diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -3,12 +3,58 @@
 All notable changes to this project will be documented in this file.
 
 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).
+and this project adheres to
+[Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [0.11.0.0] - 2024-12-29
+## [Unreleased]
 
+## [0.12.0.0] -- 2025-04-12
+
 ### Added
+
+- Added derivation of `Mergeable` instances using `NoStrategy`.
+  ([#269](https://github.com/lsrcz/grisette/pull/269))
+- Added `filterExactNumArgs` and `filterLeqNumArgs` for filtering classes that
+  accepts type constructors with exactly or at most $n$ arguments. Added more
+  list of classes. ([#269](https://github.com/lsrcz/grisette/pull/269))
+- Added derivation for `Mergeable` using `NoStrategy`.
+  ([#270](https://github.com/lsrcz/grisette/pull/270))
+- Added derivation for cereal and binary serializations.
+  ([#271](https://github.com/lsrcz/grisette/pull/271))
+- Added unconstrained positions for derivation.
+  ([#273](https://github.com/lsrcz/grisette/pull/273))
+- Added `AsMetadata` type class and `Metadata` pattern for embedding and
+  extracting values from metadata represented as an S-expression.
+  ([#277](https://github.com/lsrcz/grisette/pull/277))
+- Improved `SupportedNonFuncPrim` and `BasicSymPrim` constraints.
+  ([#278](https://github.com/lsrcz/grisette/pull/278))
+- Provided better patterns for term analysis.
+  ([#280](https://github.com/lsrcz/grisette/pull/280))
+- Added `PPrint` instances for `SomeTerm` and `Term`.
+  ([#281](https://github.com/lsrcz/grisette/pull/281))
+- Types with `SimpleMergeable` instances now have default `ITEOp` instances.
+  ([#290](https://github.com/lsrcz/grisette/pull/290))
+
+### Changed
+
+- Derivation of `PPrint` no longer relies on `OverloadedStrings` extension.
+  ([#268](https://github.com/lsrcz/grisette/pull/268))
+- The `choose*Fresh` functions will not try its best to minimize the size of the
+  guards. ([#283](https://github.com/lsrcz/grisette/pull/283))
+- `EvalModeConvertible` is now reflexive.
+  ([#284](https://github.com/lsrcz/grisette/pull/284))
+- \[Breaking\] Renamed `deriveGADT` to `derive`.
+  ([#286](https://github.com/lsrcz/grisette/pull/286))
+
+### Fixed
+
+- Fixed the derivation for empty data types.
+  ([#272](https://github.com/lsrcz/grisette/pull/272))
+
+## [0.11.0.0] -- 2024-12-29
+
+### Added
+
 - Added `deriveGADT` for deriving all relevant instances for GADTs.
   ([#267](https://github.com/lsrcz/grisette/pull/267))
 - Added `EvalModeConvertible` for a unified constraint for the evaluation modes
@@ -16,14 +62,16 @@
   ([#267](https://github.com/lsrcz/grisette/pull/267))
 
 ### Changed
-- [Breaking] We no longer support direct `toCon` from a union to a single value
-  or `toSym` from a single value to a union. These should now be done through
-  `mrgToSym`, `toUnionSym`, and `unionToCon`.
+
+- \[Breaking\] We no longer support direct `toCon` from a union to a single
+  value or `toSym` from a single value to a union. These should now be done
+  through `mrgToSym`, `toUnionSym`, and `unionToCon`.
   ([#267](https://github.com/lsrcz/grisette/pull/267))
-- [Breaking] Changed the `EvalMode` tag for `Con` to `C` and `Sym` to `S`.
+- \[Breaking\] Changed the `EvalMode` tag for `Con` to `C` and `Sym` to `S`.
   ([#267](https://github.com/lsrcz/grisette/pull/267))
 
 ### Fixed
+
 - Fixed some missing constraints for unified interfaces.
   ([#267](https://github.com/lsrcz/grisette/pull/267))
 - Fixed badly staged types in the lifting of terms.
@@ -32,10 +80,11 @@
   ([#267](https://github.com/lsrcz/grisette/pull/267))
 
 ### Removed
+
 - Removed old template-haskell-based derivation mechanism.
   ([#267](https://github.com/lsrcz/grisette/pull/267))
 
-## [0.10.0.0] - 2024-12-11
+## [0.10.0.0] -- 2024-12-11
 
 ### Added
 
@@ -49,18 +98,20 @@
   ([#265](https://github.com/lsrcz/grisette/pull/265))
 
 ### Changed
-- [Breaking] Improved the `SymFiniteBits` interface.
+
+- \[Breaking\] Improved the `SymFiniteBits` interface.
   ([#262](https://github.com/lsrcz/grisette/pull/262))
-- [Breaking] Changed the smart constructor generation Template Haskell procedure
-  name to `makeSmartCtorWith`, `makePrefixedSmartCtorWith`,
+- \[Breaking\] Changed the smart constructor generation Template Haskell
+  procedure name to `makeSmartCtorWith`, `makePrefixedSmartCtorWith`,
   `makeNamedSmartCtor`, and `makeSmartCtor`.
   ([#263](https://github.com/lsrcz/grisette/pull/263))
-- [Breaking] Renamed the evaluation mode tags `Con` and `Sym` to `C` and `S`.
+- \[Breaking\] Renamed the evaluation mode tags `Con` and `Sym` to `C` and `S`.
   ([#264](https://github.com/lsrcz/grisette/pull/264))
 
-## [0.9.0.0] - 2024-11-07
+## [0.9.0.0] -- 2024-11-07
 
 ### Added
+
 - Added missing instances for concrete general and tabular functions.
   ([#249](https://github.com/lsrcz/grisette/pull/249))
 - Added eval mode constraint on demand.
@@ -75,24 +126,25 @@
   ([#254](https://github.com/lsrcz/grisette/pull/254))
 
 ### Changed
-- [Breaking] Moved the constraints for the general and tabular functions and
+
+- \[Breaking\] Moved the constraints for the general and tabular functions and
   simplified their instances declaration.
   ([#249](https://github.com/lsrcz/grisette/pull/249))
-- [Breaking] Renamed `EvalMode` to `EvalModeAll`, renamed `MonadWithMode` to 
-  `MonadEvalModeAll`.
-  ([#250](https://github.com/lsrcz/grisette/pull/250))
+- \[Breaking\] Renamed `EvalMode` to `EvalModeAll`, renamed `MonadWithMode` to
+  `MonadEvalModeAll`. ([#250](https://github.com/lsrcz/grisette/pull/250))
 - Improved parallel symbolic evaluation performance.
   ([#252](https://github.com/lsrcz/grisette/pull/252))
-- [Breaking] Changed the metadata for identifiers from existential arguments to
-  s-expressions. ([#253](https://github.com/lsrcz/grisette/pull/253))
-- [Breaking] Changed the solving/cegis results from maintaining the exception
+- \[Breaking\] Changed the metadata for identifiers from existential arguments
+  to s-expressions. ([#253](https://github.com/lsrcz/grisette/pull/253))
+- \[Breaking\] Changed the solving/cegis results from maintaining the exception
   themselves to maintaining a textual representation of them.
   ([#253](https://github.com/lsrcz/grisette/pull/253))
-- [Breaking] Changed the 'VerifierResult' type for CEGIS to allow it report that
-  the verifier cannot find a counter example.
+- \[Breaking\] Changed the 'VerifierResult' type for CEGIS to allow it report
+  that the verifier cannot find a counter example.
   ([#257](https://github.com/lsrcz/grisette/pull/257))
 
 ### Fixed
+
 - Fixed memory leak within the term cache.
   ([#252](https://github.com/lsrcz/grisette/pull/252))
 - Fixed printing of bv terms.
@@ -106,19 +158,20 @@
   intermediate states are not properly memoized.
   ([#259](https://github.com/lsrcz/grisette/pull/259))
 
-## [0.8.0.0] - 2024-08-13
+## [0.8.0.0] -- 2024-08-13
 
 ### Added
+
 - Added pretty printer for models.
   ([#225](https://github.com/lsrcz/grisette/pull/225))
 - Added support for algebraic reals (`AlgReal` and `SymAlgReal`).
   ([#228](https://github.com/lsrcz/grisette/pull/228),
-   [#229](https://github.com/lsrcz/grisette/pull/229))
+  [#229](https://github.com/lsrcz/grisette/pull/229))
 - Added support for quantifiers.
   ([#230](https://github.com/lsrcz/grisette/pull/230))
 - Added `SafeFdiv`, `SafeLogBase`, `DivOr`, `FdivOr`, and `LogBaseOr`.
   ([#228](https://github.com/lsrcz/grisette/pull/228),
-   [#231](https://github.com/lsrcz/grisette/pull/231))
+  [#231](https://github.com/lsrcz/grisette/pull/231))
 - Added bitcast from and to `Bool`, `IntN`, `WordN`, `FP` and their symbolic
   counterparts when appropriate.
   ([#232](https://github.com/lsrcz/grisette/pull/232))
@@ -130,37 +183,36 @@
   ([#236](https://github.com/lsrcz/grisette/pull/236))
 - Add `SymFiniteBits`. ([#237](https://github.com/lsrcz/grisette/pull/237))
 - Add unified instances for all provided operations, including `FP` and
-  `AlgReal`.
-  ([#239](https://github.com/lsrcz/grisette/pull/239),
-   [#240](https://github.com/lsrcz/grisette/pull/240),
-   [#243](https://github.com/lsrcz/grisette/pull/243))
+  `AlgReal`. ([#239](https://github.com/lsrcz/grisette/pull/239),
+  [#240](https://github.com/lsrcz/grisette/pull/240),
+  [#243](https://github.com/lsrcz/grisette/pull/243))
 - Allow the use of number literals for `SomeBV`.
   ([#245](https://github.com/lsrcz/grisette/pull/245))
-- Add `symDistinct`.
-  ([#246](https://github.com/lsrcz/grisette/pull/246),
-   [#247](https://github.com/lsrcz/grisette/pull/247))
+- Add `symDistinct`. ([#246](https://github.com/lsrcz/grisette/pull/246),
+  [#247](https://github.com/lsrcz/grisette/pull/247))
 
 ### Fixed
+
 - Fixed model parsing for floating points.
   ([#227](https://github.com/lsrcz/grisette/pull/227))
 - Allowed `mkUnifiedConstructor` to be used with types without modes or args.
   ([#242](https://github.com/lsrcz/grisette/pull/242))
 
 ### Changed
-- [Breaking] Changed the operand order for `liftPFormatPrec2` and
-  `liftPFormatList2`.
-  ([#225](https://github.com/lsrcz/grisette/pull/225))
-- [Breaking] Changed the term representation with a compile-time tag for its
+
+- \[Breaking\] Changed the operand order for `liftPFormatPrec2` and
+  `liftPFormatList2`. ([#225](https://github.com/lsrcz/grisette/pull/225))
+- \[Breaking\] Changed the term representation with a compile-time tag for its
   kind (`AnyKind` for all symbols and `ConstantKind` for symbols other than
   uninterpreted functions). This also affects the 'ExtractSym'. A new
   `extractSymMaybe` will regard this tag if not all symbols can be casted to
   that tag. `extractSym` will always succeed, returning a set with `AnyKind`.
   ([#230](https://github.com/lsrcz/grisette/pull/230))
-- [Breaking] `SafeDivision` renamed to `SafeDiv`.
+- \[Breaking\] `SafeDivision` renamed to `SafeDiv`.
   ([#231](https://github.com/lsrcz/grisette/pull/231))
 - Refined the template-haskell-based derivation mechanism.
   ([#238](https://github.com/lsrcz/grisette/pull/238))
-- [Breaking] `GetData` is made injective by giving `Identity` wrapped type for
+- \[Breaking\] `GetData` is made injective by giving `Identity` wrapped type for
   concrete evaluation instead of the type itself.
   ([#242](https://github.com/lsrcz/grisette/pull/242))
 - Changed pprint for `Identity` to not to print the constructor.
@@ -170,28 +222,28 @@
   ([#244](https://github.com/lsrcz/grisette/pull/244))
 
 ### Removed
+
 - Removed `fpMin` and `fpMax`, which is removed in IEEE754-2019.
   ([#235](https://github.com/lsrcz/grisette/pull/235))
 - Dropped support for post-evaluation approximation.
   ([#241](https://github.com/lsrcz/grisette/pull/241))
-  
 
-## [0.7.0.0] - 2024-07-02
+## [0.7.0.0] -- 2024-07-02
 
 ### Added
+
 - Added `true` and `false` in `LogicalOp`.
   ([#211](https://github.com/lsrcz/grisette/pull/211))
 - Exported the `FP` constructs in the `Grisette` module.
   ([#209](https://github.com/lsrcz/grisette/pull/209))
 - Added missing `AllSyms` instance for `WordN`, `IntN`, and `FP`.
   ([#209](https://github.com/lsrcz/grisette/pull/209))
-- Added unified interfaces.
-  ([#210](https://github.com/lsrcz/grisette/pull/210),
-   [#212](https://github.com/lsrcz/grisette/pull/212),
-   [#213](https://github.com/lsrcz/grisette/pull/213),
-   [#214](https://github.com/lsrcz/grisette/pull/214),
-   [#215](https://github.com/lsrcz/grisette/pull/215),
-   [#217](https://github.com/lsrcz/grisette/pull/217))
+- Added unified interfaces. ([#210](https://github.com/lsrcz/grisette/pull/210),
+  [#212](https://github.com/lsrcz/grisette/pull/212),
+  [#213](https://github.com/lsrcz/grisette/pull/213),
+  [#214](https://github.com/lsrcz/grisette/pull/214),
+  [#215](https://github.com/lsrcz/grisette/pull/215),
+  [#217](https://github.com/lsrcz/grisette/pull/217))
 - Added `IEEEFPRoundingMode`.
   ([#219](https://github.com/lsrcz/grisette/pull/219))
 - Added `Show` instance for `SomeSym`.
@@ -200,41 +252,42 @@
   ([#221](https://github.com/lsrcz/grisette/pull/221))
 
 ### Fixed
+
 - Fixed the printing of FP terms.
   ([#219](https://github.com/lsrcz/grisette/pull/219))
 
 ### Changed
-- [Breaking] Relaxed constraints for type classes, according to
+
+- \[Breaking\] Relaxed constraints for type classes, according to
   https://github.com/haskell/core-libraries-committee/issues/10. One problem
   this causes is that the instances for `Union` will no longer be able to always
   merge the results. This is unfortunate, but should not be critical.
   ([#213](https://github.com/lsrcz/grisette/pull/213),
-   [#214](https://github.com/lsrcz/grisette/pull/214),
-   [#221](https://github.com/lsrcz/grisette/pull/221))
-- [Breaking] Rewritten the generic derivation mechanism.
+  [#214](https://github.com/lsrcz/grisette/pull/214),
+  [#221](https://github.com/lsrcz/grisette/pull/221))
+- \[Breaking\] Rewritten the generic derivation mechanism.
   ([#213](https://github.com/lsrcz/grisette/pull/213),
-   [#214](https://github.com/lsrcz/grisette/pull/214),
-   [#216](https://github.com/lsrcz/grisette/pull/216))
-- [Breaking] Changed the type class hierarchy for operations for functors, e.g.
-  `SEq1`, as described in
+  [#214](https://github.com/lsrcz/grisette/pull/214),
+  [#216](https://github.com/lsrcz/grisette/pull/216))
+- \[Breaking\] Changed the type class hierarchy for operations for functors,
+  e.g. `SEq1`, as described in
   https://github.com/haskell/core-libraries-committee/issues/10.
   ([#216](https://github.com/lsrcz/grisette/pull/216))
-- [Breaking] Renamed `UnionMergeable1` to `SymBranching`. Renamed `Union` to
+- \[Breaking\] Renamed `UnionMergeable1` to `SymBranching`. Renamed `Union` to
   `UnionBase`, and `UnionM` to `Union`.
   ([#214](https://github.com/lsrcz/grisette/pull/214),
-   [#217](https://github.com/lsrcz/grisette/pull/217))
-- [Breaking] Renamed `EvaluateSym` to `EvalSym`. Renamed `SubstituteSym` to
+  [#217](https://github.com/lsrcz/grisette/pull/217))
+- \[Breaking\] Renamed `EvaluateSym` to `EvalSym`. Renamed `SubstituteSym` to
   `SubstSym`. Renamed `ExtractSymbolics` to `ExtractSym`.
   ([#217](https://github.com/lsrcz/grisette/pull/217))
-- [Breaking] Renamed `SEq` to `SymEq`. Renamed `SOrd` to `SymOrd`.
+- \[Breaking\] Renamed `SEq` to `SymEq`. Renamed `SOrd` to `SymOrd`.
   ([#217](https://github.com/lsrcz/grisette/pull/217))
-- [Breaking] Renamed `GPretty` to `PPrint`.
+- \[Breaking\] Renamed `GPretty` to `PPrint`.
   ([#217](https://github.com/lsrcz/grisette/pull/217),
-   [#224](https://github.com/lsrcz/grisette/pull/224))
-- [Breaking] Discourage the use of approximation with `approx`. `precise` is now
-  the default and we do not require `precise` to be used everytime we call a
-  solver.
-  ([#218](https://github.com/lsrcz/grisette/pull/218))
+  [#224](https://github.com/lsrcz/grisette/pull/224))
+- \[Breaking\] Discourage the use of approximation with `approx`. `precise` is
+  now the default and we do not require `precise` to be used everytime we call a
+  solver. ([#218](https://github.com/lsrcz/grisette/pull/218))
 
 ## [0.6.0.0] -- 2024-06-07
 
@@ -262,14 +315,14 @@
 
 ### Changed
 
-- [Breaking] Equality test for `SomeBV` with different bit widths will now
+- \[Breaking\] Equality test for `SomeBV` with different bit widths will now
   return false rather than crash.
   ([#200](https://github.com/lsrcz/grisette/pull/200))
-- [Breaking] More intuitive CEGIS interface.
+- \[Breaking\] More intuitive CEGIS interface.
   ([#201](https://github.com/lsrcz/grisette/pull/201))
-- [Breaking] Changed the low-level solver interface.
+- \[Breaking\] Changed the low-level solver interface.
   ([#206](https://github.com/lsrcz/grisette/pull/206))
-- [Breaking] Changed the CEGIS interface.
+- \[Breaking\] Changed the CEGIS interface.
   ([#206](https://github.com/lsrcz/grisette/pull/206))
 - Bumped the minimum supported sbv version to 8.17.
   ([#207](https://github.com/lsrcz/grisette/pull/207))
@@ -317,32 +370,32 @@
 
 ### Changed
 
-- [Breaking] Removed the `UnionLike` and `UnionPrjOp` interface, added the
+- \[Breaking\] Removed the `UnionLike` and `UnionPrjOp` interface, added the
   `TryMerge` and `PlainUnion` interface. This allows `mrg*` operations to be
   used with non-union programs.
   ([#170](https://github.com/lsrcz/grisette/pull/170))
-- [Breaking] Refined the safe operations interface using `TryMerge`.
+- \[Breaking\] Refined the safe operations interface using `TryMerge`.
   ([#172](https://github.com/lsrcz/grisette/pull/172))
-- [Breaking] Renamed `safeMinus` to `safeSub` to be more consistent.
+- \[Breaking\] Renamed `safeMinus` to `safeSub` to be more consistent.
   ([#172](https://github.com/lsrcz/grisette/pull/172))
-- [Breaking] Unifies the implementation for all symbolic non-indexed
+- \[Breaking\] Unifies the implementation for all symbolic non-indexed
   bit-vectors. The legacy types are now type and pattern synonyms.
   ([#174](https://github.com/lsrcz/grisette/pull/174),
   [#179](https://github.com/lsrcz/grisette/pull/179),
   [#180](https://github.com/lsrcz/grisette/pull/180))
-- [Breaking] Use functional dependency instead of type family for the `Function`
-  class. ([#178](https://github.com/lsrcz/grisette/pull/178))
-- [Breaking] Added `Mergeable` constraints to some `mrg*` list operators
+- \[Breaking\] Use functional dependency instead of type family for the
+  `Function` class. ([#178](https://github.com/lsrcz/grisette/pull/178))
+- \[Breaking\] Added `Mergeable` constraints to some `mrg*` list operators
   ([#182](https://github.com/lsrcz/grisette/pull/182))
-- [Breaking] Refactored the `mrg*` constructor related template haskell code.
+- \[Breaking\] Refactored the `mrg*` constructor related template haskell code.
   ([#185](https://github.com/lsrcz/grisette/pull/185))
-- [Breaking] Dropped symbols with extra information.
+- \[Breaking\] Dropped symbols with extra information.
   ([#188](https://github.com/lsrcz/grisette/pull/188))
-- [Breaking] The `FreshIdent` is removed. It is now changed to `Identifier` and
-  `Symbol` types. ([#192](https://github.com/lsrcz/grisette/pull/192))
+- \[Breaking\] The `FreshIdent` is removed. It is now changed to `Identifier`
+  and `Symbol` types. ([#192](https://github.com/lsrcz/grisette/pull/192))
 - Changed the internal representation of the terms.
   ([#193](https://github.com/lsrcz/grisette/pull/193))
-- [Breaking] Refactored the project structures.
+- \[Breaking\] Refactored the project structures.
   ([#194](https://github.com/lsrcz/grisette/pull/194))
 
 ## [0.4.1.0] -- 2024-01-10
@@ -383,11 +436,11 @@
 
 ### Removed
 
-- [Breaking] Removed the `Grisette.Lib.Mtl` module.
+- \[Breaking\] Removed the `Grisette.Lib.Mtl` module.
   ([#132](https://github.com/lsrcz/grisette/pull/132))
-- [Breaking] Removed `SymBoolOp` and `SymIntegerOp`.
+- \[Breaking\] Removed `SymBoolOp` and `SymIntegerOp`.
   ([#146](https://github.com/lsrcz/grisette/pull/146))
-- [Breaking] Removed `ExtractSymbolics` instance for `SymbolSet`.
+- \[Breaking\] Removed `ExtractSymbolics` instance for `SymbolSet`.
   ([#146](https://github.com/lsrcz/grisette/pull/146))
 
 ### Fixed
@@ -413,33 +466,33 @@
 
 - Reorganized the files for `MonadTrans`.
   ([#132](https://github.com/lsrcz/grisette/pull/132))
-- [Breaking] Changed the name of `Union` constructors and patterns.
+- \[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
+- \[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
+- \[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
+- \[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
+- \[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`.
+- \[Breaking\] Changed the API to `MonadFresh`.
   ([#156](https://github.com/lsrcz/grisette/pull/156))
-- [Breaking] Renamed multiple symbolic operators.
+- \[Breaking\] Renamed multiple symbolic operators.
   ([#158](https://github.com/lsrcz/grisette/pull/158))
-- [Breaking] Changed the solver interface.
+- \[Breaking\] Changed the solver interface.
   ([#159](https://github.com/lsrcz/grisette/pull/159))
-- [Breaking] Changed the CEGIS solver interface.
+- \[Breaking\] Changed the CEGIS solver interface.
   ([#159](https://github.com/lsrcz/grisette/pull/159))
 
 ## [0.3.1.1] -- 2023-09-29
@@ -498,7 +551,7 @@
 - Fixed the merging for `SomeSymIntN` and `SomeSymWordN`.
   ([#72](https://github.com/lsrcz/grisette/pull/72))
 
-## [0.2.0.0] - 2023-04-13
+## [0.2.0.0] -- 2023-04-13
 
 ### Added
 
@@ -543,24 +596,26 @@
 - Fix CEGIS crash when subsequent solver calls introduces new symbolic constant.
   ([#60](https://github.com/lsrcz/grisette/pull/60))
 
-## [0.1.0.0] - 2023-01-20
+## [0.1.0.0] -- 2023-01-20
 
 ### Added
 
 - Initial release for Grisette.
 
-[0.11.0.0]: https://github.com/lsrcz/grisette/compare/v0.10.0.0...HEAD
+[0.1.0.0]: https://github.com/lsrcz/grisette/tree/v0.1.0.0
 [0.10.0.0]: https://github.com/lsrcz/grisette/compare/v0.9.0.0...v0.10.0.0
-[0.9.0.0]: https://github.com/lsrcz/grisette/compare/v0.8.0.0...v0.9.0.0
-[0.8.0.0]: https://github.com/lsrcz/grisette/compare/v0.7.0.0...v0.8.0.0
-[0.7.0.0]: https://github.com/lsrcz/grisette/compare/v0.6.0.0...v0.7.0.0
-[0.6.0.0]: https://github.com/lsrcz/grisette/compare/v0.5.0.1...v0.6.0.0
-[0.5.0.1]: https://github.com/lsrcz/grisette/compare/v0.5.0.0...v0.5.0.1
-[0.5.0.0]: https://github.com/lsrcz/grisette/compare/v0.4.1.0...v0.5.0.0
-[0.4.1.0]: https://github.com/lsrcz/grisette/compare/v0.4.0.0...v0.4.1.0
-[0.4.0.0]: https://github.com/lsrcz/grisette/compare/v0.3.1.1...v0.4.0.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
+[0.11.0.0]: https://github.com/lsrcz/grisette/compare/v0.10.0.0...v0.11.0.0
+[0.12.0.0]: https://github.com/lsrcz/grisette/compare/v0.11.0.0...v0.12.0.0
 [0.2.0.0]: https://github.com/lsrcz/grisette/compare/v0.1.0.0...v0.2.0.0
-[0.1.0.0]: https://github.com/lsrcz/grisette/tree/v0.1.0.0
+[0.3.0.0]: https://github.com/lsrcz/grisette/compare/v0.2.0.0...v0.3.0.0
+[0.3.1.0]: https://github.com/lsrcz/grisette/compare/v0.3.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.4.0.0]: https://github.com/lsrcz/grisette/compare/v0.3.1.1...v0.4.0.0
+[0.4.1.0]: https://github.com/lsrcz/grisette/compare/v0.4.0.0...v0.4.1.0
+[0.5.0.0]: https://github.com/lsrcz/grisette/compare/v0.4.1.0...v0.5.0.0
+[0.5.0.1]: https://github.com/lsrcz/grisette/compare/v0.5.0.0...v0.5.0.1
+[0.6.0.0]: https://github.com/lsrcz/grisette/compare/v0.5.0.1...v0.6.0.0
+[0.7.0.0]: https://github.com/lsrcz/grisette/compare/v0.6.0.0...v0.7.0.0
+[0.8.0.0]: https://github.com/lsrcz/grisette/compare/v0.7.0.0...v0.8.0.0
+[0.9.0.0]: https://github.com/lsrcz/grisette/compare/v0.8.0.0...v0.9.0.0
+[unreleased]: https://github.com/lsrcz/grisette/compare/v0.12.0.0...HEAD
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -3,9 +3,9 @@
 [![Haskell Tests](https://github.com/lsrcz/grisette/actions/workflows/test.yml/badge.svg)](https://github.com/lsrcz/grisette/actions/workflows/test.yml)
 [![Hackage Version](https://img.shields.io/hackage/v/grisette)](https://hackage.haskell.org/package/grisette)
 
-Grisette is a symbolic evaluation library for Haskell.
-By translating programs into SMT constraints, Grisette can help the development
-of program reasoning tools, including verification and synthesis.
+Grisette is a symbolic evaluation library for Haskell. By translating programs
+into SMT constraints, Grisette can help the development of program reasoning
+tools, including verification and synthesis.
 
 For a detailed description of the system, please refer to our POPL'23 paper
 [Grisette: Symbolic Compilation as a Functional Programming Library](https://lsrcz.github.io/files/POPL23.pdf).
@@ -48,7 +48,7 @@
 ```cabal
 library
   ...
-  build-depends: grisette >= 0.11 < 0.12
+  build-depends: grisette >= 0.12 < 0.13
 ```
 
 #### Using stack
@@ -59,14 +59,14 @@
 
 ```yaml
 extra-deps:
-  - grisette-0.11.0.0
+  - grisette-0.12.0.0
 ```
 
 and in your `package.yaml` file:
 
 ```yaml
 dependencies:
-  - grisette >= 0.11 < 0.12
+  - grisette >= 0.12 < 0.13
 ```
 
 #### Quick start template with `stack new`
@@ -78,7 +78,8 @@
 ```
 
 For more details, please see the
-[template file](https://github.com/lsrcz/stack-templates/blob/main/grisette.hsfiles) and the
+[template file](https://github.com/lsrcz/stack-templates/blob/main/grisette.hsfiles)
+and the
 [documentation for stack templates](https://docs.haskellstack.org/en/stable/templates_command/).
 
 You can test your installation by running the following command:
@@ -131,11 +132,12 @@
 for boolean and integer expressions.
 
 We will
+
 - define the *syntax* and *semantics* of an arithmetic language, and
 - build a *verifier* to check if a given arithmetic expression is equivalent to
   another, and
-- build a *synthesizer* to find an arithmetic expression that is equivalent to
-  a given expression.
+- build a *synthesizer* to find an arithmetic expression that is equivalent to a
+  given expression.
 
 ### Defining the Syntax
 
@@ -203,9 +205,9 @@
 ```
 
 The introduction of `Union` allows us to represent choices of expressions, and
-the following code chooses between `a + 2` or `a * 2`. A synthesizer can then pick
-true or false for the `choice` variable to decide which expression to pick. If
-the synthesizer picks true, the result is `a + 2`; otherwise, it is `a * 2`.
+the following code chooses between `a + 2` or `a * 2`. A synthesizer can then
+pick true or false for the `choice` variable to decide which expression to pick.
+If the synthesizer picks true, the result is `a + 2`; otherwise, it is `a * 2`.
 
 ```haskell
 add2 = add (intVal "a") (intVal 2)
@@ -215,6 +217,7 @@
 ```
 
 ### Defining the Semantics
+
 The semantics of the expressions can be defined by the following interpreter.
 Grisette provides various combinators for working with symbolic values. In the
 interpreter, the `.#` operator is very important. It conceptually
@@ -242,6 +245,7 @@
 to the [tutorials](tutorials) for more details.
 
 ### Get a verifier
+
 With the syntax and semantics defined, we can build a verifier to check if two
 expressions are equivalent. This can be done by checking if there exists a
 counter-example that falsifies the equivalence of the two expressions.
@@ -264,12 +268,13 @@
 different values. The counter-example is $a=0$, $b=1$, such that $a+b=1$ and
 $a+a=0$.
 
-``` haskell
+```haskell
 > solve z3 $ eval aPlusB ./= eval aPlusA
 Right (Model {a -> 0 :: Integer, b -> 1 :: Integer})
 ```
 
 ### Get a synthesizer
+
 We can also build a synthesizer using the built-in CEGIS algorithm in Grisette.
 Given a target expression, we can synthesize an expression using a sketch with
 "symbolic holes" that is equivalent to the target expression.
@@ -292,9 +297,11 @@
 
 ## Documentation
 
-- Haddock documentation at [grisette](https://hackage.haskell.org/package/grisette).
+- Haddock documentation: [HEAD version](https://lsrcz.github.io/grisette),
+  [release version on Hackage](https://hackage.haskell.org/package/grisette).
 - A tutorial to Grisette is in the [tutorials](tutorials) directory. They are
-  provided as jupyter notebooks with the [IHaskell](https://github.com/IHaskell/IHaskell) kernel.
+  provided as jupyter notebooks with the
+  [IHaskell](https://github.com/IHaskell/IHaskell) kernel.
 
 ## License
 
@@ -307,31 +314,32 @@
 8.10+.
 
 ### CLC proposal #10
+
 As the type classes provided by Grisette implements
 [CLC proposal #10](https://github.com/haskell/core-libraries-committee/issues/10),
 which requires `base-4.18.0.0` to work reliably, Grisette is fully compatible
-with GHC 9.6.
-You may experience instance resolution failure when using older GHCs in the
-client code (Grisette itself is buildable against GHC 8.10+ with some tricks).
+with GHC 9.6. You may experience instance resolution failure when using older
+GHCs in the client code (Grisette itself is buildable against GHC 8.10+ with
+some tricks).
 
 ### Quantifiers
 
-Grisette currently supports universal and existential quantifiers $\forall$ and
-$\exists$, but only when building with sbv >= 10.1. This also means that you
+Grisette currently supports universal and existential quantifiers $\\forall$ and
+$\\exists$, but only when building with sbv >= 10.1. This also means that you
 need to use GHC >= 9.2.
 
 ### Floating-points
 
 Grisette currently supports boolean, uninterpreted functions, bitvector,
 integer, and floating point theories. However, if you want to use the floating
-point theory, please make sure that you have the latest libBF (>=0.6.8) and sbv 
+point theory, please make sure that you have the latest libBF (>=0.6.8) and sbv
 installed (>=10.10.6). We've detected and fixed several bugs that would prevent
 a sound reasoning for floating points.
 
 ### Unified interfaces
 
-Since 0.7.0.0, Grisette provides a [unified
-interface](https://hackage.haskell.org/package/grisette/docs/Grisette-Unified.html)
+Since 0.7.0.0, Grisette provides a
+[unified interface](https://hackage.haskell.org/package/grisette/docs/Grisette-Unified.html)
 to symbolic and concrete evaluations. GHC 9.0 or earlier, without the
 [QuickLook](https://dl.acm.org/doi/10.1145/3408971) type inference algorithm for
 impredicative types, may fail to resolve some constraints. You may need to
diff --git a/grisette.cabal b/grisette.cabal
--- a/grisette.cabal
+++ b/grisette.cabal
@@ -4,34 +4,34 @@
 --
 -- see: https://github.com/sol/hpack
 
-name:           grisette
-version:        0.11.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
-                program reasoning tools, including verification, synthesis, and more.
-                .
-                The "Grisette" module exports all the core APIs for building a symbolic
-                evaluation tool. A high-level overview of the module structures are available
-                there.
-                .
-                A detailed introduction to Grisette is available at "Grisette.Core". More
-                lifted libraries are provided in @Grisette.Lib.*@ modules.
-                .
-                The "Grisette.Unified" module offers an experimental unified interface for
-                symbolic and concrete evaluation. This module should be imported qualified.
-                .
-                For more details, please checkout the README and 
-                [tutorials](https://github.com/lsrcz/grisette/tree/main/tutorials).
-category:       Formal Methods, Theorem Provers, Symbolic Computation, SMT
-homepage:       https://github.com/lsrcz/grisette#readme
-bug-reports:    https://github.com/lsrcz/grisette/issues
-author:         Sirui Lu, Rastislav Bodík
-maintainer:     Sirui Lu (siruilu@cs.washington.edu)
-copyright:      2021-2024 Sirui Lu
-license:        BSD3
-license-file:   LICENSE
-build-type:     Simple
+name:               grisette
+version:            0.12.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
+                    program reasoning tools, including verification, synthesis, and more.
+                    .
+                    The "Grisette" module exports all the core APIs for building a symbolic
+                    evaluation tool. A high-level overview of the module structures are available
+                    there.
+                    .
+                    A detailed introduction to Grisette is available at "Grisette.Core". More
+                    lifted libraries are provided in @Grisette.Lib.*@ modules.
+                    .
+                    The "Grisette.Unified" module offers an experimental unified interface for
+                    symbolic and concrete evaluation. This module should be imported qualified.
+                    .
+                    For more details, please checkout the README and 
+                    [tutorials](https://github.com/lsrcz/grisette/tree/main/tutorials).
+category:           Formal Methods, Theorem Provers, Symbolic Computation, SMT
+homepage:           https://github.com/lsrcz/grisette#readme
+bug-reports:        https://github.com/lsrcz/grisette/issues
+author:             Sirui Lu, Rastislav Bodík
+maintainer:         Sirui Lu (siruilu@cs.washington.edu)
+copyright:          2021-2024 Sirui Lu
+license:            BSD3
+license-file:       LICENSE
+build-type:         Simple
 tested-with:
     GHC == 8.10.7
   , GHC == 9.0.2
@@ -121,9 +121,7 @@
       Grisette.Internal.SymPrim.IntBitwidth
       Grisette.Internal.SymPrim.ModelRep
       Grisette.Internal.SymPrim.Prim.Internal.Caches
-      Grisette.Internal.SymPrim.Prim.Internal.Instances.BVPEval
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitCastTerm
-      Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitwiseTerm
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalDivModIntegralTerm
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFloatingTerm
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
@@ -134,13 +132,13 @@
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalOrdTerm
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalRotateTerm
       Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalShiftTerm
-      Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim
       Grisette.Internal.SymPrim.Prim.Internal.PartialEval
       Grisette.Internal.SymPrim.Prim.Internal.Serialize
       Grisette.Internal.SymPrim.Prim.Internal.Term
       Grisette.Internal.SymPrim.Prim.Internal.Unfold
       Grisette.Internal.SymPrim.Prim.Internal.Utils
       Grisette.Internal.SymPrim.Prim.Model
+      Grisette.Internal.SymPrim.Prim.Pattern
       Grisette.Internal.SymPrim.Prim.SomeTerm
       Grisette.Internal.SymPrim.Prim.Term
       Grisette.Internal.SymPrim.Prim.TermUtils
@@ -158,33 +156,36 @@
       Grisette.Internal.TH.Ctor.Common
       Grisette.Internal.TH.Ctor.SmartConstructor
       Grisette.Internal.TH.Ctor.UnifiedConstructor
-      Grisette.Internal.TH.GADT.BinaryOpCommon
-      Grisette.Internal.TH.GADT.Common
-      Grisette.Internal.TH.GADT.ConvertOpCommon
-      Grisette.Internal.TH.GADT.DeriveAllSyms
-      Grisette.Internal.TH.GADT.DeriveEq
-      Grisette.Internal.TH.GADT.DeriveEvalSym
-      Grisette.Internal.TH.GADT.DeriveExtractSym
-      Grisette.Internal.TH.GADT.DeriveGADT
-      Grisette.Internal.TH.GADT.DeriveHashable
-      Grisette.Internal.TH.GADT.DeriveMergeable
-      Grisette.Internal.TH.GADT.DeriveNFData
-      Grisette.Internal.TH.GADT.DeriveOrd
-      Grisette.Internal.TH.GADT.DerivePPrint
-      Grisette.Internal.TH.GADT.DeriveSerial
-      Grisette.Internal.TH.GADT.DeriveShow
-      Grisette.Internal.TH.GADT.DeriveSimpleMergeable
-      Grisette.Internal.TH.GADT.DeriveSubstSym
-      Grisette.Internal.TH.GADT.DeriveSymEq
-      Grisette.Internal.TH.GADT.DeriveSymOrd
-      Grisette.Internal.TH.GADT.DeriveToCon
-      Grisette.Internal.TH.GADT.DeriveToSym
-      Grisette.Internal.TH.GADT.DeriveUnifiedSimpleMergeable
-      Grisette.Internal.TH.GADT.DeriveUnifiedSymEq
-      Grisette.Internal.TH.GADT.DeriveUnifiedSymOrd
-      Grisette.Internal.TH.GADT.ShowPPrintCommon
-      Grisette.Internal.TH.GADT.UnaryOpCommon
-      Grisette.Internal.TH.GADT.UnifiedOpCommon
+      Grisette.Internal.TH.Derivation.BinaryOpCommon
+      Grisette.Internal.TH.Derivation.Common
+      Grisette.Internal.TH.Derivation.ConvertOpCommon
+      Grisette.Internal.TH.Derivation.Derive
+      Grisette.Internal.TH.Derivation.DeriveAllSyms
+      Grisette.Internal.TH.Derivation.DeriveBinary
+      Grisette.Internal.TH.Derivation.DeriveCereal
+      Grisette.Internal.TH.Derivation.DeriveEq
+      Grisette.Internal.TH.Derivation.DeriveEvalSym
+      Grisette.Internal.TH.Derivation.DeriveExtractSym
+      Grisette.Internal.TH.Derivation.DeriveHashable
+      Grisette.Internal.TH.Derivation.DeriveMergeable
+      Grisette.Internal.TH.Derivation.DeriveNFData
+      Grisette.Internal.TH.Derivation.DeriveOrd
+      Grisette.Internal.TH.Derivation.DerivePPrint
+      Grisette.Internal.TH.Derivation.DeriveSerial
+      Grisette.Internal.TH.Derivation.DeriveShow
+      Grisette.Internal.TH.Derivation.DeriveSimpleMergeable
+      Grisette.Internal.TH.Derivation.DeriveSubstSym
+      Grisette.Internal.TH.Derivation.DeriveSymEq
+      Grisette.Internal.TH.Derivation.DeriveSymOrd
+      Grisette.Internal.TH.Derivation.DeriveToCon
+      Grisette.Internal.TH.Derivation.DeriveToSym
+      Grisette.Internal.TH.Derivation.DeriveUnifiedSimpleMergeable
+      Grisette.Internal.TH.Derivation.DeriveUnifiedSymEq
+      Grisette.Internal.TH.Derivation.DeriveUnifiedSymOrd
+      Grisette.Internal.TH.Derivation.SerializeCommon
+      Grisette.Internal.TH.Derivation.ShowPPrintCommon
+      Grisette.Internal.TH.Derivation.UnaryOpCommon
+      Grisette.Internal.TH.Derivation.UnifiedOpCommon
       Grisette.Internal.TH.Util
       Grisette.Internal.Unified.BaseConstraint
       Grisette.Internal.Unified.BaseMonad
@@ -305,7 +306,6 @@
   hs-source-dirs:
       src
   ghc-options: -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wmissing-export-lists -Wmissing-home-modules -Wmissing-import-lists -Wpartial-fields -Wunused-type-patterns -Wno-x-partial -Wno-unrecognised-warning-flags
-  ghc-prof-options: -finfo-table-map -fdistinct-constructor-tables
   build-depends:
       QuickCheck >=2.14 && <2.16
     , array >=0.5.4 && <0.6
@@ -317,14 +317,14 @@
     , bytestring >=0.10.12 && <0.13
     , cereal >=0.5.8.1 && <0.6
     , cereal-text >=0.1.0.2 && <0.2
-    , containers >=0.4 && <0.8
+    , containers >=0.5.7 && <0.9
     , deepseq >=1.4.4 && <1.6
     , generic-deriving >=1.14.1 && <1.15
-    , hashable >=1.2.5 && <1.6
+    , hashable >=1.3 && <1.6
     , libBF >=0.6.3 && <0.7
     , loch-th >=0.2.2 && <0.3
     , mtl >=2.2.2 && <2.4
-    , parallel >=3.2.2.0 && <3.3
+    , parallel >=3.2.2 && <3.3
     , prettyprinter >=1.5.0 && <1.8
     , sbv >=8.17 && <12
     , stm ==2.5.*
@@ -333,7 +333,7 @@
     , th-abstraction >=0.4 && <0.8
     , th-compat >=0.1.2 && <0.2
     , th-lift-instances >=0.1.16 && <0.2
-    , transformers >=0.5.6 && <0.7
+    , transformers >=0.5.6.2 && <0.7
     , unordered-containers >=0.2.17 && <0.3
     , vector >=0.12.1.2 && <0.14
   default-language: Haskell2010
@@ -341,6 +341,9 @@
     ghc-options: -O2
   else
     ghc-options: -O0
+  if impl(ghc >= 9.2)
+    ghc-prof-options: -finfo-table-map -fdistinct-constructor-tables
+  else
 
 test-suite doctest
   type: exitcode-stdio-1.0
@@ -350,7 +353,6 @@
   hs-source-dirs:
       doctest
   ghc-options: -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wmissing-export-lists -Wmissing-home-modules -Wmissing-import-lists -Wpartial-fields -Wunused-type-patterns -Wno-x-partial -Wno-unrecognised-warning-flags -threaded -rtsopts -with-rtsopts=-N
-  ghc-prof-options: -finfo-table-map -fdistinct-constructor-tables
   build-depends:
       QuickCheck >=2.14 && <2.16
     , array >=0.5.4 && <0.6
@@ -362,16 +364,16 @@
     , bytestring >=0.10.12 && <0.13
     , cereal >=0.5.8.1 && <0.6
     , cereal-text >=0.1.0.2 && <0.2
-    , containers >=0.4 && <0.8
+    , containers >=0.5.7 && <0.9
     , deepseq >=1.4.4 && <1.6
-    , doctest >=0.18.2 && <0.24
+    , doctest >=0.18.2 && <0.25
     , generic-deriving >=1.14.1 && <1.15
     , grisette
-    , hashable >=1.2.5 && <1.6
+    , hashable >=1.3 && <1.6
     , libBF >=0.6.3 && <0.7
     , loch-th >=0.2.2 && <0.3
     , mtl >=2.2.2 && <2.4
-    , parallel >=3.2.2.0 && <3.3
+    , parallel >=3.2.2 && <3.3
     , prettyprinter >=1.5.0 && <1.8
     , sbv >=8.17 && <12
     , stm ==2.5.*
@@ -380,7 +382,7 @@
     , th-abstraction >=0.4 && <0.8
     , th-compat >=0.1.2 && <0.2
     , th-lift-instances >=0.1.16 && <0.2
-    , transformers >=0.5.6 && <0.7
+    , transformers >=0.5.6.2 && <0.7
     , unordered-containers >=0.2.17 && <0.3
     , vector >=0.12.1.2 && <0.14
   default-language: Haskell2010
@@ -388,6 +390,9 @@
     ghc-options: -O2
   else
     ghc-options: -O0
+  if impl(ghc >= 9.2)
+    ghc-prof-options: -finfo-table-map -fdistinct-constructor-tables
+  else
 
 test-suite spec
   type: exitcode-stdio-1.0
@@ -455,6 +460,7 @@
       Grisette.SymPrim.QuantifierTests
       Grisette.SymPrim.SomeBVTests
       Grisette.SymPrim.SymGeneralFunTests
+      Grisette.SymPrim.SymPrimConstraintTests
       Grisette.SymPrim.SymPrimTests
       Grisette.SymPrim.TabularFunTests
       Grisette.TestUtil.NoMerge
@@ -467,7 +473,6 @@
   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 -Wno-x-partial -Wno-unrecognised-warning-flags -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints
-  ghc-prof-options: -finfo-table-map -fdistinct-constructor-tables
   build-depends:
       HUnit ==1.6.*
     , QuickCheck >=2.14 && <2.16
@@ -480,15 +485,15 @@
     , bytestring >=0.10.12 && <0.13
     , cereal >=0.5.8.1 && <0.6
     , cereal-text >=0.1.0.2 && <0.2
-    , containers >=0.4 && <0.8
+    , containers >=0.5.7 && <0.9
     , deepseq >=1.4.4 && <1.6
     , generic-deriving >=1.14.1 && <1.15
     , grisette
-    , hashable >=1.2.5 && <1.6
+    , hashable >=1.3 && <1.6
     , libBF >=0.6.3 && <0.7
     , loch-th >=0.2.2 && <0.3
     , mtl >=2.2.2 && <2.4
-    , parallel >=3.2.2.0 && <3.3
+    , parallel >=3.2.2 && <3.3
     , prettyprinter >=1.5.0 && <1.8
     , sbv >=8.17 && <12
     , stm ==2.5.*
@@ -500,7 +505,7 @@
     , th-abstraction >=0.4 && <0.8
     , th-compat >=0.1.2 && <0.2
     , th-lift-instances >=0.1.16 && <0.2
-    , transformers >=0.5.6 && <0.7
+    , transformers >=0.5.6.2 && <0.7
     , unordered-containers >=0.2.17 && <0.3
     , vector >=0.12.1.2 && <0.14
   default-language: Haskell2010
@@ -508,3 +513,6 @@
     ghc-options: -O2
   else
     ghc-options: -O0
+  if impl(ghc >= 9.2)
+    ghc-prof-options: -finfo-table-map -fdistinct-constructor-tables
+  else
diff --git a/src/Grisette/Core.hs b/src/Grisette/Core.hs
--- a/src/Grisette/Core.hs
+++ b/src/Grisette/Core.hs
@@ -306,6 +306,8 @@
     Identifier (..),
     Symbol (..),
     identifier,
+    AsMetadata (..),
+    pattern Metadata,
     withMetadata,
     mapMetadata,
     withLocation,
@@ -556,13 +558,13 @@
     --     deriving (Mergeable) via (Default X)
     -- :}
     --
-    -- Grisette also provide 'Grisette.deriveGADT' template haskell procedure to
+    -- Grisette also provide 'Grisette.derive' template haskell procedure to
     -- derive all the instances for the classes that are relevant. This include
     -- 'Show', 'Mergeable', 'Mergeable1', etc.
     --
     -- >>> :{
     -- data X = X SymInteger Integer
-    -- deriveGADT [''X] [''Show, ''Mergeable]
+    -- derive [''X] [''Show, ''Mergeable]
     -- :}
     --
     -- Having the 'Mergeable' instance allows you to use the 'Union' type to
@@ -593,7 +595,7 @@
     -- >>> import Control.Monad.Except
     -- >>> :{
     --   data Error = Fail
-    --   deriveGADT [''Error] allClasses0
+    --   derive [''Error] allClasses0
     -- :}
     --
     -- >>> mrgIf "a" (throwError Fail) (return "x") :: ExceptT Error Union SymInteger
@@ -1829,7 +1831,8 @@
     showsSExprWithParens,
   )
 import Grisette.Internal.Core.Data.Symbol
-  ( Identifier (..),
+  ( AsMetadata (..),
+    Identifier (..),
     Symbol (..),
     identifier,
     indexed,
@@ -1840,6 +1843,7 @@
     uniqueIdentifier,
     withLocation,
     withMetadata,
+    pattern Metadata,
   )
 import Instances.TH.Lift ()
 
diff --git a/src/Grisette/Internal/Backend/Solving.hs b/src/Grisette/Internal/Backend/Solving.hs
--- a/src/Grisette/Internal/Backend/Solving.hs
+++ b/src/Grisette/Internal/Backend/Solving.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -89,7 +90,7 @@
 import Data.Dynamic (fromDyn, toDyn)
 import qualified Data.HashSet as HS
 import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)
-import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.List.NonEmpty (NonEmpty)
 import Data.Proxy (Proxy (Proxy))
 import qualified Data.SBV as SBV
 import qualified Data.SBV.Control as SBVC
@@ -150,15 +151,11 @@
   )
 import Grisette.Internal.Core.Data.MemoUtils (htmemo)
 import Grisette.Internal.SymPrim.GeneralFun (substTerm)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
-  ( sbvFPBinaryTerm,
-    sbvFPFMATerm,
-    sbvFPRoundingBinaryTerm,
-    sbvFPRoundingUnaryTerm,
-    sbvFPTraitTerm,
-    sbvFPUnaryTerm,
+import Grisette.Internal.SymPrim.Prim.Model as PM
+  ( Model,
   )
-import Grisette.Internal.SymPrim.Prim.Internal.Term
+import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm))
+import Grisette.Internal.SymPrim.Prim.Term
   ( PEvalApplyTerm (sbvApplyTerm),
     PEvalBVTerm (sbvBVConcatTerm, sbvBVExtendTerm, sbvBVSelectTerm),
     PEvalBitCastOrTerm (sbvBitCastOr),
@@ -175,6 +172,14 @@
         sbvQuotIntegralTerm,
         sbvRemIntegralTerm
       ),
+    PEvalFPTerm
+      ( sbvFPBinaryTerm,
+        sbvFPFMATerm,
+        sbvFPRoundingBinaryTerm,
+        sbvFPRoundingUnaryTerm,
+        sbvFPTraitTerm,
+        sbvFPUnaryTerm
+      ),
     PEvalFloatingTerm (sbvFloatingUnaryTerm, sbvPowerTerm),
     PEvalFractionalTerm (sbvFdivTerm, sbvRecipTerm),
     PEvalFromIntegralTerm (sbvFromIntegralTerm),
@@ -204,68 +209,62 @@
         symSBVTerm,
         withPrim
       ),
-    Term
-      ( AbsNumTerm,
-        AddNumTerm,
-        AndBitsTerm,
-        AndTerm,
-        ApplyTerm,
-        BVConcatTerm,
-        BVExtendTerm,
-        BVSelectTerm,
-        BitCastOrTerm,
-        BitCastTerm,
-        ComplementBitsTerm,
-        ConTerm,
-        DistinctTerm,
-        DivIntegralTerm,
-        EqTerm,
-        ExistsTerm,
-        FPBinaryTerm,
-        FPFMATerm,
-        FPRoundingBinaryTerm,
-        FPRoundingUnaryTerm,
-        FPTraitTerm,
-        FPUnaryTerm,
-        FdivTerm,
-        FloatingUnaryTerm,
-        ForallTerm,
-        FromFPOrTerm,
-        FromIntegralTerm,
-        ITETerm,
-        LeOrdTerm,
-        LtOrdTerm,
-        ModIntegralTerm,
-        MulNumTerm,
-        NegNumTerm,
-        NotTerm,
-        OrBitsTerm,
-        OrTerm,
-        PowerTerm,
-        QuotIntegralTerm,
-        RecipTerm,
-        RemIntegralTerm,
-        RotateLeftTerm,
-        RotateRightTerm,
-        ShiftLeftTerm,
-        ShiftRightTerm,
-        SignumNumTerm,
-        SymTerm,
-        ToFPTerm,
-        XorBitsTerm
-      ),
+    SymbolKind (AnyKind),
+    Term,
     TypedConstantSymbol,
-    TypedSymbol,
-    introSupportedPrimConstraint,
+    TypedSymbol (TypedSymbol),
     someTypedSymbol,
     symTerm,
-    withConstantSymbolSupported,
-    withSymbolSupported,
-  )
-import Grisette.Internal.SymPrim.Prim.Model as PM
-  ( Model,
+    pattern AbsNumTerm,
+    pattern AddNumTerm,
+    pattern AndBitsTerm,
+    pattern AndTerm,
+    pattern ApplyTerm,
+    pattern BVConcatTerm,
+    pattern BVExtendTerm,
+    pattern BVSelectTerm,
+    pattern BitCastOrTerm,
+    pattern BitCastTerm,
+    pattern ComplementBitsTerm,
+    pattern ConTerm,
+    pattern DistinctTerm,
+    pattern DivIntegralTerm,
+    pattern EqTerm,
+    pattern ExistsTerm,
+    pattern FPBinaryTerm,
+    pattern FPFMATerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPTraitTerm,
+    pattern FPUnaryTerm,
+    pattern FdivTerm,
+    pattern FloatingUnaryTerm,
+    pattern ForallTerm,
+    pattern FromFPOrTerm,
+    pattern FromIntegralTerm,
+    pattern ITETerm,
+    pattern LeOrdTerm,
+    pattern LtOrdTerm,
+    pattern ModIntegralTerm,
+    pattern MulNumTerm,
+    pattern NegNumTerm,
+    pattern NotTerm,
+    pattern OrBitsTerm,
+    pattern OrTerm,
+    pattern PowerTerm,
+    pattern QuotIntegralTerm,
+    pattern RecipTerm,
+    pattern RemIntegralTerm,
+    pattern RotateLeftTerm,
+    pattern RotateRightTerm,
+    pattern ShiftLeftTerm,
+    pattern ShiftRightTerm,
+    pattern SignumNumTerm,
+    pattern SupportedTerm,
+    pattern SymTerm,
+    pattern ToFPTerm,
+    pattern XorBitsTerm,
   )
-import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm))
 import Grisette.Internal.SymPrim.SymBool (SymBool (SymBool))
 
 -- $setup
@@ -531,7 +530,7 @@
         QuantifiedSymbols ->
         Term x ->
         m (QuantifiedStack -> SBVType x)
-      goCached qs t = introSupportedPrimConstraint t $ do
+      goCached qs t@SupportedTerm = do
         mp <- liftIO $ readIORef mapState
         case lookupTerm (SomeTerm t) mp of
           Just x -> return (\qst -> withPrim @x $ fromDyn (x qst) undefined)
@@ -542,9 +541,9 @@
         QuantifiedSymbols ->
         Term a ->
         m (QuantifiedStack -> SBVType a)
-      goCachedImpl _ (ConTerm _ _ _ _ v) =
+      goCachedImpl _ (ConTerm v) =
         return $ const $ conSBVTerm v
-      goCachedImpl qs t@(SymTerm _ _ _ _ ts) = do
+      goCachedImpl qs t@(SymTerm ts) = do
         if isQuantifiedSymbol ts qs
           then withPrim @a $ do
             let retDyn qst =
@@ -571,36 +570,34 @@
               modifyIORef' mapState $
                 addBiMap (SomeTerm t) (toDyn g) name (someTypedSymbol ts)
             return $ const g
-      goCachedImpl qs t@(ForallTerm _ _ _ _ (ts :: TypedConstantSymbol t1) v) =
-        withConstantSymbolSupported ts $
-          withNonFuncPrim @t1 $ do
-            do
-              m <- liftIO $ readIORef mapState
-              let (newm, sb) =
-                    attachNextQuantifiedSymbolInfo m ts
-              liftIO $ writeIORef mapState newm
-              let substedTerm = substTerm ts (symTerm sb) HS.empty v
-              r <- goCached (addQuantifiedSymbol sb qs) substedTerm
-              let ret = sbvForall sb r
-              liftIO $
-                modifyIORef' mapState $
-                  addBiMapIntermediate (SomeTerm t) (toDyn . ret)
-              return ret
-      goCachedImpl qs t@(ExistsTerm _ _ _ _ (ts :: TypedConstantSymbol t1) v) =
-        withConstantSymbolSupported ts $
-          withNonFuncPrim @t1 $ do
-            do
-              m <- liftIO $ readIORef mapState
-              let (newm, sb) =
-                    attachNextQuantifiedSymbolInfo m ts
-              liftIO $ writeIORef mapState newm
-              let substedTerm = substTerm ts (symTerm sb) HS.empty v
-              r <- goCached (addQuantifiedSymbol sb qs) substedTerm
-              let ret = sbvExists sb r
-              liftIO $
-                modifyIORef' mapState $
-                  addBiMapIntermediate (SomeTerm t) (toDyn . ret)
-              return ret
+      goCachedImpl qs t@(ForallTerm (ts :: TypedConstantSymbol t1) v) =
+        withNonFuncPrim @t1 $ do
+          do
+            m <- liftIO $ readIORef mapState
+            let (newm, sb) =
+                  attachNextQuantifiedSymbolInfo m ts
+            liftIO $ writeIORef mapState newm
+            let substedTerm = substTerm ts (symTerm sb) HS.empty v
+            r <- goCached (addQuantifiedSymbol sb qs) substedTerm
+            let ret = sbvForall sb r
+            liftIO $
+              modifyIORef' mapState $
+                addBiMapIntermediate (SomeTerm t) (toDyn . ret)
+            return ret
+      goCachedImpl qs t@(ExistsTerm (ts :: TypedConstantSymbol t1) v) =
+        withNonFuncPrim @t1 $ do
+          do
+            m <- liftIO $ readIORef mapState
+            let (newm, sb) =
+                  attachNextQuantifiedSymbolInfo m ts
+            liftIO $ writeIORef mapState newm
+            let substedTerm = substTerm ts (symTerm sb) HS.empty v
+            r <- goCached (addQuantifiedSymbol sb qs) substedTerm
+            let ret = sbvExists sb r
+            liftIO $
+              modifyIORef' mapState $
+                addBiMapIntermediate (SomeTerm t) (toDyn . ret)
+            return ret
       goCachedImpl qs t =
         withPrim @a $ do
           r <- goCachedIntermediate qs t
@@ -616,107 +613,104 @@
         QuantifiedSymbols ->
         Term a ->
         m (QuantifiedStack -> SBVType a)
-      goCachedIntermediate qs (NotTerm _ _ _ _ t) = do
+      goCachedIntermediate qs (NotTerm t) = do
         r <- goCached qs t
         return $ \qst -> SBV.sNot (r qst)
-      goCachedIntermediate qs (OrTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (OrTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> a' qst SBV..|| b' qst
-      goCachedIntermediate qs (AndTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (AndTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> a' qst SBV..&& b' qst
-      goCachedIntermediate qs (EqTerm _ _ _ _ (a :: Term v) b) = do
+      goCachedIntermediate qs (EqTerm (a :: Term v) b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $
-          introSupportedPrimConstraint a $
-            \qst -> sbvEq @v (a' qst) (b' qst)
+          \qst -> sbvEq @v (a' qst) (b' qst)
       goCachedIntermediate
         qs
-        (DistinctTerm _ _ _ _ (args@(arg1 :| _) :: NonEmpty (Term t0))) = do
+        (DistinctTerm (args :: NonEmpty (Term t0))) = do
           args' <- traverse (goCached qs) args
-          return $
-            introSupportedPrimConstraint arg1 $
-              \qst -> sbvDistinct @t0 (fmap ($ qst) args')
-      goCachedIntermediate qs (ITETerm _ _ _ _ c a b) = do
+          return $ \qst -> sbvDistinct @t0 (fmap ($ qst) args')
+      goCachedIntermediate qs (ITETerm c a b) = do
         c' <- goCached qs c
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvIte @a (c' qst) (a' qst) (b' qst)
-      goCachedIntermediate qs (AddNumTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (AddNumTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvAddNumTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (NegNumTerm _ _ _ _ a) = do
+      goCachedIntermediate qs (NegNumTerm a) = do
         a' <- goCached qs a
         return $ sbvNegNumTerm @a . a'
-      goCachedIntermediate qs (MulNumTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (MulNumTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvMulNumTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (AbsNumTerm _ _ _ _ a) = do
+      goCachedIntermediate qs (AbsNumTerm a) = do
         a' <- goCached qs a
         return $ sbvAbsNumTerm @a . a'
-      goCachedIntermediate qs (SignumNumTerm _ _ _ _ a) = do
+      goCachedIntermediate qs (SignumNumTerm a) = do
         a' <- goCached qs a
         return $ sbvSignumNumTerm @a . a'
-      goCachedIntermediate qs (LtOrdTerm _ _ _ _ (a :: Term v) b) = do
+      goCachedIntermediate qs (LtOrdTerm (a :: Term v) b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvLtOrdTerm @v (a' qst) (b' qst)
-      goCachedIntermediate qs (LeOrdTerm _ _ _ _ (a :: Term v) b) = do
+      goCachedIntermediate qs (LeOrdTerm (a :: Term v) b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvLeOrdTerm @v (a' qst) (b' qst)
-      goCachedIntermediate qs (AndBitsTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (AndBitsTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvAndBitsTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (OrBitsTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (OrBitsTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvOrBitsTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (XorBitsTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (XorBitsTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvXorBitsTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (ComplementBitsTerm _ _ _ _ a) = do
+      goCachedIntermediate qs (ComplementBitsTerm a) = do
         a' <- goCached qs a
         return $ sbvComplementBitsTerm @a . a'
-      goCachedIntermediate qs (ShiftLeftTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (ShiftLeftTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvShiftLeftTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (ShiftRightTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (ShiftRightTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvShiftRightTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (RotateLeftTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (RotateLeftTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvRotateLeftTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (RotateRightTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (RotateRightTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvRotateRightTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (ApplyTerm _ _ _ _ (f :: Term f) a) = do
+      goCachedIntermediate qs (ApplyTerm (f :: Term f) a) = do
         l1 <- goCached qs f
         l2 <- goCached qs a
         return $ \qst -> sbvApplyTerm @f (l1 qst) (l2 qst)
-      goCachedIntermediate qs (BitCastTerm _ _ _ _ (a :: Term x)) = do
+      goCachedIntermediate qs (BitCastTerm (a :: Term x)) = do
         a' <- goCached qs a
         return $ sbvBitCast @x @a . a'
       goCachedIntermediate
         qs
-        (BitCastOrTerm _ _ _ _ (d :: Term a) (a :: Term x)) = do
+        (BitCastOrTerm (d :: Term a) (a :: Term x)) = do
           d' <- goCached qs d
           a' <- goCached qs a
           return $ \qst -> sbvBitCastOr @x @a (d' qst) (a' qst)
       goCachedIntermediate
         qs
-        (BVConcatTerm _ _ _ _ (a :: Term (bv l)) (b :: Term (bv r))) =
+        (BVConcatTerm (a :: Term (bv l)) (b :: Term (bv r))) =
           do
             a' <- goCached qs a
             b' <- goCached qs b
@@ -725,80 +719,80 @@
                 sbvBVConcatTerm @bv (Proxy @l) (Proxy @r) (a' qst) (b' qst)
       goCachedIntermediate
         qs
-        (BVExtendTerm _ _ _ _ signed (pr :: p r) (a :: Term (bv l))) =
+        (BVExtendTerm signed (pr :: p r) (a :: Term (bv l))) =
           do
             a' <- goCached qs a
             return $ sbvBVExtendTerm @bv (Proxy @l) pr signed . a'
       goCachedIntermediate
         qs
-        (BVSelectTerm _ _ _ _ (pix :: p ix) (pw :: q w) (a :: Term (bv n))) =
+        (BVSelectTerm (pix :: p ix) (pw :: q w) (a :: Term (bv n))) =
           do
             a' <- goCached qs a
             return $ sbvBVSelectTerm @bv pix pw (Proxy @n) . a'
-      goCachedIntermediate qs (DivIntegralTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (DivIntegralTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvDivIntegralTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (ModIntegralTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (ModIntegralTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvModIntegralTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (QuotIntegralTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (QuotIntegralTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvQuotIntegralTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (RemIntegralTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (RemIntegralTerm a b) = do
         a' <- goCached qs a
         b' <- goCached qs b
         return $ \qst -> sbvRemIntegralTerm @a (a' qst) (b' qst)
-      goCachedIntermediate qs (FPTraitTerm _ _ _ _ trait a) = do
+      goCachedIntermediate qs (FPTraitTerm trait (a :: Term (fp eb sb))) = do
         a' <- goCached qs a
-        return $ sbvFPTraitTerm trait . a'
-      goCachedIntermediate qs (FdivTerm _ _ _ _ a b) = do
+        return $ sbvFPTraitTerm @fp @eb @sb trait . a'
+      goCachedIntermediate qs (FdivTerm a b) = do
         a <- goCached qs a
         b <- goCached qs b
         return $ \qst -> sbvFdivTerm @a (a qst) (b qst)
-      goCachedIntermediate qs (RecipTerm _ _ _ _ a) = do
+      goCachedIntermediate qs (RecipTerm a) = do
         a <- goCached qs a
         return $ sbvRecipTerm @a . a
-      goCachedIntermediate qs (FloatingUnaryTerm _ _ _ _ op a) = do
+      goCachedIntermediate qs (FloatingUnaryTerm op a) = do
         a <- goCached qs a
         return $ sbvFloatingUnaryTerm @a op . a
-      goCachedIntermediate qs (PowerTerm _ _ _ _ a b) = do
+      goCachedIntermediate qs (PowerTerm a b) = do
         a <- goCached qs a
         b <- goCached qs b
         return $ \qst -> sbvPowerTerm @a (a qst) (b qst)
-      goCachedIntermediate qs (FPUnaryTerm _ _ _ _ op a) = do
+      goCachedIntermediate qs (FPUnaryTerm op (a :: Term (fp eb sb))) = do
         a <- goCached qs a
-        return $ sbvFPUnaryTerm op . a
-      goCachedIntermediate qs (FPBinaryTerm _ _ _ _ op a b) = do
+        return $ sbvFPUnaryTerm @fp @eb @sb op . a
+      goCachedIntermediate qs (FPBinaryTerm op (a :: Term (fp eb sb)) b) = do
         a <- goCached qs a
         b <- goCached qs b
-        return $ \qst -> sbvFPBinaryTerm op (a qst) (b qst)
-      goCachedIntermediate qs (FPRoundingUnaryTerm _ _ _ _ op round a) = do
+        return $ \qst -> sbvFPBinaryTerm @fp @eb @sb op (a qst) (b qst)
+      goCachedIntermediate qs (FPRoundingUnaryTerm op round (a :: Term (fp eb sb))) = do
         round <- goCached qs round
         a <- goCached qs a
-        return $ \qst -> sbvFPRoundingUnaryTerm op (round qst) (a qst)
-      goCachedIntermediate qs (FPRoundingBinaryTerm _ _ _ _ op round a b) = do
+        return $ \qst -> sbvFPRoundingUnaryTerm @fp @eb @sb op (round qst) (a qst)
+      goCachedIntermediate qs (FPRoundingBinaryTerm op round (a :: Term (fp eb sb)) b) = do
         round <- goCached qs round
         a <- goCached qs a
         b <- goCached qs b
-        return $ \qst -> sbvFPRoundingBinaryTerm op (round qst) (a qst) (b qst)
-      goCachedIntermediate qs (FPFMATerm _ _ _ _ round a b c) = do
+        return $ \qst -> sbvFPRoundingBinaryTerm @fp @eb @sb op (round qst) (a qst) (b qst)
+      goCachedIntermediate qs (FPFMATerm round (a :: Term (fp eb sb)) b c) = do
         round <- goCached qs round
         a <- goCached qs a
         b <- goCached qs b
         c <- goCached qs c
-        return $ \qst -> sbvFPFMATerm (round qst) (a qst) (b qst) (c qst)
-      goCachedIntermediate qs (FromIntegralTerm _ _ _ _ (b :: Term b)) = do
+        return $ \qst -> sbvFPFMATerm @fp @eb @sb (round qst) (a qst) (b qst) (c qst)
+      goCachedIntermediate qs (FromIntegralTerm (b :: Term b)) = do
         b <- goCached qs b
         return $ sbvFromIntegralTerm @b @a . b
-      goCachedIntermediate qs (FromFPOrTerm _ _ _ _ d mode arg) = do
+      goCachedIntermediate qs (FromFPOrTerm d mode arg) = do
         d <- goCached qs d
         mode <- goCached qs mode
         arg <- goCached qs arg
         return $ \qst -> sbvFromFPOrTerm @a (d qst) (mode qst) (arg qst)
-      goCachedIntermediate qs (ToFPTerm _ _ _ _ mode (arg :: Term b) _ _) = do
+      goCachedIntermediate qs (ToFPTerm mode (arg :: Term b) _ _) = do
         mode <- goCached qs mode
         arg <- goCached qs arg
         return $ \qst -> sbvToFPTerm @b (mode qst) (arg qst)
@@ -806,7 +800,7 @@
       goCachedIntermediate _ SymTerm {} = error "Should not happen"
       goCachedIntermediate _ ForallTerm {} = error "Should not happen"
       goCachedIntermediate _ ExistsTerm {} = error "Should not happen"
-  r <- introSupportedPrimConstraint t' $ goCached emptyQuantifiedSymbols t'
+  r <- goCached emptyQuantifiedSymbols t'
   m <- liftIO $ readIORef mapState
   constraint <- liftIO $ readIORef accumulatedDummyConstraints
   return (m, r, constraint)
@@ -859,9 +853,11 @@
     assocFuncs = (\(s, v) -> (s, ([], v))) <$> assoc
     goSingle :: (String, ([([SBVD.CV], SBVD.CV)], SBVD.CV)) -> PM.Model -> PM.Model
     goSingle (name, cv) m = case findStringToSymbol name mp of
-      Just (SomeTypedSymbol (s :: TypedSymbol knd r)) ->
-        withSymbolSupported s $
-          insertValue s (parseSMTModelResult 0 cv :: r) m
+      Just (SomeTypedSymbol (s@TypedSymbol {} :: TypedSymbol 'AnyKind r)) ->
+        insertValue
+          s
+          (parseSMTModelResult 0 cv :: r)
+          m
       Nothing ->
         error $
           "BUG: Please send a bug report. The model is not consistent with the "
diff --git a/src/Grisette/Internal/Backend/SymBiMap.hs b/src/Grisette/Internal/Backend/SymBiMap.hs
--- a/src/Grisette/Internal/Backend/SymBiMap.hs
+++ b/src/Grisette/Internal/Backend/SymBiMap.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE Strict #-}
 
@@ -43,7 +45,7 @@
     TypedSymbol (unTypedSymbol),
     castSomeTypedSymbol,
     typedConstantSymbol,
-    withConstantSymbolSupported,
+    pattern SupportedConstantTypedSymbol,
   )
 
 -- | A bidirectional map between symbolic Grisette terms and sbv terms.
@@ -80,11 +82,11 @@
 
 attachQuantifiedSymbolInfo ::
   (SExpr -> SExpr) -> TypedConstantSymbol a -> TypedConstantSymbol a
-attachQuantifiedSymbolInfo info tsym =
-  withConstantSymbolSupported tsym $
-    typedConstantSymbol $
-      mapIdentifier (mapMetadata info) $
-        unTypedSymbol tsym
+attachQuantifiedSymbolInfo info tsym@SupportedConstantTypedSymbol =
+  typedConstantSymbol $
+    mapIdentifier (mapMetadata info) $
+      unTypedSymbol tsym
+attachQuantifiedSymbolInfo _ _ = error "Should not happen"
 
 -- | Attach the next quantified symbol info to a symbol.
 attachNextQuantifiedSymbolInfo ::
diff --git a/src/Grisette/Internal/Core/Control/Monad/CBMCExcept.hs b/src/Grisette/Internal/Core/Control/Monad/CBMCExcept.hs
--- a/src/Grisette/Internal/Core/Control/Monad/CBMCExcept.hs
+++ b/src/Grisette/Internal/Core/Control/Monad/CBMCExcept.hs
@@ -395,16 +395,14 @@
 
 instance
   {-# OVERLAPPABLE #-}
-  ( GenSymSimple spec (m (CBMCEither a b))
-  ) =>
+  (GenSymSimple spec (m (CBMCEither a b))) =>
   GenSymSimple spec (CBMCExceptT a m b)
   where
   simpleFresh v = CBMCExceptT <$> simpleFresh v
 
 instance
   {-# OVERLAPPING #-}
-  ( GenSymSimple (m (CBMCEither e a)) (m (CBMCEither e a))
-  ) =>
+  (GenSymSimple (m (CBMCEither e a)) (m (CBMCEither e a))) =>
   GenSymSimple (CBMCExceptT e m a) (CBMCExceptT e m a)
   where
   simpleFresh (CBMCExceptT v) = CBMCExceptT <$> simpleFresh v
diff --git a/src/Grisette/Internal/Core/Data/Class/GenSym.hs b/src/Grisette/Internal/Core/Data/Class/GenSym.hs
--- a/src/Grisette/Internal/Core/Data/Class/GenSym.hs
+++ b/src/Grisette/Internal/Core/Data/Class/GenSym.hs
@@ -92,6 +92,7 @@
 import Data.Bifunctor (Bifunctor (first))
 import qualified Data.ByteString as B
 import Data.Int (Int16, Int32, Int64, Int8)
+import Data.List (groupBy, sortOn)
 import Data.Ratio (Ratio)
 import Data.String (IsString (fromString))
 import qualified Data.Text as T
@@ -112,7 +113,7 @@
     unionBase,
   )
 import Grisette.Internal.Core.Data.Class.Mergeable
-  ( Mergeable (rootStrategy),
+  ( Mergeable (rootStrategy, sortIndices),
     Mergeable1 (liftRootStrategy),
     Mergeable2 (liftRootStrategy2),
     MergingStrategy (SimpleStrategy),
@@ -456,8 +457,7 @@
     m (Union a)
   default fresh ::
     (GenSymSimple spec a) =>
-    ( MonadFresh m
-    ) =>
+    (MonadFresh m) =>
     spec ->
     m (Union a)
   fresh spec = mrgSingle <$> simpleFresh spec
@@ -491,8 +491,7 @@
   -- >>> runFresh (simpleFresh (SimpleListSpec 2 ())) "a" :: [SymBool]
   -- [a@0,a@1]
   simpleFresh ::
-    ( MonadFresh m
-    ) =>
+    (MonadFresh m) =>
     spec ->
     m a
 
@@ -507,8 +506,7 @@
 
 class GenSymNoSpec a where
   freshNoSpec ::
-    ( MonadFresh m
-    ) =>
+    (MonadFresh m) =>
     m (Union (a c))
 
 instance GenSymNoSpec U1 where
@@ -530,8 +528,7 @@
   where
   freshNoSpec ::
     forall m c.
-    ( MonadFresh m
-    ) =>
+    (MonadFresh m) =>
     m (Union ((a :+: b) c))
   freshNoSpec = do
     cond :: bool <- simpleFresh ()
@@ -545,8 +542,7 @@
   where
   freshNoSpec ::
     forall m c.
-    ( MonadFresh m
-    ) =>
+    (MonadFresh m) =>
     m (Union ((a :*: b) c))
   freshNoSpec = do
     l :: Union (a c) <- freshNoSpec
@@ -617,8 +613,7 @@
 
 class GenSymSameShape a where
   genSymSameShapeFresh ::
-    ( MonadFresh m
-    ) =>
+    (MonadFresh m) =>
     a c ->
     m (a c)
 
@@ -669,6 +664,51 @@
   m a
 derivedSameShapeSimpleFresh a = to <$> genSymSameShapeFresh (from a)
 
+genGuardsUnion :: (MonadFresh m, Mergeable a) => [Union a] -> m (Union a)
+genGuardsUnion [x] = return x
+genGuardsUnion (r : rs) = do
+  b <- simpleFresh ()
+  res <- genGuardsUnion rs
+  return $ mrgIf b r res
+genGuardsUnion [] = error "chooseFresh expects at least one value"
+
+genGuards :: (MonadFresh m, Mergeable a) => [a] -> m (Union a)
+genGuards [x] = return $ mrgSingle x
+genGuards (r : rs) = do
+  b <- simpleFresh ()
+  res <- genGuards rs
+  return $ mrgIf b (mrgSingle r) res
+genGuards [] = error "chooseFresh expects at least one value"
+
+genGuardsSimple :: (MonadFresh m, SimpleMergeable a) => [a] -> m a
+genGuardsSimple [x] = return x
+genGuardsSimple (r : rs) = do
+  b <- simpleFresh ()
+  res <- genGuardsSimple rs
+  return $ mrgIte b r res
+genGuardsSimple [] = error "chooseFresh expects at least one value"
+
+leveledChoose ::
+  (Monad m, Mergeable b1) =>
+  ([b2] -> m b2) -> ([b1] -> m b2) -> [b1] -> m b2
+leveledChoose gen gen' l = go 0 choicesWithIndices
+  where
+    indices = sortIndices <$> l
+    choicesWithIndices = sortOn snd $ zip l indices
+    go i l = do
+      let grouped =
+            groupBy
+              ( \(_, a) (_, b) ->
+                  (length a <= i && length b <= i) || a !! i == b !! i
+              )
+              l
+      allChoices <- traverse (go' i) grouped
+      gen allChoices
+    go' i l =
+      if length (snd $ head l) <= i
+        then gen' $ fst <$> l
+        else go (i + 1) l
+
 -- | Symbolically chooses one of the provided values.
 -- The procedure creates @n - 1@ fresh symbolic boolean variables every time it
 -- is evaluated, and use these variables to conditionally select one of the @n@
@@ -686,20 +726,14 @@
   ) =>
   [a] ->
   m (Union a)
-chooseFresh [x] = return $ mrgSingle x
-chooseFresh (r : rs) = do
-  b <- simpleFresh ()
-  res <- chooseFresh rs
-  return $ mrgIf b (mrgSingle r) res
-chooseFresh [] = error "chooseFresh expects at least one value"
+chooseFresh = leveledChoose genGuardsUnion genGuards
 
 -- | A wrapper for `chooseFresh` that executes the `MonadFresh` context.
 -- A globally unique identifier should be supplied to ensure the uniqueness of
 -- symbolic constants in the generated symbolic values.
 choose ::
   forall a.
-  ( Mergeable a
-  ) =>
+  (Mergeable a) =>
   [a] ->
   Identifier ->
   Union a
@@ -722,20 +756,14 @@
   ) =>
   [a] ->
   m a
-chooseSimpleFresh [x] = return x
-chooseSimpleFresh (r : rs) = do
-  b :: bool <- simpleFresh ()
-  res <- chooseSimpleFresh rs
-  return $ mrgIte b r res
-chooseSimpleFresh [] = error "chooseSimpleFresh expects at least one value"
+chooseSimpleFresh = leveledChoose genGuardsSimple genGuardsSimple
 
 -- | A wrapper for `chooseSimpleFresh` that executes the `MonadFresh` context.
 -- A globally unique identifier should be supplied to ensure the uniqueness of
 -- symbolic constants in the generated symbolic values.
 chooseSimple ::
   forall a.
-  ( SimpleMergeable a
-  ) =>
+  (SimpleMergeable a) =>
   [a] ->
   Identifier ->
   a
@@ -760,20 +788,14 @@
   ) =>
   [Union a] ->
   m (Union a)
-chooseUnionFresh [x] = return x
-chooseUnionFresh (r : rs) = do
-  b <- simpleFresh ()
-  res <- chooseUnionFresh rs
-  return $ mrgIf b r res
-chooseUnionFresh [] = error "chooseUnionFresh expects at least one value"
+chooseUnionFresh = leveledChoose genGuardsUnion genGuardsUnion
 
 -- | A wrapper for `chooseUnionFresh` that executes the `MonadFresh` context.
 -- A globally unique identifier should be supplied to ensure the uniqueness of
 -- symbolic constants in the generated symbolic values.
 chooseUnion ::
   forall a.
-  ( Mergeable a
-  ) =>
+  (Mergeable a) =>
   [Union a] ->
   Identifier ->
   Union a
@@ -1584,16 +1606,14 @@
 
 instance
   {-# OVERLAPPABLE #-}
-  ( GenSymSimple spec (m (Maybe a))
-  ) =>
+  (GenSymSimple spec (m (Maybe a))) =>
   GenSymSimple spec (MaybeT m a)
   where
   simpleFresh v = MaybeT <$> simpleFresh v
 
 instance
   {-# OVERLAPPING #-}
-  ( GenSymSimple (m (Maybe a)) (m (Maybe a))
-  ) =>
+  (GenSymSimple (m (Maybe a)) (m (Maybe a))) =>
   GenSymSimple (MaybeT m a) (MaybeT m a)
   where
   simpleFresh (MaybeT v) = MaybeT <$> simpleFresh v
@@ -1622,16 +1642,14 @@
 
 instance
   {-# OVERLAPPABLE #-}
-  ( GenSymSimple spec (m (Either a b))
-  ) =>
+  (GenSymSimple spec (m (Either a b))) =>
   GenSymSimple spec (ExceptT a m b)
   where
   simpleFresh v = ExceptT <$> simpleFresh v
 
 instance
   {-# OVERLAPPING #-}
-  ( GenSymSimple (m (Either e a)) (m (Either e a))
-  ) =>
+  (GenSymSimple (m (Either e a)) (m (Either e a))) =>
   GenSymSimple (ExceptT e m a) (ExceptT e m a)
   where
   simpleFresh (ExceptT v) = ExceptT <$> simpleFresh v
diff --git a/src/Grisette/Internal/Core/Data/Class/SymFiniteBits.hs b/src/Grisette/Internal/Core/Data/Class/SymFiniteBits.hs
--- a/src/Grisette/Internal/Core/Data/Class/SymFiniteBits.hs
+++ b/src/Grisette/Internal/Core/Data/Class/SymFiniteBits.hs
@@ -39,7 +39,7 @@
 import Data.Word (Word16, Word32, Word64, Word8)
 import GHC.TypeLits (KnownNat, type (<=))
 import Grisette.Internal.Core.Data.Class.BitVector
-  ( BV (bv, bvSelect),
+  ( BV (bv, bvConcat, bvSelect),
   )
 import Grisette.Internal.Core.Data.Class.ITEOp (ITEOp (symIte))
 import Grisette.Internal.Core.Data.Class.SymEq (SymEq ((.==)))
@@ -52,6 +52,7 @@
   )
 import Grisette.Internal.SymPrim.SymBV (SymIntN, SymWordN)
 import Grisette.Internal.SymPrim.SymBool (SymBool)
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | Set a bit in a concrete value to a specific value.
 setBitTo :: (Bits a) => a -> Int -> Bool -> a
@@ -152,10 +153,12 @@
   symFromBits bits
     | length bits /= finiteBitSize (undefined :: SymWordN n) =
         error "symFromBits: length mismatch"
-    | otherwise = foldl1 (.|.) lst
+    | otherwise = case foldl1 bvConcat $ SomeBV <$> reverse lst of
+        SomeBV r -> unsafeCoerce r
+        _ -> error "symFromBits: length mismatch"
     where
-      lst :: [SymIntN n]
-      lst = (\(pos, b) -> symIte b (setBit 0 pos) 0) <$> zip [0 ..] bits
+      lst :: [SymIntN 1]
+      lst = (\b -> symIte b 1 0) <$> bits
 
 instance (KnownNat n, 1 <= n) => SymFiniteBits (SymWordN n) where
   symTestBit v = symTestBit (SomeBV v)
@@ -163,10 +166,12 @@
   symFromBits bits
     | length bits /= finiteBitSize (undefined :: SymWordN n) =
         error "symFromBits: length mismatch"
-    | otherwise = foldl1 (.|.) lst
+    | otherwise = case foldl1 bvConcat $ SomeBV <$> reverse lst of
+        SomeBV r -> unsafeCoerce r
+        _ -> error "symFromBits: length mismatch"
     where
-      lst :: [SymWordN n]
-      lst = (\(pos, b) -> symIte b (setBit 0 pos) 0) <$> zip [0 ..] bits
+      lst :: [SymWordN 1]
+      lst = (\b -> symIte b 1 0) <$> bits
 
 -- | Bit-blast a symbolic value into a list of symbolic bits. The first element
 -- in the resulting list corresponds to the least significant bit.
@@ -183,13 +188,28 @@
 
 -- | Count the number of set bits in a symbolic value.
 symPopCount :: (Num a, ITEOp a, SymFiniteBits a) => a -> a
--- Node: v - v + is a trick to assign the correct bit-width to the result.
-symPopCount v = v - v + sum ((\b -> symIte b 1 0) <$> symBitBlast v)
+symPopCount v = 0 * v + adderTree (map fromBool (symBitBlast v))
+  where
+    -- Convert a symbolic boolean to a numeric value (0 or 1)
+    -- Node: 0 * v + is a trick to assign the correct bit-width to the result.
+    fromBool b = 0 * v + symIte b 1 0
 
+    -- Implement binary adder tree to efficiently sum values
+    adderTree :: (Num a) => [a] -> a
+    adderTree [] = 0
+    adderTree [x] = x
+    adderTree xs = adderTree (pairwiseAdd xs)
+
+    -- Add adjacent pairs of values
+    pairwiseAdd :: (Num a) => [a] -> [a]
+    pairwiseAdd [] = []
+    pairwiseAdd [x] = [x]
+    pairwiseAdd (x : y : rest) = (x + y) : pairwiseAdd rest
+
 -- | Count the number of leading zeros in a symbolic value.
 symCountLeadingZeros :: (Num a, ITEOp a, SymFiniteBits a) => a -> a
--- Node: v - v + is a trick to assign the correct bit-width to the result.
-symCountLeadingZeros v = v - v + go bits rs
+-- Node: 0 * v + is a trick to assign the correct bit-width to the result.
+symCountLeadingZeros v = 0 * v + go bits rs
   where
     bits = reverse $ symBitBlast v
     rs = fromIntegral <$> [0 ..]
@@ -199,8 +219,8 @@
 
 -- | Count the number of trailing zeros in a symbolic value.
 symCountTrailingZeros :: (Num a, ITEOp a, SymFiniteBits a) => a -> a
--- Node: v - v + is a trick to assign the correct bit-width to the result.
-symCountTrailingZeros v = v - v + go bits rs
+-- Node: 0 * v + is a trick to assign the correct bit-width to the result.
+symCountTrailingZeros v = 0 * v + go bits rs
   where
     bits = symBitBlast v
     rs = fromIntegral <$> [0 ..]
diff --git a/src/Grisette/Internal/Core/Data/Symbol.hs b/src/Grisette/Internal/Core/Data/Symbol.hs
--- a/src/Grisette/Internal/Core/Data/Symbol.hs
+++ b/src/Grisette/Internal/Core/Data/Symbol.hs
@@ -6,10 +6,12 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 -- |
@@ -32,6 +34,8 @@
     indexed,
     symbolIdentifier,
     mapIdentifier,
+    AsMetadata (..),
+    pattern Metadata,
   )
 where
 
@@ -113,6 +117,23 @@
 instance IsString Identifier where
   fromString i = Identifier (T.pack i) $ List []
 
+-- | A type class for embedding a type into a metadata represented as an
+-- S-expression.
+class AsMetadata a where
+  asMetadata :: a -> SExpr
+  fromMetadata :: SExpr -> Maybe a
+
+-- | A pattern for extracting a value from a metadata represented as an
+-- S-expression.
+pattern Metadata :: (AsMetadata a) => a -> SExpr
+pattern Metadata m <- (fromMetadata -> Just m)
+  where
+    Metadata m = asMetadata m
+
+instance AsMetadata SExpr where
+  asMetadata = id
+  fromMetadata = Just
+
 -- | Simple identifier.
 -- The same identifier refers to the same symbolic variable in the whole
 -- program.
@@ -129,16 +150,17 @@
 --
 -- The user may need to use unique identifiers or additional metadata to
 -- avoid unintentional identifier collision.
-withMetadata :: T.Text -> SExpr -> Identifier
-withMetadata = Identifier
+withMetadata :: (AsMetadata a) => T.Text -> a -> Identifier
+withMetadata ident meta = Identifier ident (asMetadata meta)
 
 -- | Identifier with the file location.
 withLocation :: T.Text -> SpliceQ Identifier
 withLocation nm = [||withMetadata nm $$fileLocation||]
 
 -- | Modify the metadata of an identifier.
-mapMetadata :: (SExpr -> SExpr) -> Identifier -> Identifier
-mapMetadata f (Identifier i m) = Identifier i (f m)
+mapMetadata ::
+  (AsMetadata a) => (SExpr -> a) -> Identifier -> Identifier
+mapMetadata f (Identifier i m) = Identifier i (asMetadata $ f m)
 
 identifierCount :: IORef Int
 identifierCount = unsafePerformIO $ newIORef 0
diff --git a/src/Grisette/Internal/Internal/Decl/Core/Control/Monad/Union.hs b/src/Grisette/Internal/Internal/Decl/Core/Control/Monad/Union.hs
--- a/src/Grisette/Internal/Internal/Decl/Core/Control/Monad/Union.hs
+++ b/src/Grisette/Internal/Internal/Decl/Core/Control/Monad/Union.hs
@@ -30,16 +30,17 @@
 
 import Data.String (IsString (fromString))
 import Grisette.Internal.Core.Data.Class.PlainUnion
-  ( PlainUnion (ifView, singleView),
+  ( PlainUnion (ifView, singleView, toGuardedList),
   )
 import Grisette.Internal.Core.Data.Class.Solvable
   ( Solvable (con, conView, sym),
     pattern Con,
   )
 import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
-  ( Mergeable (rootStrategy),
+  ( Mergeable (rootStrategy, sortIndices),
     Mergeable1 (liftRootStrategy),
     MergingStrategy (SimpleStrategy),
+    resolveStrategy,
     rootStrategy1,
   )
 import Grisette.Internal.Internal.Decl.Core.Data.Class.SimpleMergeable
@@ -229,6 +230,7 @@
 instance (Mergeable a) => Mergeable (Union a) where
   rootStrategy = rootStrategy1
   {-# INLINE rootStrategy #-}
+  sortIndices = fst . resolveStrategy rootStrategy . snd . head . toGuardedList
 
 instance (Mergeable a) => SimpleMergeable (Union a) where
   mrgIte = mrgIf
diff --git a/src/Grisette/Internal/Internal/Decl/Core/Data/Class/Mergeable.hs b/src/Grisette/Internal/Internal/Decl/Core/Data/Class/Mergeable.hs
--- a/src/Grisette/Internal/Internal/Decl/Core/Data/Class/Mergeable.hs
+++ b/src/Grisette/Internal/Internal/Decl/Core/Data/Class/Mergeable.hs
@@ -205,6 +205,9 @@
   -- | The root merging strategy for the type.
   rootStrategy :: MergingStrategy a
 
+  sortIndices :: a -> [DynamicSortedIdx]
+  sortIndices = fst . resolveStrategy rootStrategy
+
 -- | Lifting of the 'Mergeable' class to unary type constructors.
 class
   (forall a. (Mergeable a) => Mergeable (u a)) =>
diff --git a/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SimpleMergeable.hs b/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SimpleMergeable.hs
--- a/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SimpleMergeable.hs
+++ b/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SimpleMergeable.hs
@@ -68,7 +68,8 @@
 import Grisette.Internal.Internal.Decl.Core.Data.Class.TryMerge
   ( TryMerge (tryMergeWithStrategy),
   )
-import Grisette.Internal.SymPrim.SymBool (SymBool)
+import Grisette.Internal.SymPrim.Prim.Internal.Term (SupportedPrim (pevalITETerm))
+import Grisette.Internal.SymPrim.SymBool (SymBool (SymBool))
 import Grisette.Internal.Utils.Derive (Arity0, Arity1)
 
 -- $setup
@@ -301,5 +302,9 @@
 {-# INLINE mrgIf #-}
 
 instance SimpleMergeable SymBool where
-  mrgIte = symIte
+  mrgIte (SymBool c) (SymBool t) (SymBool f) = SymBool $ pevalITETerm c t f
   {-# INLINE mrgIte #-}
+
+instance {-# OVERLAPPABLE #-} (SimpleMergeable a) => ITEOp a where
+  symIte = mrgIte
+  {-# INLINE symIte #-}
diff --git a/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SymEq.hs b/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SymEq.hs
--- a/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SymEq.hs
+++ b/src/Grisette/Internal/Internal/Decl/Core/Data/Class/SymEq.hs
@@ -100,7 +100,7 @@
 -- >>> a .== b
 -- (= a b)
 -- >>> a ./= b
--- (distinct a b)
+-- (! (= a b))
 --
 -- __Note:__ This type class can be derived for algebraic data types.
 -- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Control/Monad/Union.hs b/src/Grisette/Internal/Internal/Impl/Core/Control/Monad/Union.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Control/Monad/Union.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Control/Monad/Union.hs
@@ -414,7 +414,7 @@
   abs = tryMerge . unionUnaryOp abs
   signum = tryMerge . unionUnaryOp signum
 
-instance (ITEOp a, Mergeable a) => ITEOp (Union a) where
+instance (Mergeable a) => ITEOp (Union a) where
   symIte = mrgIf
 
 instance (LogicalOp a, Mergeable a) => LogicalOp (Union a) where
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/EvalSym.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/EvalSym.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/EvalSym.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/EvalSym.hs
@@ -100,7 +100,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
 import Grisette.Internal.SymPrim.TabularFun (type (=->) (TabularFun))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 #define CONCRETE_EVALUATESYM(type) \
 instance EvalSym type where \
@@ -184,7 +184,7 @@
   evalSym fillDefault model (SymFP t) =
     SymFP $ evalTerm fillDefault model HS.empty t
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
@@ -192,7 +192,7 @@
   ]
   [''EvalSym]
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -211,7 +211,7 @@
   ]
   [''EvalSym, ''EvalSym1, ''EvalSym2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ExtractSym.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ExtractSym.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ExtractSym.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ExtractSym.hs
@@ -106,7 +106,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
 import Grisette.Internal.SymPrim.TabularFun (type (=->) (TabularFun))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 -- $setup
 -- >>> import Grisette.Core
@@ -212,7 +212,7 @@
       Left HRefl -> SymbolSet <$> extractTerm HS.empty t
       Right HRefl -> SymbolSet <$> extractTerm HS.empty t
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
@@ -220,7 +220,7 @@
   ]
   [''ExtractSym]
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -239,7 +239,7 @@
   ]
   [''ExtractSym, ''ExtractSym1, ''ExtractSym2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Mergeable.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Mergeable.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Mergeable.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Mergeable.hs
@@ -118,7 +118,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger)
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>))
 import Grisette.Internal.SymPrim.TabularFun (type (=->))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 import Unsafe.Coerce (unsafeCoerce)
 
 #define CONCRETE_ORD_MERGEABLE(type) \
@@ -276,13 +276,13 @@
 instance Mergeable () where
   rootStrategy = SimpleStrategy $ \_ t _ -> t
 
-deriveGADT
+derive
   [ ''Either,
     ''(,)
   ]
   [''Mergeable, ''Mergeable1, ''Mergeable2]
 
-deriveGADT
+derive
   [ ''(,,),
     ''(,,,),
     ''(,,,,),
@@ -299,7 +299,7 @@
   ]
   [''Mergeable, ''Mergeable1, ''Mergeable2, ''Mergeable3]
 
-deriveGADT
+derive
   [ ''Maybe,
     ''Identity,
     ''Monoid.Dual,
@@ -317,7 +317,7 @@
   ]
   [''Mergeable, ''Mergeable1]
 
-deriveGADT
+derive
   [ ''AssertionError,
     ''VerificationConditions,
     ''NotRepresentableFPError,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/PPrint.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/PPrint.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/PPrint.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/PPrint.hs
@@ -86,11 +86,12 @@
     ValidFP,
   )
 import Grisette.Internal.SymPrim.GeneralFun (type (-->))
-import Grisette.Internal.SymPrim.Prim.Internal.Term ()
+import Grisette.Internal.SymPrim.Prim.Internal.Term (Term)
 import Grisette.Internal.SymPrim.Prim.Model
   ( Model (Model),
     SymbolSet (SymbolSet),
   )
+import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm))
 import Grisette.Internal.SymPrim.Prim.Term
   ( ModelValue,
     SomeTypedSymbol (SomeTypedSymbol),
@@ -111,7 +112,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
 import Grisette.Internal.SymPrim.TabularFun (type (=->))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 #define FORMAT_SIMPLE(type) \
 instance PPrint type where pformatPrec = viaShowsPrec showsPrec
@@ -174,6 +175,12 @@
 instance PPrint (a --> b) where
   pformat = viaShow
 
+instance PPrint (Term t) where
+  pformat = prettyPrintTerm
+
+instance PPrint SomeTerm where
+  pformat (SomeTerm t) = prettyPrintTerm t
+
 -- Prettyprint
 #define FORMAT_SYM_SIMPLE(symtype) \
 instance PPrint symtype where \
@@ -201,7 +208,7 @@
 instance (ValidFP eb sb) => PPrint (SymFP eb sb) where
   pformat (SymFP t) = prettyPrintTerm t
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
@@ -209,7 +216,7 @@
   ]
   [''PPrint]
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -228,7 +235,7 @@
   ]
   [''PPrint, ''PPrint1, ''PPrint2]
 
-deriveGADT
+derive
   [ ''Maybe,
     ''Monoid.Dual,
     ''Monoid.First,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SimpleMergeable.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SimpleMergeable.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SimpleMergeable.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SimpleMergeable.hs
@@ -42,6 +42,7 @@
 import Data.Functor.Compose (Compose (Compose))
 import Data.Functor.Const (Const)
 import Data.Functor.Product (Product)
+import qualified Data.HashSet as HS
 import Data.Monoid (Alt, Ap, Endo (Endo))
 import qualified Data.Monoid as Monoid
 import Data.Ord (Down)
@@ -59,7 +60,6 @@
 import GHC.TypeNats (KnownNat, type (<=))
 import Generics.Deriving (Default (Default), Default1 (Default1))
 import Grisette.Internal.Core.Control.Exception (AssertionError)
-import Grisette.Internal.Core.Data.Class.ITEOp (ITEOp (symIte))
 import Grisette.Internal.Core.Data.Class.Mergeable
   ( Mergeable (rootStrategy),
     Mergeable1 (liftRootStrategy),
@@ -77,24 +77,28 @@
   )
 import Grisette.Internal.Internal.Impl.Core.Data.Class.TryMerge ()
 import Grisette.Internal.SymPrim.FP (ValidFP)
-import Grisette.Internal.SymPrim.GeneralFun (type (-->))
-import Grisette.Internal.SymPrim.SymAlgReal (SymAlgReal)
+import Grisette.Internal.SymPrim.GeneralFun (freshArgSymbol, substTerm, type (-->) (GeneralFun))
+import Grisette.Internal.SymPrim.Prim.Internal.Term (SupportedPrim (pevalITETerm), symTerm)
+import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm))
+import Grisette.Internal.SymPrim.Prim.Term (TypedConstantSymbol)
+import Grisette.Internal.SymPrim.SymAlgReal (SymAlgReal (SymAlgReal))
 import Grisette.Internal.SymPrim.SymBV
-  ( SymIntN,
-    SymWordN,
+  ( SymIntN (SymIntN),
+    SymWordN (SymWordN),
   )
-import Grisette.Internal.SymPrim.SymFP (SymFP, SymFPRoundingMode)
-import Grisette.Internal.SymPrim.SymGeneralFun (type (-~>))
-import Grisette.Internal.SymPrim.SymInteger (SymInteger)
-import Grisette.Internal.SymPrim.SymTabularFun (type (=~>))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.SymPrim.SymBool (SymBool (SymBool))
+import Grisette.Internal.SymPrim.SymFP (SymFP (SymFP), SymFPRoundingMode (SymFPRoundingMode))
+import Grisette.Internal.SymPrim.SymGeneralFun (type (-~>) (SymGeneralFun))
+import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
+import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 -- $setup
 -- >>> import Grisette.Core
 -- >>> import Grisette.SymPrim
 -- >>> import Control.Monad.Identity
 
-deriveGADT
+derive
   [ ''(,),
     ''(,,),
     ''(,,,),
@@ -112,7 +116,7 @@
   ]
   [''SimpleMergeable, ''SimpleMergeable1, ''SimpleMergeable2]
 
-deriveGADT
+derive
   [ ''Identity,
     ''Monoid.Dual,
     ''Monoid.Sum,
@@ -121,7 +125,7 @@
   ]
   [''SimpleMergeable, ''SimpleMergeable1]
 
-deriveGADT
+derive
   [''(), ''AssertionError]
   [''SimpleMergeable]
 
@@ -532,17 +536,17 @@
 
 #define SIMPLE_MERGEABLE_SIMPLE(symtype) \
 instance SimpleMergeable symtype where \
-  mrgIte = symIte; \
+  mrgIte (SymBool c) (symtype t) (symtype f) = symtype $ pevalITETerm c t f; \
   {-# INLINE mrgIte #-}
 
 #define SIMPLE_MERGEABLE_BV(symtype) \
 instance (KnownNat n, 1 <= n) => SimpleMergeable (symtype n) where \
-  mrgIte = symIte; \
+  mrgIte (SymBool c) (symtype t) (symtype f) = symtype $ pevalITETerm c t f; \
   {-# INLINE mrgIte #-}
 
-#define SIMPLE_MERGEABLE_FUN(cop, op) \
+#define SIMPLE_MERGEABLE_FUN(cop, op, cons) \
 instance SimpleMergeable (op sa sb) where \
-  mrgIte = symIte; \
+  mrgIte (SymBool c) (cons t) (cons f) = cons $ pevalITETerm c t f; \
   {-# INLINE mrgIte #-}
 
 #if 1
@@ -551,14 +555,25 @@
 SIMPLE_MERGEABLE_SIMPLE(SymAlgReal)
 SIMPLE_MERGEABLE_BV(SymIntN)
 SIMPLE_MERGEABLE_BV(SymWordN)
-SIMPLE_MERGEABLE_FUN((=->), (=~>))
-SIMPLE_MERGEABLE_FUN((-->), (-~>))
+SIMPLE_MERGEABLE_FUN((=->), (=~>), SymTabularFun)
+SIMPLE_MERGEABLE_FUN((-->), (-~>), SymGeneralFun)
 #endif
 
 instance SimpleMergeable (a --> b) where
-  mrgIte = symIte
+  mrgIte
+    (SymBool c)
+    (GeneralFun (ta :: TypedConstantSymbol a) a)
+    (GeneralFun tb b) =
+      GeneralFun argSymbol $
+        pevalITETerm
+          c
+          (substTerm ta (symTerm argSymbol) HS.empty a)
+          (substTerm tb (symTerm argSymbol) HS.empty b)
+      where
+        argSymbol :: TypedConstantSymbol a
+        argSymbol = freshArgSymbol [SomeTerm a, SomeTerm b]
   {-# INLINE mrgIte #-}
 
 instance (ValidFP eb sb) => SimpleMergeable (SymFP eb sb) where
-  mrgIte = symIte
+  mrgIte (SymBool c) (SymFP t) (SymFP f) = SymFP $ pevalITETerm c t f
   {-# INLINE mrgIte #-}
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Solver.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Solver.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Solver.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/Solver.hs
@@ -36,7 +36,7 @@
 import Grisette.Internal.Internal.Decl.Core.Data.Class.PPrint (PPrint)
 import Grisette.Internal.Internal.Decl.Core.Data.Class.Solver (SolvingFailure)
 import Grisette.Internal.Internal.Impl.Core.Data.Class.PPrint ()
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 -- $setup
 -- >>> import Grisette
@@ -44,7 +44,7 @@
 -- >>> import Grisette.SymPrim
 -- >>> import Grisette.Backend
 
-deriveGADT
+derive
   [''SolvingFailure]
   [ ''Show,
     ''Eq,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SubstSym.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SubstSym.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SubstSym.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SubstSym.hs
@@ -99,7 +99,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
 import Grisette.Internal.SymPrim.TabularFun (type (=->) (TabularFun))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 #define CONCRETE_SUBSTITUTESYM(type) \
 instance SubstSym type where \
@@ -181,7 +181,7 @@
 instance (ValidFP eb sb) => SubstSym (SymFP eb sb) where
   substSym sym v (SymFP t) = SymFP $ substTerm sym (underlyingTerm v) HS.empty t
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
@@ -189,7 +189,7 @@
   ]
   [''SubstSym]
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -208,7 +208,7 @@
   ]
   [''SubstSym, ''SubstSym1, ''SubstSym2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymEq.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymEq.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymEq.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymEq.hs
@@ -92,7 +92,7 @@
     SymFPRoundingMode (SymFPRoundingMode),
   )
 import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 #define CONCRETE_SEQ(type) \
 instance SymEq type where \
@@ -183,7 +183,7 @@
   (SymFP l) .== (SymFP r) = SymBool $ pevalEqTerm l r
   {-# INLINE (.==) #-}
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
@@ -191,7 +191,7 @@
   ]
   [''SymEq]
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -210,7 +210,7 @@
   ]
   [''SymEq, ''SymEq1, ''SymEq2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymOrd.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymOrd.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymOrd.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/SymOrd.hs
@@ -103,7 +103,7 @@
     SymFPRoundingMode (SymFPRoundingMode),
   )
 import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 #define CONCRETE_SORD(type) \
 instance SymOrd type where \
@@ -286,7 +286,7 @@
     y1 <- y
     f x1 y1
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
@@ -294,7 +294,7 @@
   ]
   [''SymOrd]
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -313,7 +313,7 @@
   ]
   [''SymOrd, ''SymOrd1, ''SymOrd2]
 
-deriveGADT
+derive
   [ ''Maybe,
     ''Identity,
     ''Monoid.Dual,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToCon.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToCon.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToCon.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToCon.hs
@@ -107,7 +107,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger)
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
 import Grisette.Internal.SymPrim.TabularFun (type (=->))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 -- $setup
 -- >>> import Grisette.Core
@@ -247,7 +247,7 @@
       _ -> Nothing
   toCon _ = Nothing
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -266,7 +266,7 @@
   ]
   [''ToCon, ''ToCon1, ''ToCon2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Monoid.Dual,
@@ -282,7 +282,7 @@
   ]
   [''ToCon, ''ToCon1]
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
diff --git a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToSym.hs b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToSym.hs
--- a/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToSym.hs
+++ b/src/Grisette/Internal/Internal/Impl/Core/Data/Class/ToSym.hs
@@ -112,7 +112,7 @@
 import Grisette.Internal.SymPrim.SymInteger (SymInteger)
 import Grisette.Internal.SymPrim.SymTabularFun (type (=~>))
 import Grisette.Internal.SymPrim.TabularFun (type (=->))
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 -- $setup
 -- >>> import Grisette.SymPrim
@@ -258,7 +258,7 @@
   liftToSym l f = l . f . toSym
   {-# INLINE liftToSym #-}
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -277,7 +277,7 @@
   ]
   [''ToSym, ''ToSym1, ''ToSym2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Monoid.Dual,
@@ -293,7 +293,7 @@
   ]
   [''ToSym, ''ToSym1]
 
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions,
diff --git a/src/Grisette/Internal/Internal/Impl/SymPrim/AllSyms.hs b/src/Grisette/Internal/Internal/Impl/SymPrim/AllSyms.hs
--- a/src/Grisette/Internal/Internal/Impl/SymPrim/AllSyms.hs
+++ b/src/Grisette/Internal/Internal/Impl/SymPrim/AllSyms.hs
@@ -60,7 +60,7 @@
 import Grisette.Internal.SymPrim.AlgReal (AlgReal)
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
 import Grisette.Internal.SymPrim.FP (FP, FPRoundingMode, ValidFP)
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 
 -- $setup
 -- >>> import Grisette.Core
@@ -68,7 +68,7 @@
 -- >>> import Grisette.Backend
 -- >>> import Data.Proxy
 
-deriveGADT
+derive
   [ ''Either,
     ''(,),
     ''(,,),
@@ -86,7 +86,7 @@
     ''(,,,,,,,,,,,,,,)
   ]
   [''AllSyms, ''AllSyms1, ''AllSyms2]
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
@@ -96,7 +96,7 @@
     ''WriterStrict.WriterT
   ]
   [''AllSyms, ''AllSyms1]
-deriveGADT
+derive
   [ ''(),
     ''AssertionError,
     ''VerificationConditions
diff --git a/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSimpleMergeable.hs b/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSimpleMergeable.hs
--- a/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSimpleMergeable.hs
+++ b/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSimpleMergeable.hs
@@ -69,7 +69,7 @@
     UnifiedSimpleMergeable1 (withBaseSimpleMergeable1),
     UnifiedSimpleMergeable2 (withBaseSimpleMergeable2),
   )
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT)
+import Grisette.Internal.TH.Derivation.Derive (derive)
 import Grisette.Internal.Unified.BaseMonad (BaseMonad)
 import Grisette.Internal.Unified.EvalModeTag (IsConMode)
 import Grisette.Internal.Unified.UnifiedBool (UnifiedBool (GetBool))
@@ -256,7 +256,7 @@
   withBaseSimpleMergeable2 r = r
   {-# INLINE withBaseSimpleMergeable2 #-}
 
-deriveGADT
+derive
   [ ''(,),
     ''(,,),
     ''(,,,),
@@ -277,11 +277,11 @@
     ''UnifiedSimpleMergeable2
   ]
 
-deriveGADT
+derive
   [''Identity]
   [''UnifiedSimpleMergeable, ''UnifiedSimpleMergeable1]
 
-deriveGADT
+derive
   [''(), ''AssertionError]
   [''UnifiedSimpleMergeable]
 
diff --git a/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymEq.hs b/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymEq.hs
--- a/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymEq.hs
+++ b/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymEq.hs
@@ -66,10 +66,10 @@
   )
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
 import Grisette.Internal.SymPrim.FP (FP, FPRoundingMode)
-import Grisette.Internal.TH.GADT.Common
+import Grisette.Internal.TH.Derivation.Common
   ( DeriveConfig (bitSizePositions, fpBitSizePositions),
   )
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT, deriveGADTWith)
+import Grisette.Internal.TH.Derivation.Derive (derive, deriveWith)
 import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (S), IsConMode)
 import Grisette.Internal.Unified.UnifiedBool (UnifiedBool (GetBool))
 import Grisette.Internal.Unified.Util (DecideEvalMode, withMode)
@@ -229,13 +229,13 @@
   withBaseSymEq r = withBaseSymEq @'S @v r
   {-# INLINE withBaseSymEq #-}
 
-deriveGADT
+derive
   [ ''Either,
     ''(,)
   ]
   [''UnifiedSymEq, ''UnifiedSymEq1, ''UnifiedSymEq2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
@@ -246,7 +246,7 @@
   ]
   [''UnifiedSymEq, ''UnifiedSymEq1]
 
-deriveGADT
+derive
   [ ''Bool,
     ''Integer,
     ''Char,
@@ -284,25 +284,25 @@
   [''UnifiedSymEq]
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADT
+derive
   [ ''(,,),
     ''(,,,)
   ]
   [''UnifiedSymEq, ''UnifiedSymEq1, ''UnifiedSymEq2]
 #else
-deriveGADT
+derive
   [ ''(,,),
     ''(,,,)
   ]
   [''UnifiedSymEq]
 #endif
 
-deriveGADTWith
+deriveWith
   (mempty {bitSizePositions = [0]})
   [''WordN, ''IntN]
   [''UnifiedSymEq]
 
-deriveGADTWith
+deriveWith
   (mempty {fpBitSizePositions = [(0, 1)]})
   [''FP]
   [''UnifiedSymEq]
diff --git a/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymOrd.hs b/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymOrd.hs
--- a/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymOrd.hs
+++ b/src/Grisette/Internal/Internal/Impl/Unified/Class/UnifiedSymOrd.hs
@@ -85,10 +85,10 @@
   )
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
 import Grisette.Internal.SymPrim.FP (FP, FPRoundingMode)
-import Grisette.Internal.TH.GADT.Common
+import Grisette.Internal.TH.Derivation.Common
   ( DeriveConfig (bitSizePositions, fpBitSizePositions),
   )
-import Grisette.Internal.TH.GADT.DeriveGADT (deriveGADT, deriveGADTWith)
+import Grisette.Internal.TH.Derivation.Derive (derive, deriveWith)
 import Grisette.Internal.Unified.BaseMonad (BaseMonad)
 import Grisette.Internal.Unified.EvalModeTag
   ( EvalModeTag (S),
@@ -363,13 +363,13 @@
   withBaseSymOrd r = withBaseSymOrd @'S @v r
   {-# INLINE withBaseSymOrd #-}
 
-deriveGADT
+derive
   [ ''Either,
     ''(,)
   ]
   [''UnifiedSymOrd, ''UnifiedSymOrd1, ''UnifiedSymOrd2]
 
-deriveGADT
+derive
   [ ''[],
     ''Maybe,
     ''Identity,
@@ -380,7 +380,7 @@
   ]
   [''UnifiedSymOrd, ''UnifiedSymOrd1]
 
-deriveGADT
+derive
   [ ''Bool,
     ''Integer,
     ''Char,
@@ -417,25 +417,25 @@
   [''UnifiedSymOrd]
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADT
+derive
   [ ''(,,),
     ''(,,,)
   ]
   [''UnifiedSymOrd, ''UnifiedSymOrd1, ''UnifiedSymOrd2]
 #else
-deriveGADT
+derive
   [ ''(,,),
     ''(,,,)
   ]
   [''UnifiedSymOrd]
 #endif
 
-deriveGADTWith
+deriveWith
   (mempty {bitSizePositions = [0]})
   [''WordN, ''IntN]
   [''UnifiedSymOrd]
 
-deriveGADTWith
+deriveWith
   (mempty {fpBitSizePositions = [(0, 1)]})
   [''FP]
   [''UnifiedSymOrd]
diff --git a/src/Grisette/Internal/SymPrim/FunInstanceGen.hs b/src/Grisette/Internal/SymPrim/FunInstanceGen.hs
--- a/src/Grisette/Internal/SymPrim/FunInstanceGen.hs
+++ b/src/Grisette/Internal/SymPrim/FunInstanceGen.hs
@@ -22,7 +22,6 @@
   )
 where
 
-import Data.Hashable (Hashable)
 import qualified Data.SBV as SBV
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( IsSymbolKind,
@@ -73,7 +72,7 @@
   ( plainTVInferred,
     plainTVSpecified,
   )
-import Type.Reflection (TypeRep, Typeable, typeRep, type (:~~:) (HRefl))
+import Type.Reflection (TypeRep, typeRep, type (:~~:) (HRefl))
 
 instanceWithOverlapDescD ::
   Maybe Overlap -> Q Cxt -> Q Type -> [DecsQ] -> DecsQ
@@ -219,17 +218,7 @@
           |]
 
       constraints =
-        fmap concat
-          . traverse
-            ( \ty ->
-                sequence
-                  [ [t|SupportedNonFuncPrim $ty|],
-                    [t|Eq $ty|],
-                    [t|Show $ty|],
-                    [t|Hashable $ty|],
-                    [t|Typeable $ty|]
-                  ]
-            )
+        fmap concat . traverse (\ty -> sequence [[t|SupportedNonFuncPrim $ty|]])
       funType =
         foldl1 (\fty ty -> [t|$(varT funTypeName) $ty $fty|]) . reverse
       withPrims :: [Q Type] -> Q Exp
@@ -265,5 +254,5 @@
             funNamePrefix
             funTypeName
             n
-          | n <- [2 .. numArg]
+        | n <- [2 .. numArg]
         ]
diff --git a/src/Grisette/Internal/SymPrim/GeneralFun.hs b/src/Grisette/Internal/SymPrim/GeneralFun.hs
--- a/src/Grisette/Internal/SymPrim/GeneralFun.hs
+++ b/src/Grisette/Internal/SymPrim/GeneralFun.hs
@@ -37,16 +37,14 @@
 where
 
 #if MIN_VERSION_base(4,20,0)
-import Data.Foldable (Foldable (toList))
 #else
-import Data.Foldable (Foldable (foldl', toList))
+import Data.Foldable (Foldable (foldl'))
 #endif
 
 import Control.DeepSeq (NFData (rnf))
 import Data.Bifunctor (Bifunctor (second))
 import qualified Data.HashSet as HS
 import Data.Hashable (Hashable (hashWithSalt))
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Maybe (fromJust)
 import qualified Data.SBV as SBV
 import qualified Data.SBV.Dynamic as SBVD
@@ -59,14 +57,7 @@
   ( Symbol (IndexedSymbol),
   )
 import Grisette.Internal.SymPrim.FunInstanceGen (supportedPrimFunUpTo)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
-  ( pevalFPBinaryTerm,
-    pevalFPFMATerm,
-    pevalFPRoundingBinaryTerm,
-    pevalFPRoundingUnaryTerm,
-    pevalFPTraitTerm,
-    pevalFPUnaryTerm,
-  )
+import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP ()
 import Grisette.Internal.SymPrim.Prim.Internal.PartialEval (totalize2)
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( IsSymbolKind,
@@ -87,6 +78,14 @@
       ( pevalDivIntegralTerm,
         pevalModIntegralTerm
       ),
+    PEvalFPTerm
+      ( pevalFPBinaryTerm,
+        pevalFPFMATerm,
+        pevalFPRoundingBinaryTerm,
+        pevalFPRoundingUnaryTerm,
+        pevalFPTraitTerm,
+        pevalFPUnaryTerm
+      ),
     PEvalFloatingTerm (pevalFloatingUnaryTerm, pevalPowerTerm),
     PEvalFractionalTerm (pevalFdivTerm, pevalRecipTerm),
     PEvalFromIntegralTerm (pevalFromIntegralTerm),
@@ -117,56 +116,7 @@
     SupportedPrimConstraint (PrimConstraint),
     SymRep (SymType),
     SymbolKind (AnyKind),
-    Term
-      ( AbsNumTerm,
-        AddNumTerm,
-        AndBitsTerm,
-        AndTerm,
-        ApplyTerm,
-        BVConcatTerm,
-        BVExtendTerm,
-        BVSelectTerm,
-        BitCastOrTerm,
-        BitCastTerm,
-        ComplementBitsTerm,
-        ConTerm,
-        DistinctTerm,
-        DivIntegralTerm,
-        EqTerm,
-        ExistsTerm,
-        FPBinaryTerm,
-        FPFMATerm,
-        FPRoundingBinaryTerm,
-        FPRoundingUnaryTerm,
-        FPTraitTerm,
-        FPUnaryTerm,
-        FdivTerm,
-        FloatingUnaryTerm,
-        ForallTerm,
-        FromFPOrTerm,
-        FromIntegralTerm,
-        ITETerm,
-        LeOrdTerm,
-        LtOrdTerm,
-        ModIntegralTerm,
-        MulNumTerm,
-        NegNumTerm,
-        NotTerm,
-        OrBitsTerm,
-        OrTerm,
-        PowerTerm,
-        QuotIntegralTerm,
-        RecipTerm,
-        RemIntegralTerm,
-        RotateLeftTerm,
-        RotateRightTerm,
-        ShiftLeftTerm,
-        ShiftRightTerm,
-        SignumNumTerm,
-        SymTerm,
-        ToFPTerm,
-        XorBitsTerm
-      ),
+    Term,
     TypedAnySymbol,
     TypedConstantSymbol,
     TypedSymbol,
@@ -175,7 +125,6 @@
     eqHeteroSymbol,
     existsTerm,
     forallTerm,
-    introSupportedPrimConstraint,
     partitionCVArg,
     pevalAndTerm,
     pevalEqTerm,
@@ -191,9 +140,57 @@
     translateTypeError,
     typedAnySymbol,
     typedConstantSymbol,
-    withConstantSymbolSupported,
-    withSymbolSupported,
+    pattern AbsNumTerm,
+    pattern AddNumTerm,
+    pattern AndBitsTerm,
+    pattern AndTerm,
+    pattern ApplyTerm,
+    pattern BVConcatTerm,
+    pattern BVExtendTerm,
+    pattern BVSelectTerm,
+    pattern BitCastOrTerm,
+    pattern BitCastTerm,
+    pattern ComplementBitsTerm,
+    pattern ConTerm,
+    pattern DistinctTerm,
+    pattern DivIntegralTerm,
+    pattern EqTerm,
+    pattern ExistsTerm,
+    pattern FPBinaryTerm,
+    pattern FPFMATerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPTraitTerm,
+    pattern FPUnaryTerm,
+    pattern FdivTerm,
+    pattern FloatingUnaryTerm,
+    pattern ForallTerm,
+    pattern FromFPOrTerm,
+    pattern FromIntegralTerm,
+    pattern ITETerm,
+    pattern LeOrdTerm,
+    pattern LtOrdTerm,
+    pattern ModIntegralTerm,
+    pattern MulNumTerm,
+    pattern NegNumTerm,
+    pattern NotTerm,
+    pattern OrBitsTerm,
+    pattern OrTerm,
+    pattern PowerTerm,
+    pattern QuotIntegralTerm,
+    pattern RecipTerm,
+    pattern RemIntegralTerm,
+    pattern RotateLeftTerm,
+    pattern RotateRightTerm,
+    pattern ShiftLeftTerm,
+    pattern ShiftRightTerm,
+    pattern SignumNumTerm,
+    pattern SupportedTypedSymbol,
+    pattern SymTerm,
+    pattern ToFPTerm,
+    pattern XorBitsTerm,
   )
+import Grisette.Internal.SymPrim.Prim.Pattern (pattern SubTerms)
 import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm), someTerm)
 import Language.Haskell.TH.Syntax (Lift (liftTyped))
 import Type.Reflection
@@ -242,9 +239,9 @@
     goTyped = go . someTerm
 
     go :: SomeTerm -> HS.HashSet SomeTypedAnySymbol
-    go (SomeTerm (SymTerm _ _ _ _ (sym :: TypedAnySymbol a))) =
+    go (SomeTerm (SymTerm (sym :: TypedAnySymbol a))) =
       HS.singleton $ someTypedSymbol sym
-    go (SomeTerm (ConTerm _ _ _ _ cv :: Term v)) =
+    go (SomeTerm (ConTerm cv :: Term v)) =
       case (primTypeRep :: TypeRep v) of
         App (App gf _) _ ->
           case eqTypeRep (typeRep @(-->)) gf of
@@ -258,78 +255,11 @@
                     $ go (SomeTerm tm)
             Nothing -> HS.empty
         _ -> HS.empty
-    go (SomeTerm (ForallTerm _ _ _ _ sym arg)) =
-      withConstantSymbolSupported sym $
-        HS.insert (someTypedSymbol $ fromJust $ castTypedSymbol sym) $
-          goUnary arg
-    go (SomeTerm (ExistsTerm _ _ _ _ sym arg)) =
-      withConstantSymbolSupported sym $
-        HS.insert (someTypedSymbol $ fromJust $ castTypedSymbol sym) $
-          goUnary arg
-    go (SomeTerm (NotTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (OrTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (AndTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (EqTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (DistinctTerm _ _ _ _ args)) =
-      mconcat <$> map goTyped $ toList args
-    go (SomeTerm (ITETerm _ _ _ _ cond arg1 arg2)) = goTernary cond arg1 arg2
-    go (SomeTerm (AddNumTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (NegNumTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (MulNumTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (AbsNumTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (SignumNumTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (LtOrdTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (LeOrdTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (AndBitsTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (OrBitsTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (XorBitsTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (ComplementBitsTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (ShiftLeftTerm _ _ _ _ arg n)) = goBinary arg n
-    go (SomeTerm (ShiftRightTerm _ _ _ _ arg n)) = goBinary arg n
-    go (SomeTerm (RotateLeftTerm _ _ _ _ arg n)) = goBinary arg n
-    go (SomeTerm (RotateRightTerm _ _ _ _ arg n)) = goBinary arg n
-    go (SomeTerm (BitCastTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (BitCastOrTerm _ _ _ _ d arg)) = goBinary d arg
-    go (SomeTerm (BVConcatTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (BVSelectTerm _ _ _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (BVExtendTerm _ _ _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (ApplyTerm _ _ _ _ func arg)) = goBinary func arg
-    go (SomeTerm (DivIntegralTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (ModIntegralTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (QuotIntegralTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (RemIntegralTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (FPTraitTerm _ _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (FdivTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (RecipTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (FloatingUnaryTerm _ _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (PowerTerm _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (FPUnaryTerm _ _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (FPBinaryTerm _ _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (FPRoundingUnaryTerm _ _ _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (FPRoundingBinaryTerm _ _ _ _ _ _ arg1 arg2)) = goBinary arg1 arg2
-    go (SomeTerm (FPFMATerm _ _ _ _ mode arg1 arg2 arg3)) =
-      mconcat
-        [ goTyped mode,
-          goTyped arg1,
-          goTyped arg2,
-          goTyped arg3
-        ]
-    go (SomeTerm (FromIntegralTerm _ _ _ _ arg)) = goUnary arg
-    go (SomeTerm (FromFPOrTerm _ _ _ _ d mode arg)) = goTernary d mode arg
-    go (SomeTerm (ToFPTerm _ _ _ _ mode arg _ _)) = goBinary mode arg
-    goUnary :: Term a -> HS.HashSet SomeTypedAnySymbol
-    goUnary = goTyped
-    goBinary ::
-      Term a ->
-      Term b ->
-      HS.HashSet SomeTypedAnySymbol
-    goBinary a b = goTyped a <> goTyped b
-    goTernary ::
-      Term a ->
-      Term b ->
-      Term c ->
-      HS.HashSet SomeTypedAnySymbol
-    goTernary a b c = goTyped a <> goTyped b <> goTyped c
+    go (SomeTerm (ForallTerm sym arg)) =
+      HS.insert (someTypedSymbol $ fromJust $ castTypedSymbol sym) $ goTyped arg
+    go (SomeTerm (ExistsTerm sym arg)) =
+      HS.insert (someTypedSymbol $ fromJust $ castTypedSymbol sym) $ goTyped arg
+    go (SomeTerm (SubTerms tms)) = mconcat <$> map go $ tms
 
 -- | Generate a fresh argument symbol that is not used as bounded or unbounded
 -- variables in the function body for a general symbolic function.
@@ -412,9 +342,9 @@
   Term b
 pevalGeneralFunApplyTerm = totalize2 doPevalApplyTerm applyTerm
   where
-    doPevalApplyTerm (ConTerm _ _ _ _ (GeneralFun arg tm)) v =
+    doPevalApplyTerm (ConTerm (GeneralFun arg tm)) v =
       Just $ substTerm arg v HS.empty tm
-    doPevalApplyTerm (ITETerm _ _ _ _ c l r) v =
+    doPevalApplyTerm (ITETerm c l r) v =
       return $ pevalITETerm c (pevalApplyTerm l v) (pevalApplyTerm r v)
     doPevalApplyTerm _ _ = Nothing
 
@@ -479,7 +409,7 @@
       HS.HashSet SomeTypedConstantSymbol ->
       SomeTerm ->
       SomeTerm
-    goSome _ bs c@(SomeTerm (ConTerm _ _ _ _ cv :: Term x)) =
+    goSome _ bs c@(SomeTerm (ConTerm cv :: Term x)) =
       case (primTypeRep :: TypeRep x) of
         App (App gf _) _ ->
           case eqTypeRep gf (typeRep @(-->)) of
@@ -495,118 +425,115 @@
                  in SomeTerm $ conTerm $ GeneralFun sym (go newmemo tm)
             Nothing -> c
         _ -> c
-    goSome _ bs c@(SomeTerm ((SymTerm _ _ _ _ sym) :: Term a)) =
+    goSome _ bs c@(SomeTerm ((SymTerm sym) :: Term a)) =
       case castTypedSymbol sym of
         Just sym' | HS.member (someTypedSymbol sym') bs -> c
         _ -> SomeTerm $ subst sym
-    goSome _ bs (SomeTerm (ForallTerm _ _ _ _ tsym b)) =
+    goSome _ bs (SomeTerm (ForallTerm tsym b)) =
       let newmemo =
             htmemo (goSome newmemo (HS.insert (someTypedSymbol tsym) bs))
           {-# NOINLINE newmemo #-}
        in goUnary newmemo (forallTerm tsym) b
-    goSome _ bs (SomeTerm (ExistsTerm _ _ _ _ tsym b)) =
+    goSome _ bs (SomeTerm (ExistsTerm tsym b)) =
       let newmemo =
             htmemo (goSome newmemo (HS.insert (someTypedSymbol tsym) bs))
           {-# NOINLINE newmemo #-}
        in goUnary newmemo (existsTerm tsym) b
-    goSome memo _ (SomeTerm (NotTerm _ _ _ _ arg)) =
+    goSome memo _ (SomeTerm (NotTerm arg)) =
       goUnary memo pevalNotTerm arg
-    goSome memo _ (SomeTerm (OrTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (OrTerm arg1 arg2)) =
       goBinary memo pevalOrTerm arg1 arg2
-    goSome memo _ (SomeTerm (AndTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (AndTerm arg1 arg2)) =
       goBinary memo pevalAndTerm arg1 arg2
-    goSome memo _ (SomeTerm (EqTerm _ _ _ _ arg1 arg2)) =
-      introSupportedPrimConstraint arg1 $
-        goBinary memo pevalEqTerm arg1 arg2
-    goSome memo _ (SomeTerm (DistinctTerm _ _ _ _ args@(arg1 :| _))) =
-      introSupportedPrimConstraint arg1 $
-        SomeTerm $
-          pevalDistinctTerm (fmap (go memo) args)
-    goSome memo _ (SomeTerm (ITETerm _ _ _ _ cond arg1 arg2)) =
+    goSome memo _ (SomeTerm (EqTerm arg1 arg2)) =
+      goBinary memo pevalEqTerm arg1 arg2
+    goSome memo _ (SomeTerm (DistinctTerm args)) =
+      SomeTerm $ pevalDistinctTerm (fmap (go memo) args)
+    goSome memo _ (SomeTerm (ITETerm cond arg1 arg2)) =
       goTernary memo pevalITETerm cond arg1 arg2
-    goSome memo _ (SomeTerm (AddNumTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (AddNumTerm arg1 arg2)) =
       goBinary memo pevalAddNumTerm arg1 arg2
-    goSome memo _ (SomeTerm (NegNumTerm _ _ _ _ arg)) =
+    goSome memo _ (SomeTerm (NegNumTerm arg)) =
       goUnary memo pevalNegNumTerm arg
-    goSome memo _ (SomeTerm (MulNumTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (MulNumTerm arg1 arg2)) =
       goBinary memo pevalMulNumTerm arg1 arg2
-    goSome memo _ (SomeTerm (AbsNumTerm _ _ _ _ arg)) =
+    goSome memo _ (SomeTerm (AbsNumTerm arg)) =
       goUnary memo pevalAbsNumTerm arg
-    goSome memo _ (SomeTerm (SignumNumTerm _ _ _ _ arg)) =
+    goSome memo _ (SomeTerm (SignumNumTerm arg)) =
       goUnary memo pevalSignumNumTerm arg
-    goSome memo _ (SomeTerm (LtOrdTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (LtOrdTerm arg1 arg2)) =
       goBinary memo pevalLtOrdTerm arg1 arg2
-    goSome memo _ (SomeTerm (LeOrdTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (LeOrdTerm arg1 arg2)) =
       goBinary memo pevalLeOrdTerm arg1 arg2
-    goSome memo _ (SomeTerm (AndBitsTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (AndBitsTerm arg1 arg2)) =
       goBinary memo pevalAndBitsTerm arg1 arg2
-    goSome memo _ (SomeTerm (OrBitsTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (OrBitsTerm arg1 arg2)) =
       goBinary memo pevalOrBitsTerm arg1 arg2
-    goSome memo _ (SomeTerm (XorBitsTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (XorBitsTerm arg1 arg2)) =
       goBinary memo pevalXorBitsTerm arg1 arg2
-    goSome memo _ (SomeTerm (ComplementBitsTerm _ _ _ _ arg)) =
+    goSome memo _ (SomeTerm (ComplementBitsTerm arg)) =
       goUnary memo pevalComplementBitsTerm arg
-    goSome memo _ (SomeTerm (ShiftLeftTerm _ _ _ _ arg n)) =
+    goSome memo _ (SomeTerm (ShiftLeftTerm arg n)) =
       goBinary memo pevalShiftLeftTerm arg n
-    goSome memo _ (SomeTerm (RotateLeftTerm _ _ _ _ arg n)) =
+    goSome memo _ (SomeTerm (RotateLeftTerm arg n)) =
       goBinary memo pevalRotateLeftTerm arg n
-    goSome memo _ (SomeTerm (ShiftRightTerm _ _ _ _ arg n)) =
+    goSome memo _ (SomeTerm (ShiftRightTerm arg n)) =
       goBinary memo pevalShiftRightTerm arg n
-    goSome memo _ (SomeTerm (RotateRightTerm _ _ _ _ arg n)) =
+    goSome memo _ (SomeTerm (RotateRightTerm arg n)) =
       goBinary memo pevalRotateRightTerm arg n
-    goSome memo _ (SomeTerm (BitCastTerm _ _ _ _ (arg :: Term a) :: Term r)) =
+    goSome memo _ (SomeTerm (BitCastTerm (arg :: Term a) :: Term r)) =
       goUnary memo (pevalBitCastTerm @a @r) arg
-    goSome memo _ (SomeTerm (BitCastOrTerm _ _ _ _ (d :: term r) (arg :: Term a) :: Term r)) =
+    goSome memo _ (SomeTerm (BitCastOrTerm (d :: term r) (arg :: Term a) :: Term r)) =
       goBinary memo (pevalBitCastOrTerm @a @r) d arg
-    goSome memo _ (SomeTerm (BVConcatTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (BVConcatTerm arg1 arg2)) =
       goBinary memo pevalBVConcatTerm arg1 arg2
-    goSome memo _ (SomeTerm (BVSelectTerm _ _ _ _ ix w arg)) =
+    goSome memo _ (SomeTerm (BVSelectTerm ix w arg)) =
       goUnary memo (pevalBVSelectTerm ix w) arg
-    goSome memo _ (SomeTerm (BVExtendTerm _ _ _ _ n signed arg)) =
+    goSome memo _ (SomeTerm (BVExtendTerm n signed arg)) =
       goUnary memo (pevalBVExtendTerm n signed) arg
-    goSome memo _ (SomeTerm (ApplyTerm _ _ _ _ f arg)) =
+    goSome memo _ (SomeTerm (ApplyTerm f arg)) =
       goBinary memo pevalApplyTerm f arg
-    goSome memo _ (SomeTerm (DivIntegralTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (DivIntegralTerm arg1 arg2)) =
       goBinary memo pevalDivIntegralTerm arg1 arg2
-    goSome memo _ (SomeTerm (ModIntegralTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (ModIntegralTerm arg1 arg2)) =
       goBinary memo pevalModIntegralTerm arg1 arg2
-    goSome memo _ (SomeTerm (QuotIntegralTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (QuotIntegralTerm arg1 arg2)) =
       goBinary memo pevalQuotIntegralTerm arg1 arg2
-    goSome memo _ (SomeTerm (RemIntegralTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (RemIntegralTerm arg1 arg2)) =
       goBinary memo pevalRemIntegralTerm arg1 arg2
-    goSome memo _ (SomeTerm (FPTraitTerm _ _ _ _ trait arg)) =
+    goSome memo _ (SomeTerm (FPTraitTerm trait arg)) =
       goUnary memo (pevalFPTraitTerm trait) arg
-    goSome memo _ (SomeTerm (FdivTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (FdivTerm arg1 arg2)) =
       goBinary memo pevalFdivTerm arg1 arg2
-    goSome memo _ (SomeTerm (RecipTerm _ _ _ _ arg)) =
+    goSome memo _ (SomeTerm (RecipTerm arg)) =
       goUnary memo pevalRecipTerm arg
-    goSome memo _ (SomeTerm (FloatingUnaryTerm _ _ _ _ op arg)) =
+    goSome memo _ (SomeTerm (FloatingUnaryTerm op arg)) =
       goUnary memo (pevalFloatingUnaryTerm op) arg
-    goSome memo _ (SomeTerm (PowerTerm _ _ _ _ arg1 arg2)) =
+    goSome memo _ (SomeTerm (PowerTerm arg1 arg2)) =
       goBinary memo pevalPowerTerm arg1 arg2
-    goSome memo _ (SomeTerm (FPUnaryTerm _ _ _ _ op arg)) =
+    goSome memo _ (SomeTerm (FPUnaryTerm op arg)) =
       goUnary memo (pevalFPUnaryTerm op) arg
-    goSome memo _ (SomeTerm (FPBinaryTerm _ _ _ _ op arg1 arg2)) =
+    goSome memo _ (SomeTerm (FPBinaryTerm op arg1 arg2)) =
       goBinary memo (pevalFPBinaryTerm op) arg1 arg2
-    goSome memo _ (SomeTerm (FPRoundingUnaryTerm _ _ _ _ op mode arg)) =
+    goSome memo _ (SomeTerm (FPRoundingUnaryTerm op mode arg)) =
       goUnary memo (pevalFPRoundingUnaryTerm op mode) arg
-    goSome memo _ (SomeTerm (FPRoundingBinaryTerm _ _ _ _ op mode arg1 arg2)) =
+    goSome memo _ (SomeTerm (FPRoundingBinaryTerm op mode arg1 arg2)) =
       goBinary memo (pevalFPRoundingBinaryTerm op mode) arg1 arg2
-    goSome memo _ (SomeTerm (FPFMATerm _ _ _ _ mode arg1 arg2 arg3)) =
+    goSome memo _ (SomeTerm (FPFMATerm mode arg1 arg2 arg3)) =
       SomeTerm $
         pevalFPFMATerm
           (go memo mode)
           (go memo arg1)
           (go memo arg2)
           (go memo arg3)
-    goSome memo _ (SomeTerm (FromIntegralTerm _ _ _ _ (arg :: Term a) :: Term b)) =
+    goSome memo _ (SomeTerm (FromIntegralTerm (arg :: Term a) :: Term b)) =
       goUnary memo (pevalFromIntegralTerm @a @b) arg
-    goSome memo _ (SomeTerm (FromFPOrTerm _ _ _ _ d mode arg)) =
+    goSome memo _ (SomeTerm (FromFPOrTerm d mode arg)) =
       goTernary memo pevalFromFPOrTerm d mode arg
     goSome
       memo
       _
-      (SomeTerm (ToFPTerm _ _ _ _ mode (arg :: Term a) (_ :: p eb) (_ :: q sb))) =
+      (SomeTerm (ToFPTerm mode (arg :: Term a) (_ :: p eb) (_ :: q sb))) =
         goBinary memo (pevalToFPTerm @a @eb @sb) mode arg
     goUnary memo f a = SomeTerm $ f (go memo a)
     goBinary memo f a b = SomeTerm $ f (go memo a) (go memo b)
@@ -622,20 +549,20 @@
   HS.HashSet SomeTypedConstantSymbol ->
   Term b ->
   Term b
-substTerm sym a =
+substTerm sym@SupportedTypedSymbol a =
   generalSubstSomeTerm
     ( \t ->
         if eqHeteroSymbol sym t
           then unsafeCoerce a
-          else withSymbolSupported t $ symTerm t
+          else symTerm t
     )
 
 supportedPrimFunUpTo
   [|buildGeneralFun (typedConstantSymbol "a") (conTerm defaultValue)|]
   [|
     \c t f -> case (t, f) of
-      ( ConTerm _ _ _ _ (GeneralFun (ta :: TypedConstantSymbol a) a),
-        ConTerm _ _ _ _ (GeneralFun tb b)
+      ( ConTerm (GeneralFun (ta :: TypedConstantSymbol a) a),
+        ConTerm (GeneralFun tb b)
         ) ->
           conTerm $
             GeneralFun argSymbol $
diff --git a/src/Grisette/Internal/SymPrim/ModelRep.hs b/src/Grisette/Internal/SymPrim/ModelRep.hs
--- a/src/Grisette/Internal/SymPrim/ModelRep.hs
+++ b/src/Grisette/Internal/SymPrim/ModelRep.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 -- |
 -- Module      :   Grisette.Internal.SymPrim.ModelRep
@@ -18,7 +19,7 @@
 import Grisette.Internal.SymPrim.Prim.Model (Model)
 import Grisette.Internal.SymPrim.Prim.Term
   ( LinkedRep (underlyingTerm),
-    Term (SymTerm),
+    pattern SymTerm,
   )
 
 -- $setup
@@ -40,5 +41,5 @@
 instance ModelRep (ModelSymPair ct st) Model where
   buildModel (sym := val) =
     case underlyingTerm sym of
-      SymTerm _ _ _ _ symbol -> insertValue symbol val emptyModel
+      SymTerm symbol -> insertValue symbol val emptyModel
       _ -> error "buildModel: should only use symbolic constants"
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Caches.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Caches.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Caches.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Caches.hs
@@ -21,8 +21,9 @@
 module Grisette.Internal.SymPrim.Prim.Internal.Caches
   ( SomeStableName (..),
     Id,
-    Ident,
+    StableIdent,
     Digest,
+    CachedInfo (..),
     Interned (..),
     intern,
     haveCache,
@@ -73,37 +74,48 @@
 type Id = Word32
 
 -- | The identity of a term.
-type Ident = StableName Any
+type StableIdent = StableName Any
 
 -- | A digest of a term.
 type Digest = Word32
 
-newtype Cache t = Cache {getCache :: A.Array Int (CacheState t)}
+-- | Information about a cached term.
+data CachedInfo = CachedInfo
+  { cachedThreadId :: {-# UNPACK #-} !WeakThreadId,
+    cachedDigest :: {-# UNPACK #-} !Digest,
+    cachedId :: {-# UNPACK #-} !Id,
+    cachedStableIdent :: {-# UNPACK #-} !StableIdent
+  }
 
+data Cache t = Cache
+  { getCache :: A.Array Int (CacheState t),
+    idSem :: MVar (),
+    nextId :: M.IOVector Id
+  }
+
 type HashTable k v = IORef (HM.HashMap k v)
 
 data CacheState t where
   CacheState ::
     { _sem :: MVar (),
-      _nextId :: M.IOVector Id,
-      _currentThread :: HashTable (Description t) (Id, Weak Ident)
+      _currentThread :: HashTable (Description t) (Id, Weak StableIdent)
     } ->
     CacheState t
 
 finalizeCacheState :: CacheState t -> IO ()
-finalizeCacheState (CacheState _ _ s) = do
+finalizeCacheState (CacheState _ s) = do
   m <- readIORef s
   traverse_ (\(_, w) -> finalize w) m
 
 finalizeCache :: Cache t -> IO ()
-finalizeCache (Cache a) = mapM_ finalizeCacheState (A.elems a)
+finalizeCache (Cache a _ _) = mapM_ finalizeCacheState (A.elems a)
 
 -- | A class for interning terms.
 class Interned t where
   data Description t
   type Uninterned t
   describe :: Uninterned t -> Description t
-  identify :: WeakThreadId -> Digest -> Id -> Ident -> Uninterned t -> t
+  identify :: CachedInfo -> Uninterned t -> t
   threadId :: t -> WeakThreadId
   descriptionDigest :: Description t -> Digest
 
@@ -128,11 +140,13 @@
     element =
       CacheState
         <$> newMVar ()
-        <*> M.replicate 1 0
         <*> newIORef HM.empty
     result = do
       elements <- replicateM (fromIntegral cacheWidth) element
-      return $ Cache $ A.listArray (0, fromIntegral cacheWidth - 1) elements
+      idSem <- newMVar ()
+      nextId <- M.replicate 1 0
+      return $
+        Cache (A.listArray (0, fromIntegral cacheWidth - 1) elements) idSem nextId
 
 -- | Internal cache for memoization of term construction. Different types have
 -- different caches and they may share names, ids, or representations, but they
@@ -177,8 +191,8 @@
       cache <- readIORef cref
       case HM.lookup tyFingerprint cache of
         Just c -> do
-          let Cache a = unsafeCoerce c :: Cache t
-          let CacheState sem _ s = a A.! grp
+          let Cache a _ _ = unsafeCoerce c :: Cache t
+          let CacheState sem s = a A.! grp
           takeMVar sem
           current <- readIORef s
           case HM.lookup dt current of
@@ -206,21 +220,23 @@
   let !dt = describe bt :: Description t
       !hdt = descriptionDigest dt
       !r = hdt `mod` cacheWidth
-      CacheState sem nextId s = getCache cache A.! (fromIntegral r)
+      CacheState sem s = getCache cache A.! (fromIntegral r)
   takeMVar sem
   -- print ("intern", wtid, dt, r)
   current <- readIORef s
   case HM.lookup dt current of
     Nothing -> do
-      newId0 <- M.unsafeRead nextId 0
-      M.unsafeWrite nextId 0 (newId0 + 1)
+      takeMVar (idSem cache)
+      newId0 <- M.unsafeRead (nextId cache) 0
+      M.unsafeWrite (nextId cache) 0 (newId0 + 1)
+      putMVar (idSem cache) ()
       let newId = newId0 * cacheWidth + r
       newIdent <- makeStableName dt
-      let anyNewIdent = unsafeCoerce newIdent :: Ident
+      let anyNewIdent = unsafeCoerce newIdent :: StableIdent
       identRef <-
         mkWeakStableNameRefWithFinalizer anyNewIdent $
           reclaimTerm wtid fingerprint (fromIntegral r) dt
-      let !t = identify (weakThreadId tid) hdt newId anyNewIdent bt
+      let !t = identify (CachedInfo (weakThreadId tid) hdt newId anyNewIdent) bt
       writeIORef s $ HM.insert dt (newId, identRef) current
       putMVar sem ()
       return t
@@ -228,21 +244,26 @@
       t1 <- deRefWeak oldIdentRef
       case t1 of
         Nothing -> do
-          newId0 <- M.unsafeRead nextId 0
-          M.unsafeWrite nextId 0 (newId0 + 1)
+          takeMVar (idSem cache)
+          newId0 <- M.unsafeRead (nextId cache) 0
+          M.unsafeWrite (nextId cache) 0 (newId0 + 1)
+          putMVar (idSem cache) ()
           let newId = newId0 * cacheWidth + r
           newIdent <- makeStableName dt
-          let anyNewIdent = unsafeCoerce newIdent :: Ident
+          let anyNewIdent = unsafeCoerce newIdent :: StableIdent
           identRef <-
             mkWeakStableNameRefWithFinalizer anyNewIdent $
               reclaimTerm wtid fingerprint (fromIntegral r) dt
-          let !term = identify (weakThreadId tid) hdt newId anyNewIdent bt
+          let !term =
+                identify
+                  (CachedInfo (weakThreadId tid) hdt newId anyNewIdent)
+                  bt
           writeIORef s $ HM.insert dt (newId, identRef) current
           putMVar sem ()
           return term
         Just t1 -> do
           putMVar sem ()
-          return $! identify (weakThreadId tid) hdt oldId t1 bt
+          return $! identify (CachedInfo (weakThreadId tid) hdt oldId t1) bt
 {-# NOINLINE intern #-}
 
 -- | Check if the current thread has a cache.
@@ -253,10 +274,10 @@
   return $ HM.member tid caches
 
 cacheStateSize :: CacheState t -> IO Int
-cacheStateSize (CacheState _ _ s) = HM.size <$> readIORef s
+cacheStateSize (CacheState _ s) = HM.size <$> readIORef s
 
 cacheStateLiveSize :: CacheState t -> IO Int
-cacheStateLiveSize (CacheState sem _ s) = do
+cacheStateLiveSize (CacheState sem s) = do
   takeMVar sem
   v <- fmap snd . HM.toList <$> readIORef s
   r <-
@@ -270,30 +291,11 @@
   putMVar sem ()
   return r
 
-{-
-dumpCacheState :: CacheState t -> IO ()
-dumpCacheState (CacheState sem s) = do
-  takeMVar sem
-  v <- HM.toList <$> readIORef s
-  mapM_
-    ( \(k, (i, v)) -> do
-        v1 <- deRefWeak v
-        case v1 of
-          Nothing -> print (k, i, "dead")
-          Just r -> print (k, i, r)
-    )
-    v
-  putMVar sem ()
-
-dumpCache :: Cache t -> IO ()
-dumpCache (Cache a) = mapM_ dumpCacheState (A.elems a)
--}
-
 cacheSize :: Cache t -> IO Int
-cacheSize (Cache a) = sum <$> mapM cacheStateSize (A.elems a)
+cacheSize (Cache a _ _) = sum <$> mapM cacheStateSize (A.elems a)
 
 cacheLiveSize :: Cache t -> IO Int
-cacheLiveSize (Cache a) = sum <$> mapM cacheStateLiveSize (A.elems a)
+cacheLiveSize (Cache a _ _) = sum <$> mapM cacheStateLiveSize (A.elems a)
 
 -- | Get the size of the current thread's cache.
 threadCacheSize :: WeakThreadId -> IO Int
@@ -314,15 +316,3 @@
       cache <- readIORef cref
       sum <$> mapM cacheLiveSize (HM.elems cache)
     Nothing -> return 0
-
-{-
--- | Dump the current thread's cache.
-dumpThreadCache :: WeakThreadId -> IO ()
-dumpThreadCache tid = do
-  caches <- readIORef termCacheCell
-  case HM.lookup tid caches of
-    Just (_, cref) -> do
-      cache <- readIORef cref
-      mapM_ dumpCache (HM.elems cache)
-    Nothing -> return ()
--}
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/BVPEval.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/BVPEval.hs
deleted file mode 100644
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/BVPEval.hs
+++ /dev/null
@@ -1,601 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# HLINT ignore "Eta reduce" #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
--- |
--- Module      :   Grisette.Internal.SymPrim.Prim.Internal.Instances.BVPEval
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.SymPrim.Prim.Internal.Instances.BVPEval () where
-
-import Data.Kind (Type)
-import Data.Maybe (isJust)
-import Data.Proxy (Proxy (Proxy))
-import qualified Data.SBV as SBV
-import Data.Typeable (Typeable, type (:~:) (Refl))
-import GHC.TypeNats (KnownNat, Nat, natVal, sameNat, type (+), type (-), type (<=))
-import Grisette.Internal.Core.Data.Class.BitVector
-  ( SizedBV
-      ( sizedBVConcat,
-        sizedBVFromIntegral,
-        sizedBVSelect,
-        sizedBVSext,
-        sizedBVZext
-      ),
-  )
-import Grisette.Internal.SymPrim.BV (IntN, WordN)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitCastTerm (doPevalBitCast)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim
-  ( bvIsNonZeroFromGEq1,
-  )
-import Grisette.Internal.SymPrim.Prim.Internal.Term
-  ( PEvalBVTerm
-      ( pevalBVConcatTerm,
-        pevalBVExtendTerm,
-        pevalBVSelectTerm,
-        sbvBVConcatTerm,
-        sbvBVExtendTerm,
-        sbvBVSelectTerm
-      ),
-    PEvalBitCastTerm (pevalBitCastTerm, sbvBitCast),
-    SupportedPrim,
-    Term
-      ( BVConcatTerm,
-        BVExtendTerm,
-        BVSelectTerm,
-        BitCastTerm,
-        ConTerm
-      ),
-    bitCastTerm,
-    bvConcatTerm,
-    bvExtendTerm,
-    bvSelectTerm,
-    conTerm,
-    pattern DynTerm,
-  )
-import Grisette.Internal.SymPrim.Prim.Internal.Unfold
-  ( binaryUnfoldOnce,
-    unaryUnfoldOnce,
-  )
-import Grisette.Internal.SymPrim.Prim.TermUtils (castTerm)
-import Grisette.Internal.Utils.Parameterized
-  ( LeqProof (LeqProof),
-    NatRepr,
-    SomeNatRepr (SomeNatRepr),
-    SomePositiveNatRepr (SomePositiveNatRepr),
-    addNat,
-    mkNatRepr,
-    mkPositiveNatRepr,
-    natRepr,
-    unsafeAxiom,
-    unsafeKnownProof,
-    unsafeLeqProof,
-    withKnownNat,
-    withKnownProof,
-  )
-
-pevalDefaultBVSelectTerm ::
-  forall (bv2 :: Nat -> Type) bv n ix w p q.
-  ( KnownNat n,
-    KnownNat ix,
-    KnownNat w,
-    1 <= n,
-    1 <= w,
-    ix + w <= n,
-    PEvalBVTerm bv,
-    forall x. (KnownNat x, 1 <= x) => PEvalBitCastTerm (bv2 x) (bv x),
-    PEvalBVTerm bv2,
-    Typeable bv,
-    SupportedPrim (bv w),
-    SupportedPrim (bv2 n)
-  ) =>
-  p ix ->
-  q w ->
-  Term (bv n) ->
-  Term (bv w)
-pevalDefaultBVSelectTerm ix w =
-  unaryUnfoldOnce (doPevalDefaultBVSelectTerm @bv2 ix w) (bvSelectTerm ix w)
-
-unsafePevalBVSelectTerm ::
-  forall bv n ix w.
-  (PEvalBVTerm bv) =>
-  NatRepr n ->
-  NatRepr ix ->
-  NatRepr w ->
-  Term (bv n) ->
-  Term (bv w)
-unsafePevalBVSelectTerm n ix w term =
-  withKnownNat n $
-    withKnownNat ix $
-      withKnownNat w $
-        case ( unsafeLeqProof @1 @n,
-               unsafeLeqProof @1 @w,
-               unsafeLeqProof @(ix + w) @n
-             ) of
-          (LeqProof, LeqProof, LeqProof) -> pevalBVSelectTerm ix w term
-
-doPevalDefaultBVSelectTerm ::
-  forall (bv2 :: Nat -> Type) bv n ix w p q.
-  ( KnownNat n,
-    KnownNat ix,
-    KnownNat w,
-    forall x. (KnownNat x, 1 <= x) => PEvalBitCastTerm (bv2 x) (bv x),
-    1 <= n,
-    1 <= w,
-    ix + w <= n,
-    PEvalBVTerm bv,
-    PEvalBVTerm bv2,
-    Typeable bv,
-    SupportedPrim (bv w),
-    SupportedPrim (bv2 n)
-  ) =>
-  p ix ->
-  q w ->
-  Term (bv n) ->
-  Maybe (Term (bv w))
-doPevalDefaultBVSelectTerm _ _ rhs
-  | isJust (sameNat (Proxy @ix) (Proxy @0))
-      && isJust (sameNat (Proxy @w) (Proxy @n)) =
-      Just rhs >>= castTerm
-doPevalDefaultBVSelectTerm ix w (ConTerm _ _ _ _ b) =
-  Just $ conTerm $ sizedBVSelect ix w b
-doPevalDefaultBVSelectTerm ix w (BitCastTerm _ _ _ _ (DynTerm (b :: Term (bv2 n)))) =
-  Just $ pevalBitCastTerm $ pevalBVSelectTerm ix w b
-doPevalDefaultBVSelectTerm
-  pix
-  pw
-  (BVConcatTerm _ _ _ _ (b1 :: Term (bv n1)) (b2 :: Term (bv n2)))
-    | ix + w <= n2 = Just $ unsafePevalBVSelectTerm n2Repr ixRepr wRepr b2
-    | ix >= n2 =
-        case mkNatRepr (ix - n2) of
-          SomeNatRepr ixpn2Repr ->
-            Just $ unsafePevalBVSelectTerm n1Repr ixpn2Repr wRepr b1
-    | otherwise =
-        case (mkNatRepr (w + ix - n2), mkNatRepr (n2 - ix)) of
-          (SomeNatRepr wixpn2Repr, SomeNatRepr n2pixRepr) ->
-            let b1Part =
-                  unsafePevalBVSelectTerm n1Repr (natRepr @0) wixpn2Repr b1
-                b2Part = unsafePevalBVSelectTerm n2Repr ixRepr n2pixRepr b2
-             in Just $
-                  unsafePevalBVConcatTerm
-                    wixpn2Repr
-                    n2pixRepr
-                    wRepr
-                    b1Part
-                    b2Part
-    where
-      ixRepr = natRepr @ix
-      wRepr = natRepr @w
-      n1Repr = natRepr @n1
-      n2Repr = natRepr @n2
-      ix = natVal @ix pix
-      w = natVal @w pw
-      n2 = natVal @n2 (Proxy @n2)
-doPevalDefaultBVSelectTerm
-  _
-  _
-  (BVSelectTerm _ _ _ _ (_ :: proxy ix1) _ (b :: Term (bv n1))) =
-    Just $
-      unsafePevalBVSelectTerm
-        (natRepr @n1)
-        (addNat (natRepr @ix) (natRepr @ix1))
-        (natRepr @w)
-        b
-doPevalDefaultBVSelectTerm
-  pix
-  pw
-  (BVExtendTerm _ _ _ _ signed _ (b :: Term (bv n1)))
-    | ix + w <= n1 = Just $ unsafePevalBVSelectTerm n1Repr ixRepr wRepr b
-    | ix < n1 =
-        case mkNatRepr (n1 - ix) of
-          SomeNatRepr n1pixRepr ->
-            let bPart = unsafePevalBVSelectTerm n1Repr ixRepr n1pixRepr b
-             in Just $ unsafePevalBVExtendTerm n1pixRepr wRepr signed bPart
-    | otherwise = Nothing
-    where
-      ixRepr = natRepr @ix
-      wRepr = natRepr @w
-      n1Repr = natRepr @n1
-      ix = natVal @ix pix
-      w = natVal @w pw
-      n1 = natVal @n1 (Proxy @n1)
-doPevalDefaultBVSelectTerm _ _ _ = Nothing
-
-pevalDefaultBVExtendTerm ::
-  forall proxy l r bv.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    Typeable bv,
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
-  ) =>
-  Bool ->
-  proxy r ->
-  Term (bv l) ->
-  Term (bv r)
-pevalDefaultBVExtendTerm signed p =
-  unaryUnfoldOnce (doPevalDefaultBVExtendTerm signed p) (bvExtendTerm signed p)
-
-unsafePevalBVExtendTerm ::
-  forall bv l r.
-  (PEvalBVTerm bv) =>
-  NatRepr l ->
-  NatRepr r ->
-  Bool ->
-  Term (bv l) ->
-  Term (bv r)
-unsafePevalBVExtendTerm lRepr rRepr signed v =
-  case (unsafeLeqProof @1 @l, unsafeLeqProof @1 @r, unsafeLeqProof @l @r) of
-    (LeqProof, LeqProof, LeqProof) ->
-      withKnownNat lRepr $
-        withKnownNat rRepr $
-          pevalBVExtendTerm signed (Proxy @r) v
-
-doPevalDefaultBVExtendTerm ::
-  forall proxy l r bv.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    Typeable bv,
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
-  ) =>
-  Bool ->
-  proxy r ->
-  Term (bv l) ->
-  Maybe (Term (bv r))
-doPevalDefaultBVExtendTerm signed p (ConTerm _ _ _ _ b) =
-  Just $ conTerm $ if signed then sizedBVSext p b else sizedBVZext p b
-doPevalDefaultBVExtendTerm _ _ b
-  | isJust $ sameNat (Proxy @l) (Proxy @r) =
-      Just b >>= castTerm
-doPevalDefaultBVExtendTerm False pr b =
-  case (mkPositiveNatRepr $ r - l) of
-    SomePositiveNatRepr (rplRepr :: NatRepr lpr) ->
-      Just $
-        unsafePevalBVConcatTerm
-          rplRepr
-          lRepr
-          rRepr
-          (conTerm $ sizedBVFromIntegral 0)
-          b
-  where
-    lRepr = natRepr @l
-    rRepr = natRepr @r
-    l = natVal @l (Proxy @l)
-    r = natVal @r pr
-doPevalDefaultBVExtendTerm True p (BVExtendTerm _ _ _ _ True _ (b :: Term (bv l1))) =
-  case unsafeLeqProof @l1 @r of
-    LeqProof -> Just $ pevalBVExtendTerm True p b
-doPevalDefaultBVExtendTerm _ _ _ = Nothing
-
-pevalDefaultBVConcatTerm ::
-  forall bv a b.
-  ( KnownNat a,
-    KnownNat b,
-    1 <= a,
-    1 <= b,
-    PEvalBVTerm bv,
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
-  ) =>
-  Term (bv a) ->
-  Term (bv b) ->
-  Term (bv (a + b))
-pevalDefaultBVConcatTerm =
-  withKnownNat (addNat (natRepr @a) (natRepr @b)) $
-    case (unsafeLeqProof @1 @(a + b)) of
-      LeqProof ->
-        binaryUnfoldOnce doPevalDefaultBVConcatTerm bvConcatTerm
-
-unsafeBVConcatTerm ::
-  forall bv n1 n2 r.
-  (PEvalBVTerm bv, forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)) =>
-  NatRepr n1 ->
-  NatRepr n2 ->
-  NatRepr r ->
-  Term (bv n1) ->
-  Term (bv n2) ->
-  Term (bv r)
-unsafeBVConcatTerm n1Repr n2Repr rRepr lhs rhs =
-  case ( unsafeAxiom :: (n1 + n2) :~: r,
-         unsafeLeqProof @1 @r,
-         unsafeLeqProof @1 @n1,
-         unsafeLeqProof @1 @n2
-       ) of
-    (Refl, LeqProof, LeqProof, LeqProof) ->
-      withKnownNat n1Repr $
-        withKnownNat n2Repr $
-          withKnownNat rRepr $
-            bvConcatTerm lhs rhs
-
-unsafePevalBVConcatTerm ::
-  forall bv n1 n2 r.
-  (PEvalBVTerm bv) =>
-  NatRepr n1 ->
-  NatRepr n2 ->
-  NatRepr r ->
-  Term (bv n1) ->
-  Term (bv n2) ->
-  Term (bv r)
-unsafePevalBVConcatTerm n1Repr n2Repr rRepr lhs rhs =
-  case ( unsafeAxiom :: (n1 + n2) :~: r,
-         unsafeLeqProof @1 @r,
-         unsafeLeqProof @1 @n1,
-         unsafeLeqProof @1 @n2
-       ) of
-    (Refl, LeqProof, LeqProof, LeqProof) ->
-      withKnownNat n1Repr $
-        withKnownNat n2Repr $
-          withKnownNat rRepr $
-            pevalBVConcatTerm lhs rhs
-
-doPevalDefaultBVConcatTerm ::
-  forall bv l r.
-  ( KnownNat l,
-    KnownNat r,
-    KnownNat (l + r),
-    1 <= l,
-    1 <= r,
-    1 <= (l + r),
-    PEvalBVTerm bv,
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
-  ) =>
-  Term (bv l) ->
-  Term (bv r) ->
-  Maybe (Term (bv (l + r)))
--- 1. [c1 c2] -> c1c2
-doPevalDefaultBVConcatTerm (ConTerm _ _ _ _ v) (ConTerm _ _ _ _ v') =
-  withKnownNat (addNat (natRepr @l) (natRepr @r)) $
-    Just $
-      conTerm $
-        sizedBVConcat v v'
--- 2. [c1 (c2 ?)] -> (c1c2 ?)
-doPevalDefaultBVConcatTerm
-  (ConTerm _ _ _ _ vl)
-  (BVConcatTerm _ _ _ _ (ConTerm _ _ _ _ (vrl :: bv rl)) (rr :: Term (bv rr))) =
-    case unsafeLeqProof @1 @(l + rl) of
-      LeqProof ->
-        Just $
-          withKnownNat lRlRepr $
-            unsafeBVConcatTerm
-              lRlRepr
-              (natRepr @rr)
-              (addNat (natRepr @l) (natRepr @r))
-              (conTerm $ sizedBVConcat vl vrl)
-              rr
-    where
-      lRlRepr = addNat (natRepr @l) (natRepr @rl)
--- 3. [c1 (s c2)] -> (c1 (s c2))
-doPevalDefaultBVConcatTerm (ConTerm {}) (BVConcatTerm _ _ _ _ _ ConTerm {}) = Nothing
--- 4. [(c s) ?) -> (c [s ?])
-doPevalDefaultBVConcatTerm
-  (BVConcatTerm _ _ _ _ (ll@ConTerm {} :: Term (bv ll)) (lr :: Term (bv lr)))
-  r =
-    Just $ unsafeBVConcatTerm llRepr lrRRepr lRRepr ll rhs
-    where
-      llRepr = natRepr @ll
-      lrRepr = natRepr @lr
-      lRepr = natRepr @l
-      rRepr = natRepr @r
-      lrRRepr = addNat lrRepr rRepr
-      lRRepr = addNat lRepr rRepr
-      rhs :: Term (bv (lr + r))
-      rhs = unsafePevalBVConcatTerm lrRepr rRepr lrRRepr lr r
--- 5. [? (c1 (s2 c2))] -> (([? c1] s2) c2)
-doPevalDefaultBVConcatTerm
-  l
-  ( BVConcatTerm
-      _
-      _
-      _
-      _
-      (rl@ConTerm {} :: Term (bv rl))
-      (BVConcatTerm _ _ _ _ (rrl :: Term (bv rrl)) (rrr@ConTerm {} :: Term (bv rrr)))
-    ) =
-    Just $ unsafeBVConcatTerm lRlRrlRepr rrrRepr lRRepr lRlRrl rrr
-    where
-      lRepr = natRepr @l
-      rlRepr = natRepr @rl
-      rrlRepr = natRepr @rrl
-      rrrRepr = natRepr @rrr
-      lRlRepr = addNat lRepr rlRepr
-      rRepr = natRepr @r
-      lRRepr = addNat lRepr rRepr
-      lRl = unsafePevalBVConcatTerm lRepr rlRepr lRlRepr l rl
-      lRlRrlRepr = addNat lRlRepr rrlRepr
-      lRlRrl = unsafeBVConcatTerm lRlRepr rrlRepr lRlRrlRepr lRl rrl
--- 6. [(s1 c1) c2] -> (s1 c1c2)
-doPevalDefaultBVConcatTerm
-  (BVConcatTerm _ _ _ _ (ll :: Term (bv ll)) ((ConTerm _ _ _ _ vlr) :: Term (bv lr)))
-  (ConTerm _ _ _ _ vr) =
-    Just $ unsafeBVConcatTerm llRepr lrRRepr lRRepr ll rhs
-    where
-      llRepr = natRepr @ll
-      lrRepr = natRepr @lr
-      lRepr = natRepr @l
-      rRepr = natRepr @r
-      lrRRepr = addNat lrRepr rRepr
-      lRRepr = addNat lRepr rRepr
-      rhs :: Term (bv (lr + r))
-      rhs = case unsafeLeqProof @1 @(lr + r) of
-        LeqProof ->
-          withKnownNat lrRRepr $ conTerm $ sizedBVConcat vlr vr
--- 7. [(s1 c1) (c2 s2)] -> (s1 (c1c2 s2))
-doPevalDefaultBVConcatTerm
-  (BVConcatTerm _ _ _ _ (ll :: Term (bv ll)) ((ConTerm _ _ _ _ vlr) :: Term (bv lr)))
-  (BVConcatTerm _ _ _ _ ((ConTerm _ _ _ _ vrl) :: Term (bv rl)) (rr :: Term (bv rr))) =
-    Just $ unsafeBVConcatTerm llRepr lrRlRrRepr lRRepr ll lrRlRR
-    where
-      lRepr = natRepr @l
-      rRepr = natRepr @r
-      llRepr = natRepr @ll
-      lrRepr = natRepr @lr
-      rlRepr = natRepr @rl
-      rrRepr = natRepr @rr
-      lRRepr = addNat lRepr rRepr
-      lrRlRepr :: NatRepr (lr + rl)
-      lrRlRepr = addNat lrRepr rlRepr
-      lrRlRrRepr :: NatRepr ((lr + rl) + rr)
-      lrRlRrRepr = addNat lrRlRepr rrRepr
-      lrRl :: Term (bv (lr + rl))
-      lrRl = case unsafeLeqProof @1 @(lr + rl) of
-        LeqProof -> withKnownNat lrRlRepr $ conTerm $ sizedBVConcat vlr vrl
-      lrRlRR :: Term (bv ((lr + rl) + rr))
-      lrRlRR = unsafeBVConcatTerm lrRlRepr rrRepr lrRlRrRepr lrRl rr
--- 8. [?notc (s2 c)] -> ((s1 s2) c)
-doPevalDefaultBVConcatTerm
-  l
-  (BVConcatTerm _ _ _ _ (rl :: Term (bv rl)) (rr@ConTerm {} :: Term (bv rr))) =
-    Just $
-      unsafeBVConcatTerm
-        lRlRepr
-        (natRepr @rr)
-        (addNat (natRepr @l) (natRepr @r))
-        lhs
-        rr
-    where
-      lRepr = natRepr @l
-      rlRepr = natRepr @rl
-      lRlRepr = addNat lRepr rlRepr
-      lhs :: Term (bv (l + rl))
-      lhs = unsafeBVConcatTerm lRepr rlRepr lRlRepr l rl
-doPevalDefaultBVConcatTerm _ _ = Nothing
-
-instance PEvalBVTerm WordN where
-  pevalBVSelectTerm = pevalDefaultBVSelectTerm @IntN
-  pevalBVConcatTerm = pevalDefaultBVConcatTerm
-  pevalBVExtendTerm = pevalDefaultBVExtendTerm
-  sbvBVConcatTerm pl pr l r =
-    bvIsNonZeroFromGEq1 pl $
-      bvIsNonZeroFromGEq1 pr $
-        l SBV.# r
-  sbvBVSelectTerm (pix :: p0 ix) (pw :: p1 w) (pn :: p2 n) bv =
-    bvIsNonZeroFromGEq1 (Proxy @n) $
-      bvIsNonZeroFromGEq1 (Proxy @w) $
-        sbvDefaultBVSelectTerm pix pw pn bv
-  sbvBVExtendTerm (_ :: p0 l) (_ :: p1 r) signed bv =
-    withKnownProof
-      (unsafeKnownProof @(r - l) (natVal (Proxy @r) - natVal (Proxy @l)))
-      $ case (unsafeLeqProof @(l + 1) @r, unsafeLeqProof @1 @(r - l)) of
-        (LeqProof, LeqProof) ->
-          bvIsNonZeroFromGEq1 (Proxy @r) $
-            bvIsNonZeroFromGEq1 (Proxy @l) $
-              bvIsNonZeroFromGEq1 (Proxy @(r - l)) $
-                if signed then SBV.signExtend bv else SBV.zeroExtend bv
-
-instance PEvalBVTerm IntN where
-  pevalBVSelectTerm = pevalDefaultBVSelectTerm @WordN
-  pevalBVConcatTerm = pevalDefaultBVConcatTerm
-  pevalBVExtendTerm = pevalDefaultBVExtendTerm
-  sbvBVConcatTerm (pl :: p l) (pr :: q r) l r =
-    bvIsNonZeroFromGEq1 pl $
-      bvIsNonZeroFromGEq1 pr $
-        withKnownNat (addNat (natRepr @l) (natRepr @r)) $
-          case unsafeLeqProof @1 @(l + r) of
-            LeqProof ->
-              bvIsNonZeroFromGEq1 (Proxy @(l + r)) $
-                sbvBitCast @(WordN (l + r)) @(IntN (l + r)) $
-                  (sbvBitCast @(IntN l) @(WordN l) l)
-                    SBV.# (sbvBitCast @(IntN r) @(WordN r) r)
-  sbvBVSelectTerm (pix :: p0 ix) (pw :: p1 w) (pn :: p2 n) bv =
-    bvIsNonZeroFromGEq1 (Proxy @n) $
-      bvIsNonZeroFromGEq1 (Proxy @w) $
-        sbvDefaultBVSelectTerm pix pw pn bv
-  sbvBVExtendTerm (_ :: p0 l) (_ :: p1 r) signed bv =
-    withKnownProof
-      (unsafeKnownProof @(r - l) (natVal (Proxy @r) - natVal (Proxy @l)))
-      $ case (unsafeLeqProof @(l + 1) @r, unsafeLeqProof @1 @(r - l)) of
-        (LeqProof, LeqProof) ->
-          bvIsNonZeroFromGEq1 (Proxy @r) $
-            bvIsNonZeroFromGEq1 (Proxy @l) $
-              bvIsNonZeroFromGEq1 (Proxy @(r - l)) $
-                if signed
-                  then SBV.signExtend bv
-                  else
-                    SBV.sFromIntegral
-                      ( SBV.zeroExtend
-                          (SBV.sFromIntegral bv :: SBV.SBV (SBV.WordN l)) ::
-                          SBV.SBV (SBV.WordN r)
-                      )
-
-sbvDefaultBVSelectTerm ::
-  ( KnownNat ix,
-    KnownNat w,
-    KnownNat n,
-    1 <= n,
-    1 <= w,
-    (ix + w) <= n,
-    SBV.SymVal (bv n)
-  ) =>
-  p1 ix ->
-  p2 w ->
-  p3 n ->
-  SBV.SBV (bv n) ->
-  SBV.SBV (bv w)
-sbvDefaultBVSelectTerm (_ :: p0 ix) (_ :: p1 w) (_ :: p2 n) bv =
-  withKnownProof
-    ( unsafeKnownProof @(w + ix - 1)
-        (natVal (Proxy @w) + natVal (Proxy @ix) - 1)
-    )
-    $ case ( unsafeAxiom @(w + ix - 1 - ix + 1) @w,
-             unsafeLeqProof @(((w + ix) - 1) + 1) @n,
-             unsafeLeqProof @ix @(w + ix - 1)
-           ) of
-      (Refl, LeqProof, LeqProof) ->
-        bvIsNonZeroFromGEq1 (Proxy @n) $
-          bvIsNonZeroFromGEq1 (Proxy @w) $
-            SBV.bvExtract (Proxy @(w + ix - 1)) (Proxy @ix) bv
-
-instance (KnownNat n, 1 <= n) => PEvalBitCastTerm (WordN n) (IntN n) where
-  pevalBitCastTerm = unaryUnfoldOnce doPevalBitCastBV bitCastTerm
-    where
-      doPevalBitCastBV :: Term (WordN n) -> Maybe (Term (IntN n))
-      doPevalBitCastBV
-        (BVConcatTerm _ _ _ _ (l :: Term (WordN l)) (r :: Term (WordN r))) =
-          Just $
-            pevalBVConcatTerm
-              (pevalBitCastTerm @(WordN l) @(IntN l) l)
-              (pevalBitCastTerm @(WordN r) @(IntN r) r)
-      doPevalBitCastBV (BVExtendTerm _ _ _ _ signed pr (b :: Term (WordN l))) =
-        Just $
-          pevalBVExtendTerm signed pr $
-            pevalBitCastTerm @(WordN l) @(IntN l) b
-      doPevalBitCastBV v = doPevalBitCast v
-  sbvBitCast = bvIsNonZeroFromGEq1 (Proxy @n) SBV.sFromIntegral
-
-instance (KnownNat n, 1 <= n) => PEvalBitCastTerm (IntN n) (WordN n) where
-  pevalBitCastTerm = unaryUnfoldOnce doPevalBitCastBV bitCastTerm
-    where
-      doPevalBitCastBV :: Term (IntN n) -> Maybe (Term (WordN n))
-      doPevalBitCastBV
-        (BVConcatTerm _ _ _ _ (l :: Term (IntN l)) (r :: Term (IntN r))) =
-          Just $
-            pevalBVConcatTerm
-              (pevalBitCastTerm @(IntN l) @(WordN l) l)
-              (pevalBitCastTerm @(IntN r) @(WordN r) r)
-      doPevalBitCastBV (BVExtendTerm _ _ _ _ signed pr (b :: Term (IntN l))) =
-        Just $
-          pevalBVExtendTerm signed pr $
-            pevalBitCastTerm @(IntN l) @(WordN l) b
-      doPevalBitCastBV v = doPevalBitCast v
-  sbvBitCast = bvIsNonZeroFromGEq1 (Proxy @n) SBV.sFromIntegral
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitCastTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitCastTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitCastTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitCastTerm.hs
@@ -30,17 +30,18 @@
   )
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
 import Grisette.Internal.SymPrim.FP (FP, ValidFP, withValidFPProofs)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalBitCastOrTerm (pevalBitCastOrTerm, sbvBitCastOr),
     PEvalBitCastTerm (pevalBitCastTerm, sbvBitCast),
     SupportedPrim,
-    Term (BitCastTerm, ConTerm),
+    Term,
     bitCastOrTerm,
     bitCastTerm,
     conTerm,
-    introSupportedPrimConstraint,
+    pattern BitCastTerm,
+    pattern ConTerm,
     pattern DynTerm,
+    pattern SupportedTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold
   ( binaryUnfoldOnce,
@@ -49,14 +50,14 @@
 
 doPevalBitCastSameType ::
   forall x b. (SupportedPrim b) => Term x -> Maybe (Term b)
-doPevalBitCastSameType (BitCastTerm _ _ _ _ (DynTerm (b :: Term b))) = Just b
-doPevalBitCastSameType (BitCastTerm _ _ _ _ x) = doPevalBitCastSameType x
+doPevalBitCastSameType (BitCastTerm (DynTerm (b :: Term b))) = Just b
+doPevalBitCastSameType (BitCastTerm x) = doPevalBitCastSameType x
 doPevalBitCastSameType _ = Nothing
 
 -- | Partially evaluate a bitcast term. If no reduction is performed, return
 -- Nothing.
 doPevalBitCast :: (PEvalBitCastTerm a b, SupportedPrim b) => Term a -> Maybe (Term b)
-doPevalBitCast (ConTerm _ _ _ _ v) = Just $ conTerm $ bitCast v
+doPevalBitCast (ConTerm v) = Just $ conTerm $ bitCast v
 doPevalBitCast t = doPevalBitCastSameType t
 
 pevalBitCastGeneral ::
@@ -71,7 +72,7 @@
   Term b ->
   Term a ->
   Maybe (Term b)
-doPevalBitCastOr (ConTerm _ _ _ _ d) (ConTerm _ _ _ _ v) =
+doPevalBitCastOr (ConTerm d) (ConTerm v) =
   Just $ conTerm $ bitCastOr d v
 doPevalBitCastOr _ _ = Nothing
 
@@ -81,9 +82,8 @@
   Term b ->
   Term a ->
   Term b
-pevalBitCastOr d a =
-  introSupportedPrimConstraint d $
-    binaryUnfoldOnce doPevalBitCastOr bitCastOrTerm d a
+pevalBitCastOr d@SupportedTerm =
+  binaryUnfoldOnce doPevalBitCastOr bitCastOrTerm d
 
 instance PEvalBitCastTerm Bool (IntN 1) where
   pevalBitCastTerm = pevalBitCastGeneral
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitwiseTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitwiseTerm.hs
deleted file mode 100644
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalBitwiseTerm.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Eta reduce" #-}
-
--- |
--- Module      :   Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitwiseTerm
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitwiseTerm () where
-
-import Data.Bits (Bits (complement, xor, zeroBits, (.&.), (.|.)))
-import GHC.TypeLits (KnownNat, type (<=))
-import Grisette.Internal.SymPrim.BV (IntN, WordN)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
-import Grisette.Internal.SymPrim.Prim.Internal.Term
-  ( PEvalBitwiseTerm
-      ( pevalAndBitsTerm,
-        pevalComplementBitsTerm,
-        pevalOrBitsTerm,
-        pevalXorBitsTerm,
-        withSbvBitwiseTermConstraint
-      ),
-    SupportedPrim (withPrim),
-    Term (ComplementBitsTerm, ConTerm),
-    andBitsTerm,
-    complementBitsTerm,
-    conTerm,
-    orBitsTerm,
-    xorBitsTerm,
-  )
-import Grisette.Internal.SymPrim.Prim.Internal.Unfold
-  ( binaryUnfoldOnce,
-    unaryUnfoldOnce,
-  )
-
-pevalDefaultAndBitsTerm ::
-  (Bits a, SupportedPrim a, PEvalBitwiseTerm a) => Term a -> Term a -> Term a
-pevalDefaultAndBitsTerm = binaryUnfoldOnce doPevalAndBitsTerm andBitsTerm
-  where
-    doPevalAndBitsTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) =
-      Just $ conTerm (a .&. b)
-    doPevalAndBitsTerm (ConTerm _ _ _ _ a) b
-      | a == zeroBits = Just $ conTerm zeroBits
-      | a == complement zeroBits = Just b
-    doPevalAndBitsTerm a (ConTerm _ _ _ _ b)
-      | b == zeroBits = Just $ conTerm zeroBits
-      | b == complement zeroBits = Just a
-    doPevalAndBitsTerm a b | a == b = Just a
-    doPevalAndBitsTerm _ _ = Nothing
-
-pevalDefaultOrBitsTerm ::
-  (Bits a, SupportedPrim a, PEvalBitwiseTerm a) => Term a -> Term a -> Term a
-pevalDefaultOrBitsTerm = binaryUnfoldOnce doPevalOrBitsTerm orBitsTerm
-  where
-    doPevalOrBitsTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) = Just $ conTerm (a .|. b)
-    doPevalOrBitsTerm (ConTerm _ _ _ _ a) b
-      | a == zeroBits = Just b
-      | a == complement zeroBits = Just $ conTerm $ complement zeroBits
-    doPevalOrBitsTerm a (ConTerm _ _ _ _ b)
-      | b == zeroBits = Just a
-      | b == complement zeroBits = Just $ conTerm $ complement zeroBits
-    doPevalOrBitsTerm a b | a == b = Just a
-    doPevalOrBitsTerm _ _ = Nothing
-
-pevalDefaultXorBitsTerm ::
-  (PEvalBitwiseTerm a, SupportedPrim a, Bits a) => Term a -> Term a -> Term a
-pevalDefaultXorBitsTerm = binaryUnfoldOnce doPevalXorBitsTerm xorBitsTerm
-  where
-    doPevalXorBitsTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) =
-      Just $ conTerm (a `xor` b)
-    doPevalXorBitsTerm (ConTerm _ _ _ _ a) b
-      | a == zeroBits = Just b
-      | a == complement zeroBits = Just $ pevalComplementBitsTerm b
-    doPevalXorBitsTerm a (ConTerm _ _ _ _ b)
-      | b == zeroBits = Just a
-      | b == complement zeroBits = Just $ pevalComplementBitsTerm a
-    doPevalXorBitsTerm a b | a == b = Just $ conTerm zeroBits
-    doPevalXorBitsTerm (ComplementBitsTerm _ _ _ _ i) (ComplementBitsTerm _ _ _ _ j) =
-      Just $ pevalXorBitsTerm i j
-    doPevalXorBitsTerm (ComplementBitsTerm _ _ _ _ i) j =
-      Just $ pevalComplementBitsTerm $ pevalXorBitsTerm i j
-    doPevalXorBitsTerm i (ComplementBitsTerm _ _ _ _ j) =
-      Just $ pevalComplementBitsTerm $ pevalXorBitsTerm i j
-    doPevalXorBitsTerm _ _ = Nothing
-
-pevalDefaultComplementBitsTerm ::
-  (Bits a, SupportedPrim a, PEvalBitwiseTerm a) => Term a -> Term a
-pevalDefaultComplementBitsTerm =
-  unaryUnfoldOnce doPevalComplementBitsTerm complementBitsTerm
-  where
-    doPevalComplementBitsTerm (ConTerm _ _ _ _ a) = Just $ conTerm $ complement a
-    doPevalComplementBitsTerm (ComplementBitsTerm _ _ _ _ a) = Just a
-    doPevalComplementBitsTerm _ = Nothing
-
-instance (KnownNat n, 1 <= n) => PEvalBitwiseTerm (WordN n) where
-  pevalAndBitsTerm = pevalDefaultAndBitsTerm
-  pevalOrBitsTerm = pevalDefaultOrBitsTerm
-  pevalXorBitsTerm = pevalDefaultXorBitsTerm
-  pevalComplementBitsTerm = pevalDefaultComplementBitsTerm
-  withSbvBitwiseTermConstraint r = withPrim @(WordN n) r
-
-instance (KnownNat n, 1 <= n) => PEvalBitwiseTerm (IntN n) where
-  pevalAndBitsTerm = pevalDefaultAndBitsTerm
-  pevalOrBitsTerm = pevalDefaultOrBitsTerm
-  pevalXorBitsTerm = pevalDefaultXorBitsTerm
-  pevalComplementBitsTerm = pevalDefaultComplementBitsTerm
-  withSbvBitwiseTermConstraint r = withPrim @(IntN n) r
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalDivModIntegralTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalDivModIntegralTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalDivModIntegralTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalDivModIntegralTerm.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# HLINT ignore "Eta reduce" #-}
 {-# LANGUAGE TypeApplications #-}
@@ -27,7 +28,6 @@
 
 import GHC.TypeNats (KnownNat, type (<=))
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalDivModIntegralTerm
       ( pevalDivIntegralTerm,
@@ -37,28 +37,28 @@
         withSbvDivModIntegralTermConstraint
       ),
     SupportedPrim (withPrim),
-    Term (ConTerm),
+    Term,
     conTerm,
     divIntegralTerm,
-    introSupportedPrimConstraint,
     modIntegralTerm,
     quotIntegralTerm,
     remIntegralTerm,
+    pattern ConTerm,
+    pattern SupportedTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (binaryUnfoldOnce)
 
 -- | Default partial evaluation of division operation for integral types.
 pevalDefaultDivIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Term a
-pevalDefaultDivIntegralTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultDivIntegralTerm divIntegralTerm l r
+pevalDefaultDivIntegralTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultDivIntegralTerm divIntegralTerm l r
 
 doPevalDefaultDivIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultDivIntegralTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultDivIntegralTerm (ConTerm a) (ConTerm b)
   | b /= 0 = Just $ conTerm $ a `div` b
-doPevalDefaultDivIntegralTerm a (ConTerm _ _ _ _ 1) = Just a
+doPevalDefaultDivIntegralTerm a (ConTerm 1) = Just a
 doPevalDefaultDivIntegralTerm _ _ = Nothing
 
 -- | Default partial evaluation of division operation for bounded integral
@@ -68,80 +68,78 @@
   Term a ->
   Term a ->
   Term a
-pevalDefaultDivBoundedIntegralTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultDivBoundedIntegralTerm divIntegralTerm l r
+pevalDefaultDivBoundedIntegralTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultDivBoundedIntegralTerm divIntegralTerm l r
 
 doPevalDefaultDivBoundedIntegralTerm ::
   (PEvalDivModIntegralTerm a, Bounded a, Integral a) =>
   Term a ->
   Term a ->
   Maybe (Term a)
-doPevalDefaultDivBoundedIntegralTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultDivBoundedIntegralTerm (ConTerm a) (ConTerm b)
   | b /= 0 && (b /= -1 || a /= minBound) = Just $ conTerm $ a `div` b
-doPevalDefaultDivBoundedIntegralTerm a (ConTerm _ _ _ _ 1) = Just a
+doPevalDefaultDivBoundedIntegralTerm a (ConTerm 1) = Just a
 doPevalDefaultDivBoundedIntegralTerm _ _ = Nothing
 
 -- | Default partial evaluation of modulo operation for integral types.
 pevalDefaultModIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Term a
-pevalDefaultModIntegralTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultModIntegralTerm modIntegralTerm l r
+pevalDefaultModIntegralTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultModIntegralTerm modIntegralTerm l r
 
 doPevalDefaultModIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultModIntegralTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultModIntegralTerm (ConTerm a) (ConTerm b)
   | b /= 0 = Just $ conTerm $ a `mod` b
-doPevalDefaultModIntegralTerm _ (ConTerm _ _ _ _ 1) = Just $ conTerm 0
-doPevalDefaultModIntegralTerm _ (ConTerm _ _ _ _ (-1)) = Just $ conTerm 0
+doPevalDefaultModIntegralTerm _ (ConTerm 1) = Just $ conTerm 0
+doPevalDefaultModIntegralTerm _ (ConTerm (-1)) = Just $ conTerm 0
 doPevalDefaultModIntegralTerm _ _ = Nothing
 
 -- | Default partial evaluation of quotient operation for integral types.
 pevalDefaultQuotIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Term a
-pevalDefaultQuotIntegralTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultQuotIntegralTerm quotIntegralTerm l r
+pevalDefaultQuotIntegralTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultQuotIntegralTerm quotIntegralTerm l r
 
 doPevalDefaultQuotIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultQuotIntegralTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultQuotIntegralTerm (ConTerm a) (ConTerm b)
   | b /= 0 = Just $ conTerm $ a `quot` b
-doPevalDefaultQuotIntegralTerm a (ConTerm _ _ _ _ 1) = Just a
+doPevalDefaultQuotIntegralTerm a (ConTerm 1) = Just a
 doPevalDefaultQuotIntegralTerm _ _ = Nothing
 
 -- | Default partial evaluation of quotient operation for bounded integral
 -- types.
 pevalDefaultQuotBoundedIntegralTerm ::
-  (PEvalDivModIntegralTerm a, Bounded a, Integral a) => Term a -> Term a -> Term a
-pevalDefaultQuotBoundedIntegralTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultQuotBoundedIntegralTerm quotIntegralTerm l r
+  (PEvalDivModIntegralTerm a, Bounded a, Integral a) =>
+  Term a ->
+  Term a ->
+  Term a
+pevalDefaultQuotBoundedIntegralTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultQuotBoundedIntegralTerm quotIntegralTerm l r
 
 doPevalDefaultQuotBoundedIntegralTerm ::
   (PEvalDivModIntegralTerm a, Bounded a, Integral a) =>
   Term a ->
   Term a ->
   Maybe (Term a)
-doPevalDefaultQuotBoundedIntegralTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultQuotBoundedIntegralTerm (ConTerm a) (ConTerm b)
   | b /= 0 && (b /= -1 || a /= minBound) = Just $ conTerm $ a `quot` b
-doPevalDefaultQuotBoundedIntegralTerm a (ConTerm _ _ _ _ 1) = Just a
+doPevalDefaultQuotBoundedIntegralTerm a (ConTerm 1) = Just a
 doPevalDefaultQuotBoundedIntegralTerm _ _ = Nothing
 
 -- | Default partial evaluation of remainder operation for integral types.
 pevalDefaultRemIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Term a
-pevalDefaultRemIntegralTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultRemIntegralTerm remIntegralTerm l r
+pevalDefaultRemIntegralTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultRemIntegralTerm remIntegralTerm l r
 
 doPevalDefaultRemIntegralTerm ::
   (PEvalDivModIntegralTerm a, Integral a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultRemIntegralTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultRemIntegralTerm (ConTerm a) (ConTerm b)
   | b /= 0 = Just $ conTerm $ a `rem` b
-doPevalDefaultRemIntegralTerm _ (ConTerm _ _ _ _ 1) = Just $ conTerm 0
-doPevalDefaultRemIntegralTerm _ (ConTerm _ _ _ _ (-1)) = Just $ conTerm 0
+doPevalDefaultRemIntegralTerm _ (ConTerm 1) = Just $ conTerm 0
+doPevalDefaultRemIntegralTerm _ (ConTerm (-1)) = Just $ conTerm 0
 doPevalDefaultRemIntegralTerm _ _ = Nothing
 
 instance PEvalDivModIntegralTerm Integer where
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFP.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFP.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFP.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFP.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 -- |
 -- Module      :   Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
@@ -8,21 +9,7 @@
 -- Maintainer  :   siruilu@cs.washington.edu
 -- Stability   :   Experimental
 -- Portability :   GHC only
-module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
-  ( pevalFPTraitTerm,
-    sbvFPTraitTerm,
-    pevalFPUnaryTerm,
-    sbvFPUnaryTerm,
-    pevalFPBinaryTerm,
-    sbvFPBinaryTerm,
-    pevalFPRoundingUnaryTerm,
-    sbvFPRoundingUnaryTerm,
-    pevalFPRoundingBinaryTerm,
-    sbvFPRoundingBinaryTerm,
-    pevalFPFMATerm,
-    sbvFPFMATerm,
-  )
-where
+module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP () where
 
 import qualified Data.SBV as SBV
 import Grisette.Internal.Core.Data.Class.IEEEFP
@@ -43,7 +30,7 @@
         fpSub
       ),
   )
-import Grisette.Internal.SymPrim.FP (FP, FPRoundingMode, ValidFP)
+import Grisette.Internal.SymPrim.FP (FP, ValidFP)
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( FPBinaryOp (FPMaximum, FPMaximumNumber, FPMinimum, FPMinimumNumber, FPRem),
     FPRoundingBinaryOp (FPAdd, FPDiv, FPMul, FPSub),
@@ -63,8 +50,20 @@
         FPIsZero
       ),
     FPUnaryOp (FPAbs, FPNeg),
-    SupportedPrim,
-    Term (ConTerm),
+    PEvalFPTerm
+      ( pevalFPBinaryTerm,
+        pevalFPFMATerm,
+        pevalFPRoundingBinaryTerm,
+        pevalFPRoundingUnaryTerm,
+        pevalFPTraitTerm,
+        pevalFPUnaryTerm,
+        sbvFPBinaryTerm,
+        sbvFPFMATerm,
+        sbvFPRoundingBinaryTerm,
+        sbvFPRoundingUnaryTerm,
+        sbvFPTraitTerm,
+        sbvFPUnaryTerm
+      ),
     conTerm,
     fpBinaryTerm,
     fpFMATerm,
@@ -72,120 +71,129 @@
     fpRoundingUnaryTerm,
     fpTraitTerm,
     fpUnaryTerm,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (unaryUnfoldOnce)
 
--- | Partially evaluate a floating-point trait term.
-pevalFPTraitTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPTrait ->
-  Term (FP eb sb) ->
-  Term Bool
-pevalFPTraitTerm trait = unaryUnfoldOnce doPevalFPTraitTerm (fpTraitTerm trait)
-  where
-    doPevalFPTraitTerm (ConTerm _ _ _ _ a) = case trait of
-      FPIsNaN -> Just $ conTerm $ isNaN a
-      FPIsPositive ->
-        Just $
-          conTerm $
-            not (isNaN a) && a >= 0 && not (isNegativeZero a)
-      FPIsNegative ->
-        Just $ conTerm $ not (isNaN a) && (a < 0 || isNegativeZero a)
-      FPIsInfinite -> Just $ conTerm $ isInfinite a
-      FPIsPositiveInfinite -> Just $ conTerm $ isInfinite a && a > 0
-      FPIsNegativeInfinite -> Just $ conTerm $ isInfinite a && a < 0
-      FPIsPositiveZero ->
-        Just $ conTerm $ a == 0 && not (isNegativeZero a)
-      FPIsNegativeZero -> Just $ conTerm $ isNegativeZero a
-      FPIsZero -> Just $ conTerm $ a == 0
-      FPIsNormal ->
-        Just $
-          conTerm $
-            not (a == 0 || isNaN a || isInfinite a || isDenormalized a)
-      FPIsSubnormal -> Just $ conTerm $ isDenormalized a
-      FPIsPoint -> Just $ conTerm $ not (isNaN a || isInfinite a)
-    doPevalFPTraitTerm _ = Nothing
+instance PEvalFPTerm FP where
+  pevalFPTraitTerm trait =
+    unaryUnfoldOnce doPevalFPTraitTerm (fpTraitTerm trait)
+    where
+      doPevalFPTraitTerm (ConTerm a) = case trait of
+        FPIsNaN -> Just $ conTerm $ isNaN a
+        FPIsPositive ->
+          Just $
+            conTerm $
+              not (isNaN a) && a >= 0 && not (isNegativeZero a)
+        FPIsNegative ->
+          Just $ conTerm $ not (isNaN a) && (a < 0 || isNegativeZero a)
+        FPIsInfinite -> Just $ conTerm $ isInfinite a
+        FPIsPositiveInfinite -> Just $ conTerm $ isInfinite a && a > 0
+        FPIsNegativeInfinite -> Just $ conTerm $ isInfinite a && a < 0
+        FPIsPositiveZero ->
+          Just $ conTerm $ a == 0 && not (isNegativeZero a)
+        FPIsNegativeZero -> Just $ conTerm $ isNegativeZero a
+        FPIsZero -> Just $ conTerm $ a == 0
+        FPIsNormal ->
+          Just $
+            conTerm $
+              not (a == 0 || isNaN a || isInfinite a || isDenormalized a)
+        FPIsSubnormal -> Just $ conTerm $ isDenormalized a
+        FPIsPoint -> Just $ conTerm $ not (isNaN a || isInfinite a)
+      doPevalFPTraitTerm _ = Nothing
+  pevalFPUnaryTerm = fpUnaryTerm
+  {-# INLINE pevalFPUnaryTerm #-}
+  pevalFPBinaryTerm bop (ConTerm l) (ConTerm r) =
+    case bop of
+      FPMaximum -> conTerm $ fpMaximum l r
+      FPMaximumNumber -> conTerm $ fpMaximumNumber l r
+      FPMinimum -> conTerm $ fpMinimum l r
+      FPMinimumNumber -> conTerm $ fpMinimumNumber l r
+      FPRem -> conTerm $ fpRem l r
+  pevalFPBinaryTerm FPMaximum l r | l == r = l
+  pevalFPBinaryTerm FPMaximumNumber l r | l == r = l
+  pevalFPBinaryTerm FPMinimum l r | l == r = l
+  pevalFPBinaryTerm FPMinimumNumber l r | l == r = l
+  pevalFPBinaryTerm bop l r = fpBinaryTerm bop l r
+  {-# INLINE pevalFPBinaryTerm #-}
+  pevalFPRoundingUnaryTerm uop (ConTerm rd) (ConTerm l) =
+    case uop of
+      FPSqrt -> conTerm $ fpSqrt rd l
+      FPRoundToIntegral -> conTerm $ fpRoundToIntegral rd l
+  pevalFPRoundingUnaryTerm uop rd l = fpRoundingUnaryTerm uop rd l
+  {-# INLINE pevalFPRoundingUnaryTerm #-}
+  pevalFPRoundingBinaryTerm bop (ConTerm rd) (ConTerm l) (ConTerm r) =
+    case bop of
+      FPAdd -> conTerm $ fpAdd rd l r
+      FPSub -> conTerm $ fpSub rd l r
+      FPMul -> conTerm $ fpMul rd l r
+      FPDiv -> conTerm $ fpDiv rd l r
+  pevalFPRoundingBinaryTerm bop rd l r = fpRoundingBinaryTerm bop rd l r
+  {-# INLINE pevalFPRoundingBinaryTerm #-}
+  pevalFPFMATerm (ConTerm rd) (ConTerm x) (ConTerm y) (ConTerm z) =
+    conTerm $ fpFMA rd x y z
+  pevalFPFMATerm rd x y z = fpFMATerm rd x y z
+  {-# INLINE pevalFPFMATerm #-}
 
--- Workaround for https://github.com/GaloisInc/libBF-hs/pull/32, which affects
--- the correctness of the Ord instance for 'Data.SBV.FloatingPoint'.
-goodFpIsPositive ::
-  (ValidFP eb sb) =>
-  SBV.SFloatingPoint eb sb ->
-  SBV.SBool
-goodFpIsPositive x =
-  SBV.sNot (SBV.fpIsNaN x) SBV..&& SBV.fpIsPositive x
-{-# INLINE goodFpIsPositive #-}
+  sbvFPTraitTerm FPIsNaN = SBV.fpIsNaN
+  sbvFPTraitTerm FPIsPositive = goodFpIsPositive
+  sbvFPTraitTerm FPIsNegative = goodFpIsNegative
+  sbvFPTraitTerm FPIsInfinite = SBV.fpIsInfinite
+  sbvFPTraitTerm FPIsPositiveInfinite = \f ->
+    SBV.fpIsInfinite f SBV..&& goodFpIsPositive f
+  sbvFPTraitTerm FPIsNegativeInfinite = \f ->
+    SBV.fpIsInfinite f SBV..&& goodFpIsNegative f
+  sbvFPTraitTerm FPIsPositiveZero =
+    \f -> SBV.fpIsZero f SBV..&& goodFpIsPositive f
+  sbvFPTraitTerm FPIsNegativeZero =
+    \f -> SBV.fpIsZero f SBV..&& goodFpIsNegative f
+  sbvFPTraitTerm FPIsZero = SBV.fpIsZero
+  sbvFPTraitTerm FPIsNormal = SBV.fpIsNormal
+  sbvFPTraitTerm FPIsSubnormal = SBV.fpIsSubnormal
+  sbvFPTraitTerm FPIsPoint = SBV.fpIsPoint
 
-goodFpIsNegative ::
-  (ValidFP eb sb) =>
-  SBV.SFloatingPoint eb sb ->
-  SBV.SBool
-goodFpIsNegative x = SBV.sNot (SBV.fpIsNaN x) SBV..&& SBV.fpIsNegative x
-{-# INLINE goodFpIsNegative #-}
+  sbvFPUnaryTerm FPAbs = SBV.fpAbs
+  sbvFPUnaryTerm FPNeg = SBV.fpNeg
+  {-# INLINE sbvFPUnaryTerm #-}
 
--- | Lowering an floating-point trait term to sbv.
-sbvFPTraitTerm ::
-  (ValidFP eb sb) =>
-  FPTrait ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SBool
-sbvFPTraitTerm FPIsNaN = SBV.fpIsNaN
-sbvFPTraitTerm FPIsPositive = goodFpIsPositive
-sbvFPTraitTerm FPIsNegative = goodFpIsNegative
-sbvFPTraitTerm FPIsInfinite = SBV.fpIsInfinite
-sbvFPTraitTerm FPIsPositiveInfinite = \f ->
-  SBV.fpIsInfinite f SBV..&& goodFpIsPositive f
-sbvFPTraitTerm FPIsNegativeInfinite = \f ->
-  SBV.fpIsInfinite f SBV..&& goodFpIsNegative f
-sbvFPTraitTerm FPIsPositiveZero =
-  \f -> SBV.fpIsZero f SBV..&& goodFpIsPositive f
-sbvFPTraitTerm FPIsNegativeZero =
-  \f -> SBV.fpIsZero f SBV..&& goodFpIsNegative f
-sbvFPTraitTerm FPIsZero = SBV.fpIsZero
-sbvFPTraitTerm FPIsNormal = SBV.fpIsNormal
-sbvFPTraitTerm FPIsSubnormal = SBV.fpIsSubnormal
-sbvFPTraitTerm FPIsPoint = SBV.fpIsPoint
+  sbvFPBinaryTerm FPRem x y = SBV.fpRem x y
+  sbvFPBinaryTerm FPMinimum x y =
+    SBV.ite (SBV.fpIsNaN x SBV..|| SBV.fpIsNaN y) SBV.nan $
+      SBV.ite (sbvCmpHandleNegZero x y) x y
+  sbvFPBinaryTerm FPMinimumNumber x y =
+    SBV.ite (SBV.fpIsNaN x) y $
+      SBV.ite (SBV.fpIsNaN y) x $
+        SBV.ite (sbvCmpHandleNegZero x y) x y
+  sbvFPBinaryTerm FPMaximum x y =
+    SBV.ite (SBV.fpIsNaN x SBV..|| SBV.fpIsNaN y) SBV.nan $
+      SBV.ite (sbvCmpHandleNegZero x y) y x
+  sbvFPBinaryTerm FPMaximumNumber x y =
+    SBV.ite (SBV.fpIsNaN x) y $
+      SBV.ite (SBV.fpIsNaN y) x $
+        SBV.ite (sbvCmpHandleNegZero x y) y x
+  {-# INLINE sbvFPBinaryTerm #-}
 
--- | Partially evaluate a floating-point unary term.
-pevalFPUnaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPUnaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-pevalFPUnaryTerm = fpUnaryTerm
-{-# INLINE pevalFPUnaryTerm #-}
+  sbvFPRoundingUnaryTerm FPSqrt = SBV.fpSqrt
+  sbvFPRoundingUnaryTerm FPRoundToIntegral = SBV.fpRoundToIntegral
+  {-# INLINE sbvFPRoundingUnaryTerm #-}
 
--- | Lowering an floating-point unary term to sbv.
-sbvFPUnaryTerm ::
-  (ValidFP eb sb) =>
-  FPUnaryOp ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb
-sbvFPUnaryTerm FPAbs = SBV.fpAbs
-sbvFPUnaryTerm FPNeg = SBV.fpNeg
-{-# INLINE sbvFPUnaryTerm #-}
+  sbvFPRoundingBinaryTerm FPAdd = SBV.fpAdd
+  sbvFPRoundingBinaryTerm FPSub = SBV.fpSub
+  sbvFPRoundingBinaryTerm FPMul = SBV.fpMul
+  sbvFPRoundingBinaryTerm FPDiv = SBV.fpDiv
+  {-# INLINE sbvFPRoundingBinaryTerm #-}
 
--- | Partially evaluate a floating-point binary term.
-pevalFPBinaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPBinaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-pevalFPBinaryTerm bop (ConTerm _ _ _ _ l) (ConTerm _ _ _ _ r) =
-  case bop of
-    FPMaximum -> conTerm $ fpMaximum l r
-    FPMaximumNumber -> conTerm $ fpMaximumNumber l r
-    FPMinimum -> conTerm $ fpMinimum l r
-    FPMinimumNumber -> conTerm $ fpMinimumNumber l r
-    FPRem -> conTerm $ fpRem l r
-pevalFPBinaryTerm FPMaximum l r | l == r = l
-pevalFPBinaryTerm FPMaximumNumber l r | l == r = l
-pevalFPBinaryTerm FPMinimum l r | l == r = l
-pevalFPBinaryTerm FPMinimumNumber l r | l == r = l
-pevalFPBinaryTerm bop l r = fpBinaryTerm bop l r
-{-# INLINE pevalFPBinaryTerm #-}
+  sbvFPFMATerm = SBV.fpFMA
+  {-# INLINE sbvFPFMATerm #-}
 
+goodFpIsPositive :: (ValidFP eb sb) => SBV.SFloatingPoint eb sb -> SBV.SBool
+goodFpIsPositive x = SBV.sNot (SBV.fpIsNaN x) SBV..&& SBV.fpIsPositive x
+{-# INLINE goodFpIsPositive #-}
+
+goodFpIsNegative :: (ValidFP eb sb) => SBV.SFloatingPoint eb sb -> SBV.SBool
+goodFpIsNegative x = SBV.sNot (SBV.fpIsNaN x) SBV..&& SBV.fpIsNegative x
+{-# INLINE goodFpIsNegative #-}
+
 sbvCmpHandleNegZero ::
   (ValidFP eb sb) =>
   SBV.SFloatingPoint eb sb ->
@@ -196,111 +204,4 @@
     (SBV.fpIsZero x SBV..&& SBV.fpIsZero y)
     (SBV.fpIsNegativeZero x)
     (x SBV..< y)
-
--- | Lowering an floating-point binary term to sbv.
-sbvFPBinaryTerm ::
-  (ValidFP eb sb) =>
-  FPBinaryOp ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb
-sbvFPBinaryTerm FPRem x y = SBV.fpRem x y
-sbvFPBinaryTerm FPMinimum x y =
-  SBV.ite (SBV.fpIsNaN x SBV..|| SBV.fpIsNaN y) SBV.nan $
-    SBV.ite (sbvCmpHandleNegZero x y) x y
-sbvFPBinaryTerm FPMinimumNumber x y =
-  SBV.ite (SBV.fpIsNaN x) y $
-    SBV.ite (SBV.fpIsNaN y) x $
-      SBV.ite (sbvCmpHandleNegZero x y) x y
-sbvFPBinaryTerm FPMaximum x y =
-  SBV.ite (SBV.fpIsNaN x SBV..|| SBV.fpIsNaN y) SBV.nan $
-    SBV.ite (sbvCmpHandleNegZero x y) y x
-sbvFPBinaryTerm FPMaximumNumber x y =
-  SBV.ite (SBV.fpIsNaN x) y $
-    SBV.ite (SBV.fpIsNaN y) x $
-      SBV.ite (sbvCmpHandleNegZero x y) y x
-{-# INLINE sbvFPBinaryTerm #-}
-
--- | Partially evaluate a floating-point rounding unary term.
-pevalFPRoundingUnaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPRoundingUnaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-pevalFPRoundingUnaryTerm uop (ConTerm _ _ _ _ rd) (ConTerm _ _ _ _ l) =
-  case uop of
-    FPSqrt -> conTerm $ fpSqrt rd l
-    FPRoundToIntegral -> conTerm $ fpRoundToIntegral rd l
-pevalFPRoundingUnaryTerm uop rd l = fpRoundingUnaryTerm uop rd l
-{-# INLINE pevalFPRoundingUnaryTerm #-}
-
--- | Lowering an floating-point rounding unary term to sbv.
-sbvFPRoundingUnaryTerm ::
-  (ValidFP eb sb) =>
-  FPRoundingUnaryOp ->
-  SBV.SRoundingMode ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb
-sbvFPRoundingUnaryTerm FPSqrt = SBV.fpSqrt
-sbvFPRoundingUnaryTerm FPRoundToIntegral = SBV.fpRoundToIntegral
-{-# INLINE sbvFPRoundingUnaryTerm #-}
-
--- | Partially evaluate a floating-point rounding binary term.
-pevalFPRoundingBinaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPRoundingBinaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-pevalFPRoundingBinaryTerm bop (ConTerm _ _ _ _ rd) (ConTerm _ _ _ _ l) (ConTerm _ _ _ _ r) =
-  case bop of
-    FPAdd -> conTerm $ fpAdd rd l r
-    FPSub -> conTerm $ fpSub rd l r
-    FPMul -> conTerm $ fpMul rd l r
-    FPDiv -> conTerm $ fpDiv rd l r
-pevalFPRoundingBinaryTerm bop rd l r = fpRoundingBinaryTerm bop rd l r
-{-# INLINE pevalFPRoundingBinaryTerm #-}
-
--- | Lowering an floating-point rounding binary term to sbv.
-sbvFPRoundingBinaryTerm ::
-  (ValidFP eb sb) =>
-  FPRoundingBinaryOp ->
-  SBV.SRoundingMode ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb
-sbvFPRoundingBinaryTerm FPAdd = SBV.fpAdd
-sbvFPRoundingBinaryTerm FPSub = SBV.fpSub
-sbvFPRoundingBinaryTerm FPMul = SBV.fpMul
-sbvFPRoundingBinaryTerm FPDiv = SBV.fpDiv
-{-# INLINE sbvFPRoundingBinaryTerm #-}
-
--- | Partially evaluate a floating-point fused multiply-add term.
-pevalFPFMATerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-pevalFPFMATerm
-  (ConTerm _ _ _ _ rd)
-  (ConTerm _ _ _ _ x)
-  (ConTerm _ _ _ _ y)
-  (ConTerm _ _ _ _ z) =
-    conTerm $ fpFMA rd x y z
-pevalFPFMATerm rd x y z = fpFMATerm rd x y z
-{-# INLINE pevalFPFMATerm #-}
-
--- | Lowering an floating-point fused multiply-add term to sbv.
-sbvFPFMATerm ::
-  (ValidFP eb sb) =>
-  SBV.SRoundingMode ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb ->
-  SBV.SFloatingPoint eb sb
-sbvFPFMATerm = SBV.fpFMA
-{-# INLINE sbvFPFMATerm #-}
+{-# INLINE sbvCmpHandleNegZero #-}
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFloatingTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFloatingTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFloatingTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFloatingTerm.hs
@@ -16,7 +16,6 @@
 
 import Grisette.Internal.SymPrim.AlgReal (AlgReal)
 import Grisette.Internal.SymPrim.FP (FP, ValidFP)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( FloatingUnaryOp (FloatingAcosh, FloatingAsinh, FloatingAtanh, FloatingSqrt),
     PEvalFloatingTerm
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFractionalTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFractionalTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFractionalTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFractionalTerm.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -17,7 +18,6 @@
 
 import Grisette.Internal.SymPrim.AlgReal (AlgReal)
 import Grisette.Internal.SymPrim.FP (FP, ValidFP)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalFractionalTerm
       ( pevalFdivTerm,
@@ -25,11 +25,12 @@
         withSbvFractionalTermConstraint
       ),
     SupportedPrim (withPrim),
-    Term (ConTerm),
+    Term,
     conTerm,
     fdivTerm,
-    introSupportedPrimConstraint,
     recipTerm,
+    pattern ConTerm,
+    pattern SupportedTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold
   ( binaryUnfoldOnce,
@@ -45,26 +46,24 @@
 
 pevalDefaultFdivTerm ::
   (PEvalFractionalTerm a, Eq a) => Term a -> Term a -> Term a
-pevalDefaultFdivTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce doPevalDefaultFdivTerm fdivTerm l r
+pevalDefaultFdivTerm l@SupportedTerm r =
+  binaryUnfoldOnce doPevalDefaultFdivTerm fdivTerm l r
 
 doPevalDefaultFdivTerm ::
   (PEvalFractionalTerm a, Eq a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultFdivTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b)
+doPevalDefaultFdivTerm (ConTerm a) (ConTerm b)
   | b /= 0 = Just $ conTerm $ a / b
-doPevalDefaultFdivTerm a (ConTerm _ _ _ _ 1) = Just a
+doPevalDefaultFdivTerm a (ConTerm 1) = Just a
 doPevalDefaultFdivTerm _ _ = Nothing
 
 pevalDefaultRecipTerm ::
   (PEvalFractionalTerm a, Eq a) => Term a -> Term a
-pevalDefaultRecipTerm l =
-  introSupportedPrimConstraint l $
-    unaryUnfoldOnce doPevalDefaultRecipTerm recipTerm l
+pevalDefaultRecipTerm l@SupportedTerm =
+  unaryUnfoldOnce doPevalDefaultRecipTerm recipTerm l
 
 doPevalDefaultRecipTerm ::
   (PEvalFractionalTerm a, Eq a) => Term a -> Maybe (Term a)
-doPevalDefaultRecipTerm (ConTerm _ _ _ _ n) | n /= 0 = Just $ conTerm $ recip n
+doPevalDefaultRecipTerm (ConTerm n) | n /= 0 = Just $ conTerm $ recip n
 doPevalDefaultRecipTerm _ = Nothing
 
 instance PEvalFractionalTerm AlgReal where
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFromIntegralTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFromIntegralTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFromIntegralTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalFromIntegralTerm.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
@@ -24,16 +25,15 @@
 import Grisette.Internal.SymPrim.AlgReal (AlgReal)
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
 import Grisette.Internal.SymPrim.FP (FP, ValidFP)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim
-  ( bvIsNonZeroFromGEq1,
-  )
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalFromIntegralTerm (pevalFromIntegralTerm, sbvFromIntegralTerm),
     SupportedNonFuncPrim (withNonFuncPrim),
     SupportedPrim,
-    Term (ConTerm),
+    Term,
+    bvIsNonZeroFromGEq1,
     conTerm,
     fromIntegralTerm,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (unaryUnfoldOnce)
 
@@ -42,7 +42,7 @@
 pevalFromIntegralTermGeneric =
   unaryUnfoldOnce doPEvalFromIntegralTerm fromIntegralTerm
   where
-    doPEvalFromIntegralTerm (ConTerm _ _ _ _ a) = Just $ conTerm $ fromIntegral a
+    doPEvalFromIntegralTerm (ConTerm a) = Just $ conTerm $ fromIntegral a
     doPEvalFromIntegralTerm _ = Nothing
 
 instance PEvalFromIntegralTerm Integer Integer where
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalIEEEFPConvertibleTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalIEEEFPConvertibleTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalIEEEFPConvertibleTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalIEEEFPConvertibleTerm.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
@@ -50,9 +51,6 @@
     FPRoundingMode (RNA, RNE, RTN, RTP, RTZ),
     ValidFP,
   )
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim
-  ( bvIsNonZeroFromGEq1,
-  )
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalIEEEFPConvertibleTerm
       ( pevalFromFPOrTerm,
@@ -62,10 +60,12 @@
       ),
     SBVRep (SBVType),
     SupportedPrim (conSBVTerm),
-    Term (ConTerm),
+    Term,
+    bvIsNonZeroFromGEq1,
     conTerm,
     fromFPOrTerm,
     toFPTerm,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (binaryUnfoldOnce)
 
@@ -143,9 +143,9 @@
   Term FPRoundingMode ->
   Term (FP eb sb) ->
   Term a
-generalPevalFromFPOrTerm (ConTerm _ _ _ _ d) (ConTerm _ _ _ _ rd) (ConTerm _ _ _ _ f) =
+generalPevalFromFPOrTerm (ConTerm d) (ConTerm rd) (ConTerm f) =
   conTerm $ fromFPOr d rd f
-generalPevalFromFPOrTerm d _ (ConTerm _ _ _ _ f) | fpIsNaN f || fpIsInfinite f = d
+generalPevalFromFPOrTerm d _ (ConTerm f) | fpIsNaN f || fpIsInfinite f = d
 generalPevalFromFPOrTerm d rd f = fromFPOrTerm d rd f
 
 algRealPevalFromFPOrTerm ::
@@ -157,9 +157,9 @@
   Term FPRoundingMode ->
   Term (FP eb sb) ->
   Term AlgReal
-algRealPevalFromFPOrTerm (ConTerm _ _ _ _ d) _ (ConTerm _ _ _ _ f) =
+algRealPevalFromFPOrTerm (ConTerm d) _ (ConTerm f) =
   conTerm $ fromFPOr d RNE f
-algRealPevalFromFPOrTerm d _ (ConTerm _ _ _ _ f) | fpIsNaN f || fpIsInfinite f = d
+algRealPevalFromFPOrTerm d _ (ConTerm f) | fpIsNaN f || fpIsInfinite f = d
 algRealPevalFromFPOrTerm d _ f = fromFPOrTerm d (conTerm RNE) f
 
 generalDoPevalToFPTerm ::
@@ -170,7 +170,7 @@
   Term FPRoundingMode ->
   Term a ->
   Maybe (Term (FP eb sb))
-generalDoPevalToFPTerm (ConTerm _ _ _ _ rd) (ConTerm _ _ _ _ f) =
+generalDoPevalToFPTerm (ConTerm rd) (ConTerm f) =
   Just $ conTerm $ toFP rd f
 generalDoPevalToFPTerm _ _ = Nothing
 
@@ -192,9 +192,9 @@
   Term FPRoundingMode ->
   Term (FP eb1 sb1) ->
   Maybe (Term (FP eb sb))
-fpDoPevalToFPTerm (ConTerm _ _ _ _ rd) (ConTerm _ _ _ _ f) =
+fpDoPevalToFPTerm (ConTerm rd) (ConTerm f) =
   Just $ conTerm $ toFP rd f
-fpDoPevalToFPTerm _ (ConTerm _ _ _ _ f)
+fpDoPevalToFPTerm _ (ConTerm f)
   | fpIsNaN f = Just $ conTerm fpNaN
   | fpIsPositiveInfinite f = Just $ conTerm fpPositiveInfinite
   | fpIsNegativeInfinite f = Just $ conTerm fpNegativeInfinite
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalNumTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalNumTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalNumTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalNumTerm.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# HLINT ignore "Eta reduce" #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
@@ -16,20 +15,10 @@
 -- Maintainer  :   siruilu@cs.washington.edu
 -- Stability   :   Experimental
 -- Portability :   GHC only
-module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalNumTerm
-  ( pevalDefaultAddNumTerm,
-    pevalDefaultNegNumTerm,
-  )
-where
+module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalNumTerm () where
 
-import Control.Monad (msum)
-import Data.Bits (Bits)
-import Data.SBV (Bits (isSigned))
-import GHC.TypeLits (KnownNat, type (<=))
 import Grisette.Internal.SymPrim.AlgReal (AlgReal)
-import Grisette.Internal.SymPrim.BV (IntN, WordN)
 import Grisette.Internal.SymPrim.FP (FP, ValidFP)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalNumTerm
       ( pevalAbsNumTerm,
@@ -40,194 +29,23 @@
         withSbvNumTermConstraint
       ),
     SupportedPrim (withPrim),
-    Term (AbsNumTerm, AddNumTerm, ConTerm, MulNumTerm, NegNumTerm),
     absNumTerm,
     addNumTerm,
-    conTerm,
-    introSupportedPrimConstraint,
+    doPevalNoOverflowAbsNumTerm,
+    doPevalNoOverflowSignumNumTerm,
     mulNumTerm,
     negNumTerm,
-    pevalSubNumTerm,
+    pevalDefaultAddNumTerm,
+    pevalDefaultMulNumTerm,
+    pevalDefaultNegNumTerm,
     signumNumTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold
-  ( binaryUnfoldOnce,
-    generalBinaryUnfolded,
+  ( generalBinaryUnfolded,
     generalUnaryUnfolded,
     unaryUnfoldOnce,
   )
 
--- | Default partial evaluation of addition of numerical terms.
-pevalDefaultAddNumTerm :: (PEvalNumTerm a, Eq a) => Term a -> Term a -> Term a
-pevalDefaultAddNumTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce
-      doPevalDefaultAddNumTerm
-      (\a b -> normalizeAddNum $ addNumTerm a b)
-      l
-      r
-
-doPevalDefaultAddNumTerm ::
-  (PEvalNumTerm a, Eq a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultAddNumTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) = Just $ conTerm $ a + b
-doPevalDefaultAddNumTerm l@(ConTerm _ _ _ _ a) b = case (a, b) of
-  (0, k) -> Just k
-  (l1, AddNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k) ->
-    Just $ pevalAddNumTerm (conTerm $ l1 + j) k
-  _ -> doPevalDefaultAddNumTermNoCon l b
-doPevalDefaultAddNumTerm a r@(ConTerm {}) = doPevalDefaultAddNumTerm r a
-doPevalDefaultAddNumTerm l r = doPevalDefaultAddNumTermNoCon l r
-
-doPevalDefaultAddNumTermNoCon ::
-  (PEvalNumTerm a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultAddNumTermNoCon (AddNumTerm _ _ _ _ i@ConTerm {} j) k =
-  Just $ pevalAddNumTerm i $ pevalAddNumTerm j k
-doPevalDefaultAddNumTermNoCon i (AddNumTerm _ _ _ _ j@ConTerm {} k) =
-  Just $ pevalAddNumTerm j $ pevalAddNumTerm i k
-doPevalDefaultAddNumTermNoCon (NegNumTerm _ _ _ _ i) (NegNumTerm _ _ _ _ j) =
-  Just $ pevalNegNumTerm $ pevalAddNumTerm i j
-doPevalDefaultAddNumTermNoCon
-  (MulNumTerm _ _ _ _ (ConTerm _ _ _ _ i) j)
-  (MulNumTerm _ _ _ _ (ConTerm _ _ _ _ k) l)
-    | j == l = Just $ pevalMulNumTerm (conTerm $ i + k) j
-doPevalDefaultAddNumTermNoCon
-  (MulNumTerm _ _ _ _ i@ConTerm {} j)
-  (MulNumTerm _ _ _ _ k@(ConTerm {}) l)
-    | i == k = Just $ pevalMulNumTerm i (pevalAddNumTerm j l)
-doPevalDefaultAddNumTermNoCon _ _ = Nothing
-
-normalizeAddNum :: (PEvalNumTerm a) => Term a -> Term a
-normalizeAddNum (AddNumTerm _ _ _ _ l r@(ConTerm {})) = addNumTerm r l
-normalizeAddNum v = v
-
--- | Default partial evaluation of negation of numerical terms.
-pevalDefaultNegNumTerm :: (PEvalNumTerm a, Eq a) => Term a -> Term a
-pevalDefaultNegNumTerm l =
-  introSupportedPrimConstraint l $
-    unaryUnfoldOnce doPevalDefaultNegNumTerm negNumTerm l
-
-doPevalDefaultNegNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
-doPevalDefaultNegNumTerm (ConTerm _ _ _ _ a) = Just $ conTerm $ -a
-doPevalDefaultNegNumTerm (NegNumTerm _ _ _ _ v) = Just v
-doPevalDefaultNegNumTerm (AddNumTerm _ _ _ _ (ConTerm _ _ _ _ l) r) =
-  Just $ pevalSubNumTerm (conTerm $ -l) r
-doPevalDefaultNegNumTerm (AddNumTerm _ _ _ _ (NegNumTerm _ _ _ _ l) r) =
-  Just $ pevalAddNumTerm l (pevalNegNumTerm r)
-doPevalDefaultNegNumTerm (AddNumTerm _ _ _ _ l (NegNumTerm _ _ _ _ r)) =
-  Just $ pevalAddNumTerm (pevalNegNumTerm l) r
-doPevalDefaultNegNumTerm (MulNumTerm _ _ _ _ (ConTerm _ _ _ _ l) r) =
-  Just $ pevalMulNumTerm (conTerm $ -l) r
-doPevalDefaultNegNumTerm (MulNumTerm _ _ _ _ (NegNumTerm {}) _) =
-  error "Should not happen"
-doPevalDefaultNegNumTerm (MulNumTerm _ _ _ _ _ (NegNumTerm {})) =
-  error "Should not happen"
-doPevalDefaultNegNumTerm (AddNumTerm _ _ _ _ _ ConTerm {}) = error "Should not happen"
-doPevalDefaultNegNumTerm _ = Nothing
-
--- Mul
-pevalDefaultMulNumTerm :: (PEvalNumTerm a, Eq a) => Term a -> Term a -> Term a
-pevalDefaultMulNumTerm l r =
-  introSupportedPrimConstraint l $
-    binaryUnfoldOnce
-      doPevalDefaultMulNumTerm
-      (\a b -> normalizeMulNum $ mulNumTerm a b)
-      l
-      r
-
-normalizeMulNum :: (PEvalNumTerm a) => Term a -> Term a
-normalizeMulNum (MulNumTerm _ _ _ _ l r@(ConTerm {})) = mulNumTerm r l
-normalizeMulNum v = v
-
-doPevalDefaultMulNumTerm ::
-  (PEvalNumTerm a, Eq a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultMulNumTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) =
-  Just $ conTerm $ a * b
-doPevalDefaultMulNumTerm l@(ConTerm _ _ _ _ a) b = case (a, b) of
-  (0, _) -> Just $ conTerm 0
-  (1, k) -> Just k
-  (-1, k) -> Just $ pevalNegNumTerm k
-  (l1, MulNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k) ->
-    Just $ pevalMulNumTerm (conTerm $ l1 * j) k
-  (l1, AddNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k) ->
-    Just $ pevalAddNumTerm (conTerm $ l1 * j) (pevalMulNumTerm (conTerm l1) k)
-  (l1, NegNumTerm _ _ _ _ j) -> Just (pevalMulNumTerm (conTerm $ -l1) j)
-  (_, MulNumTerm _ _ _ _ _ ConTerm {}) -> error "Should not happen"
-  (_, AddNumTerm _ _ _ _ _ ConTerm {}) -> error "Should not happen"
-  _ -> doPevalDefaultMulNumTermNoCon l b
-doPevalDefaultMulNumTerm a r@(ConTerm {}) = doPevalDefaultMulNumTerm r a
-doPevalDefaultMulNumTerm l r = doPevalDefaultMulNumTermNoCon l r
-
-doPevalDefaultMulNumTermNoCon ::
-  (PEvalNumTerm a) => Term a -> Term a -> Maybe (Term a)
-doPevalDefaultMulNumTermNoCon (MulNumTerm _ _ _ _ i@ConTerm {} j) k =
-  Just $ pevalMulNumTerm i $ pevalMulNumTerm j k
-doPevalDefaultMulNumTermNoCon i (MulNumTerm _ _ _ _ j@ConTerm {} k) =
-  Just $ pevalMulNumTerm j $ pevalMulNumTerm i k
-doPevalDefaultMulNumTermNoCon (NegNumTerm _ _ _ _ i) j =
-  Just $ pevalNegNumTerm $ pevalMulNumTerm i j
-doPevalDefaultMulNumTermNoCon i (NegNumTerm _ _ _ _ j) =
-  Just $ pevalNegNumTerm $ pevalMulNumTerm i j
-doPevalDefaultMulNumTermNoCon i j@ConTerm {} = Just $ pevalMulNumTerm j i
-doPevalDefaultMulNumTermNoCon (MulNumTerm _ _ _ _ _ ConTerm {}) _ =
-  error "Should not happen"
-doPevalDefaultMulNumTermNoCon _ (MulNumTerm _ _ _ _ _ ConTerm {}) =
-  error "Should not happen"
-doPevalDefaultMulNumTermNoCon _ _ = Nothing
-
--- Abs
-pevalBitsAbsNumTerm :: (PEvalNumTerm a, Bits a) => Term a -> Term a
-pevalBitsAbsNumTerm l =
-  introSupportedPrimConstraint l $
-    unaryUnfoldOnce doPevalBitsAbsNumTerm absNumTerm l
-
-doPevalGeneralAbsNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
-doPevalGeneralAbsNumTerm (ConTerm _ _ _ _ a) = Just $ conTerm $ abs a
-doPevalGeneralAbsNumTerm (NegNumTerm _ _ _ _ v) = Just $ pevalAbsNumTerm v
-doPevalGeneralAbsNumTerm t@(AbsNumTerm {}) = Just t
-doPevalGeneralAbsNumTerm _ = Nothing
-
-doPevalBitsAbsNumTerm ::
-  forall a. (PEvalNumTerm a, Bits a) => Term a -> Maybe (Term a)
-doPevalBitsAbsNumTerm t =
-  msum
-    [ if isSigned (undefined :: a) then Nothing else Just t,
-      doPevalGeneralAbsNumTerm t
-    ]
-
-doPevalNoOverflowAbsNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
-doPevalNoOverflowAbsNumTerm t =
-  msum
-    [ doPevalGeneralAbsNumTerm t,
-      case t of
-        MulNumTerm _ _ _ _ l r ->
-          Just $ pevalMulNumTerm (pevalAbsNumTerm l) $ pevalAbsNumTerm r
-        _ -> Nothing
-    ]
-
--- Signum
-
-pevalGeneralSignumNumTerm :: (PEvalNumTerm a) => Term a -> Term a
-pevalGeneralSignumNumTerm l =
-  introSupportedPrimConstraint l $
-    unaryUnfoldOnce doPevalGeneralSignumNumTerm signumNumTerm l
-
-doPevalGeneralSignumNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
-doPevalGeneralSignumNumTerm (ConTerm _ _ _ _ a) = Just $ conTerm $ signum a
-doPevalGeneralSignumNumTerm _ = Nothing
-
-doPevalNoOverflowSignumNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
-doPevalNoOverflowSignumNumTerm t =
-  msum
-    [ doPevalGeneralSignumNumTerm t,
-      case t of
-        NegNumTerm _ _ _ _ v -> Just $ pevalNegNumTerm $ pevalSignumNumTerm v
-        MulNumTerm _ _ _ _ l r ->
-          Just $
-            pevalMulNumTerm (pevalSignumNumTerm l) $
-              pevalSignumNumTerm r
-        _ -> Nothing
-    ]
-
 instance PEvalNumTerm Integer where
   pevalAddNumTerm = pevalDefaultAddNumTerm
   pevalNegNumTerm = pevalDefaultNegNumTerm
@@ -236,22 +54,6 @@
   pevalSignumNumTerm =
     unaryUnfoldOnce doPevalNoOverflowSignumNumTerm signumNumTerm
   withSbvNumTermConstraint r = r
-
-instance (KnownNat n, 1 <= n) => PEvalNumTerm (WordN n) where
-  pevalAddNumTerm = pevalDefaultAddNumTerm
-  pevalNegNumTerm = pevalDefaultNegNumTerm
-  pevalMulNumTerm = pevalDefaultMulNumTerm
-  pevalAbsNumTerm = pevalBitsAbsNumTerm
-  pevalSignumNumTerm = pevalGeneralSignumNumTerm
-  withSbvNumTermConstraint r = withPrim @(WordN n) r
-
-instance (KnownNat n, 1 <= n) => PEvalNumTerm (IntN n) where
-  pevalAddNumTerm = pevalDefaultAddNumTerm
-  pevalNegNumTerm = pevalDefaultNegNumTerm
-  pevalMulNumTerm = pevalDefaultMulNumTerm
-  pevalAbsNumTerm = pevalBitsAbsNumTerm
-  pevalSignumNumTerm = pevalGeneralSignumNumTerm
-  withSbvNumTermConstraint r = withPrim @(IntN n) r
 
 instance (ValidFP eb sb) => PEvalNumTerm (FP eb sb) where
   pevalAddNumTerm = generalBinaryUnfolded (+) addNumTerm
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalOrdTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalOrdTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalOrdTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalOrdTerm.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
@@ -44,11 +45,13 @@
         withSbvOrdTermConstraint
       ),
     SupportedPrim (conSBVTerm, withPrim),
-    Term (AddNumTerm, ConTerm),
+    Term,
     conTerm,
     leOrdTerm,
     ltOrdTerm,
     pevalSubNumTerm,
+    pattern AddNumTerm,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (binaryUnfoldOnce)
 
@@ -58,7 +61,7 @@
 
 doPevalGeneralLtOrdTerm ::
   (PEvalOrdTerm a, Ord a) => Term a -> Term a -> Maybe (Term Bool)
-doPevalGeneralLtOrdTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) = Just $ conTerm $ a < b
+doPevalGeneralLtOrdTerm (ConTerm a) (ConTerm b) = Just $ conTerm $ a < b
 doPevalGeneralLtOrdTerm _ _ = Nothing
 
 -- | General partially evaluation of less than or equal to operation.
@@ -67,7 +70,7 @@
 
 doPevalGeneralLeOrdTerm ::
   (PEvalOrdTerm a, Ord a) => Term a -> Term a -> Maybe (Term Bool)
-doPevalGeneralLeOrdTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ b) = Just $ conTerm $ a <= b
+doPevalGeneralLeOrdTerm (ConTerm a) (ConTerm b) = Just $ conTerm $ a <= b
 doPevalGeneralLeOrdTerm _ _ = Nothing
 
 instance PEvalOrdTerm Integer where
@@ -77,18 +80,18 @@
         msum
           [ doPevalGeneralLtOrdTerm l r,
             case (l, r) of
-              (ConTerm _ _ _ _ l, AddNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k) ->
+              (ConTerm l, AddNumTerm (ConTerm j) k) ->
                 Just $ pevalLtOrdTerm (conTerm $ l - j) k
-              (AddNumTerm _ _ _ _ (ConTerm _ _ _ _ i) j, ConTerm _ _ _ _ k) ->
+              (AddNumTerm (ConTerm i) j, ConTerm k) ->
                 Just $ pevalLtOrdTerm j (conTerm $ k - i)
-              ((AddNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k), l) ->
+              ((AddNumTerm (ConTerm j) k), l) ->
                 Just $
                   pevalLtOrdTerm
                     (conTerm j)
                     (pevalSubNumTerm l k)
-              (j, (AddNumTerm _ _ _ _ (ConTerm _ _ _ _ k) l)) ->
+              (j, (AddNumTerm (ConTerm k) l)) ->
                 Just $ pevalLtOrdTerm (conTerm $ -k) (pevalSubNumTerm l j)
-              (l, ConTerm _ _ _ _ r) ->
+              (l, ConTerm r) ->
                 Just $ pevalLtOrdTerm (conTerm $ -r) (pevalNegNumTerm l)
               _ -> Nothing
           ]
@@ -98,15 +101,15 @@
         msum
           [ doPevalGeneralLeOrdTerm l r,
             case (l, r) of
-              (ConTerm _ _ _ _ l, AddNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k) ->
+              (ConTerm l, AddNumTerm (ConTerm j) k) ->
                 Just $ pevalLeOrdTerm (conTerm $ l - j) k
-              (AddNumTerm _ _ _ _ (ConTerm _ _ _ _ i) j, ConTerm _ _ _ _ k) ->
+              (AddNumTerm (ConTerm i) j, ConTerm k) ->
                 Just $ pevalLeOrdTerm j (conTerm $ k - i)
-              (AddNumTerm _ _ _ _ (ConTerm _ _ _ _ j) k, l) ->
+              (AddNumTerm (ConTerm j) k, l) ->
                 Just $ pevalLeOrdTerm (conTerm j) (pevalSubNumTerm l k)
-              (j, AddNumTerm _ _ _ _ (ConTerm _ _ _ _ k) l) ->
+              (j, AddNumTerm (ConTerm k) l) ->
                 Just $ pevalLeOrdTerm (conTerm $ -k) (pevalSubNumTerm l j)
-              (l, ConTerm _ _ _ _ r) ->
+              (l, ConTerm r) ->
                 Just $ pevalLeOrdTerm (conTerm $ -r) (pevalNegNumTerm l)
               _ -> Nothing
           ]
@@ -136,9 +139,9 @@
   [ ( conSBVTerm @FPRoundingMode a,
       conSBVTerm @FPRoundingMode b
     )
-    | a <- allFPRoundingMode,
-      b <- allFPRoundingMode,
-      a < b
+  | a <- allFPRoundingMode,
+    b <- allFPRoundingMode,
+    a < b
   ]
 
 fpRoundingModeLeTable :: [(SBV.SRoundingMode, SBV.SRoundingMode)]
@@ -146,9 +149,9 @@
   [ ( conSBVTerm @FPRoundingMode a,
       conSBVTerm @FPRoundingMode b
     )
-    | a <- allFPRoundingMode,
-      b <- allFPRoundingMode,
-      a <= b
+  | a <- allFPRoundingMode,
+    b <- allFPRoundingMode,
+    a <= b
   ]
 
 sbvTableLookup ::
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalRotateTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalRotateTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalRotateTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalRotateTerm.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -26,7 +27,6 @@
 import GHC.TypeLits (KnownNat, type (<=))
 import Grisette.Internal.Core.Data.Class.SymRotate (SymRotate (symRotate))
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim (bvIsNonZeroFromGEq1)
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( PEvalRotateTerm
       ( pevalRotateLeftTerm,
@@ -36,11 +36,13 @@
         withSbvRotateTermConstraint
       ),
     SupportedNonFuncPrim (withNonFuncPrim),
-    Term (ConTerm),
+    Term,
+    bvIsNonZeroFromGEq1,
     conTerm,
-    introSupportedPrimConstraint,
     rotateLeftTerm,
     rotateRightTerm,
+    pattern ConTerm,
+    pattern SupportedTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (unaryUnfoldOnce)
 
@@ -51,12 +53,11 @@
   Term a ->
   Term a ->
   Term a
-pevalFiniteBitsSymRotateRotateLeftTerm t n =
-  introSupportedPrimConstraint t $
-    unaryUnfoldOnce
-      (`doPevalFiniteBitsSymRotateRotateLeftTerm` n)
-      (`rotateLeftTerm` n)
-      t
+pevalFiniteBitsSymRotateRotateLeftTerm t@SupportedTerm n =
+  unaryUnfoldOnce
+    (`doPevalFiniteBitsSymRotateRotateLeftTerm` n)
+    (`rotateLeftTerm` n)
+    t
 
 doPevalFiniteBitsSymRotateRotateLeftTerm ::
   forall a.
@@ -64,12 +65,12 @@
   Term a ->
   Term a ->
   Maybe (Term a)
-doPevalFiniteBitsSymRotateRotateLeftTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ n)
+doPevalFiniteBitsSymRotateRotateLeftTerm (ConTerm a) (ConTerm n)
   | n >= 0 = Just $ conTerm $ symRotate a n -- Just $ conTerm $ rotateL a (fromIntegral n)
-doPevalFiniteBitsSymRotateRotateLeftTerm x (ConTerm _ _ _ _ 0) = Just x
--- doPevalFiniteBitsSymRotateRotateLeftTerm (RotateLeftTerm _ x (ConTerm _ _ _ _ n)) (ConTerm _ _ _ _ n1)
+doPevalFiniteBitsSymRotateRotateLeftTerm x (ConTerm 0) = Just x
+-- doPevalFiniteBitsSymRotateRotateLeftTerm (RotateLeftTerm _ x (ConTerm  n)) (ConTerm  n1)
 --   | n >= 0 && n1 >= 0 = Just $ pevalFiniteBitsSymRotateRotateLeftTerm x (conTerm $ n + n1)
-doPevalFiniteBitsSymRotateRotateLeftTerm x (ConTerm _ _ _ _ n)
+doPevalFiniteBitsSymRotateRotateLeftTerm x (ConTerm n)
   | n >= 0 && (fromIntegral n :: Integer) >= fromIntegral bs =
       Just $
         pevalFiniteBitsSymRotateRotateLeftTerm
@@ -86,12 +87,11 @@
   Term a ->
   Term a ->
   Term a
-pevalFiniteBitsSymRotateRotateRightTerm t n =
-  introSupportedPrimConstraint t $
-    unaryUnfoldOnce
-      (`doPevalFiniteBitsSymRotateRotateRightTerm` n)
-      (`rotateRightTerm` n)
-      t
+pevalFiniteBitsSymRotateRotateRightTerm t@SupportedTerm n =
+  unaryUnfoldOnce
+    (`doPevalFiniteBitsSymRotateRotateRightTerm` n)
+    (`rotateRightTerm` n)
+    t
 
 doPevalFiniteBitsSymRotateRotateRightTerm ::
   forall a.
@@ -99,7 +99,7 @@
   Term a ->
   Term a ->
   Maybe (Term a)
-doPevalFiniteBitsSymRotateRotateRightTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ n)
+doPevalFiniteBitsSymRotateRotateRightTerm (ConTerm a) (ConTerm n)
   | n >= 0 =
       Just . conTerm $
         rotateR
@@ -108,10 +108,10 @@
               (fromIntegral n :: Integer)
                 `mod` fromIntegral (finiteBitSize n)
           )
-doPevalFiniteBitsSymRotateRotateRightTerm x (ConTerm _ _ _ _ 0) = Just x
--- doPevalFiniteBitsSymRotateRotateRightTerm (RotateRightTerm _ x (ConTerm _ _ _ _ n)) (ConTerm _ _ _ _ n1)
+doPevalFiniteBitsSymRotateRotateRightTerm x (ConTerm 0) = Just x
+-- doPevalFiniteBitsSymRotateRotateRightTerm (RotateRightTerm _ x (ConTerm  n)) (ConTerm  n1)
 --   | n >= 0 && n1 >= 0 = Just $ pevalFiniteBitsSymRotateRotateRightTerm x (conTerm $ n + n1)
-doPevalFiniteBitsSymRotateRotateRightTerm x (ConTerm _ _ _ _ n)
+doPevalFiniteBitsSymRotateRotateRightTerm x (ConTerm n)
   | n >= 0 && (fromIntegral n :: Integer) >= fromIntegral bs =
       Just $
         pevalFiniteBitsSymRotateRotateRightTerm
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalShiftTerm.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalShiftTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalShiftTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/PEvalShiftTerm.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -22,91 +24,179 @@
 
 import Data.Bits (Bits (isSigned, shiftR, zeroBits), FiniteBits (finiteBitSize))
 import Data.Proxy (Proxy (Proxy))
-import GHC.TypeLits (KnownNat, type (<=))
+import Data.Typeable ((:~:) (Refl))
+import GHC.TypeLits (KnownNat, type (+), type (<=))
 import Grisette.Internal.Core.Data.Class.SymShift (SymShift (symShift))
 import Grisette.Internal.SymPrim.BV (IntN, WordN)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim (bvIsNonZeroFromGEq1)
 import Grisette.Internal.SymPrim.Prim.Internal.Term
-  ( PEvalShiftTerm (pevalShiftLeftTerm, pevalShiftRightTerm, withSbvShiftTermConstraint),
+  ( PEvalBVTerm (pevalBVConcatTerm, pevalBVExtendTerm),
+    PEvalShiftTerm
+      ( pevalShiftLeftTerm,
+        pevalShiftRightTerm,
+        withSbvShiftTermConstraint
+      ),
     SupportedNonFuncPrim (withNonFuncPrim),
     SupportedPrim,
-    Term (ConTerm),
+    Term,
+    bvIsNonZeroFromGEq1,
     conTerm,
-    introSupportedPrimConstraint,
     shiftLeftTerm,
     shiftRightTerm,
+    unsafePevalBVSelectTerm,
+    pattern ConTerm,
+    pattern SupportedTerm,
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Unfold (unaryUnfoldOnce)
+import Grisette.Internal.Utils.Parameterized
+  ( LeqProof (LeqProof),
+    NatRepr,
+    SomePositiveNatRepr (SomePositiveNatRepr),
+    mkPositiveNatRepr,
+    natRepr,
+    subNat,
+    unsafeAxiom,
+    unsafeLeqProof,
+  )
 
 -- | Partial evaluation of symbolic shift left term for finite bits types.
 pevalFiniteBitsSymShiftShiftLeftTerm ::
-  forall a.
-  (Integral a, SymShift a, FiniteBits a, PEvalShiftTerm a) =>
-  Term a ->
-  Term a ->
-  Term a
-pevalFiniteBitsSymShiftShiftLeftTerm t n =
-  introSupportedPrimConstraint t $
-    unaryUnfoldOnce
-      (`doPevalFiniteBitsSymShiftShiftLeftTerm` n)
-      (`shiftLeftTerm` n)
-      t
+  forall bv n.
+  ( forall m. (KnownNat m, 1 <= m) => Integral (bv m),
+    forall m. (KnownNat m, 1 <= m) => SymShift (bv m),
+    forall m. (KnownNat m, 1 <= m) => SupportedPrim (bv m),
+    forall m. (KnownNat m, 1 <= m) => PEvalShiftTerm (bv m),
+    PEvalBVTerm bv,
+    KnownNat n,
+    1 <= n
+  ) =>
+  Term (bv n) ->
+  Term (bv n) ->
+  Term (bv n)
+pevalFiniteBitsSymShiftShiftLeftTerm t@SupportedTerm n =
+  unaryUnfoldOnce
+    (`doPevalFiniteBitsSymShiftShiftLeftTerm` n)
+    (`shiftLeftTerm` n)
+    t
 
 doPevalFiniteBitsSymShiftShiftLeftTerm ::
-  forall a.
-  (Integral a, SymShift a, FiniteBits a, SupportedPrim a) =>
-  Term a ->
-  Term a ->
-  Maybe (Term a)
-doPevalFiniteBitsSymShiftShiftLeftTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ n)
+  forall bv n.
+  ( forall m. (KnownNat m, 1 <= m) => Integral (bv m),
+    forall m. (KnownNat m, 1 <= m) => SymShift (bv m),
+    forall m. (KnownNat m, 1 <= m) => SupportedPrim (bv m),
+    forall m. (KnownNat m, 1 <= m) => PEvalShiftTerm (bv m),
+    PEvalBVTerm bv,
+    KnownNat n,
+    1 <= n
+  ) =>
+  Term (bv n) ->
+  Term (bv n) ->
+  Maybe (Term (bv n))
+doPevalFiniteBitsSymShiftShiftLeftTerm (ConTerm a) (ConTerm n)
   | n >= 0 =
       if (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n)
         then Just $ conTerm zeroBits
         else Just $ conTerm $ symShift a n
-doPevalFiniteBitsSymShiftShiftLeftTerm x (ConTerm _ _ _ _ 0) = Just x
+doPevalFiniteBitsSymShiftShiftLeftTerm x (ConTerm 0) = Just x
 -- TODO: Need to handle the overflow case.
--- doPevalShiftLeftTerm (ShiftLeftTerm _ x (ConTerm _ _ _ _ n)) (ConTerm _ _ _ _ n1)
+-- doPevalShiftLeftTerm (ShiftLeftTerm _ x (ConTerm  n)) (ConTerm  n1)
 --   | n >= 0 && n1 >= 0 = Just $ pevalShiftLeftTerm x (conTerm $ n + n1)
-doPevalFiniteBitsSymShiftShiftLeftTerm _ (ConTerm _ _ _ _ n)
-  | n >= 0 && (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n) =
+doPevalFiniteBitsSymShiftShiftLeftTerm _ (ConTerm n)
+  | n > 0 && (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n) =
       Just $ conTerm zeroBits
+doPevalFiniteBitsSymShiftShiftLeftTerm x (ConTerm shiftAmount)
+  | shiftAmount > 0 =
+      case (namount, nremaining) of
+        ( SomePositiveNatRepr (_ :: NatRepr amount),
+          SomePositiveNatRepr (nremaining :: NatRepr remaining)
+          ) ->
+            case ( unsafeLeqProof @remaining @n,
+                   unsafeAxiom @(remaining + amount) @n
+                 ) of
+              (LeqProof, Refl) ->
+                Just $
+                  pevalBVConcatTerm
+                    (unsafePevalBVSelectTerm nn (natRepr @0) nremaining x)
+                    (conTerm zeroBits :: Term (bv amount))
+  where
+    nn = natRepr @n
+    namount = mkPositiveNatRepr $ fromIntegral shiftAmount
+    nremaining =
+      mkPositiveNatRepr $
+        fromIntegral (finiteBitSize shiftAmount) - fromIntegral shiftAmount
 doPevalFiniteBitsSymShiftShiftLeftTerm _ _ = Nothing
 
 -- | Partial evaluation of symbolic shift right term for finite bits types.
 pevalFiniteBitsSymShiftShiftRightTerm ::
-  forall a.
-  (Integral a, SymShift a, FiniteBits a, PEvalShiftTerm a) =>
-  Term a ->
-  Term a ->
-  Term a
-pevalFiniteBitsSymShiftShiftRightTerm t n =
-  introSupportedPrimConstraint t $
-    unaryUnfoldOnce
-      (`doPevalFiniteBitsSymShiftShiftRightTerm` n)
-      (`shiftRightTerm` n)
-      t
+  forall bv n.
+  ( forall m. (KnownNat m, 1 <= m) => Integral (bv m),
+    forall m. (KnownNat m, 1 <= m) => SymShift (bv m),
+    forall m. (KnownNat m, 1 <= m) => SupportedPrim (bv m),
+    forall m. (KnownNat m, 1 <= m) => PEvalShiftTerm (bv m),
+    PEvalBVTerm bv,
+    KnownNat n,
+    1 <= n
+  ) =>
+  Term (bv n) ->
+  Term (bv n) ->
+  Term (bv n)
+pevalFiniteBitsSymShiftShiftRightTerm t@SupportedTerm n =
+  unaryUnfoldOnce
+    (`doPevalFiniteBitsSymShiftShiftRightTerm` n)
+    (`shiftRightTerm` n)
+    t
 
 doPevalFiniteBitsSymShiftShiftRightTerm ::
-  forall a.
-  (Integral a, SymShift a, FiniteBits a, SupportedPrim a) =>
-  Term a ->
-  Term a ->
-  Maybe (Term a)
-doPevalFiniteBitsSymShiftShiftRightTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ n)
+  forall bv n.
+  ( forall m. (KnownNat m, 1 <= m) => Integral (bv m),
+    forall m. (KnownNat m, 1 <= m) => SymShift (bv m),
+    forall m. (KnownNat m, 1 <= m) => SupportedPrim (bv m),
+    forall m. (KnownNat m, 1 <= m) => PEvalShiftTerm (bv m),
+    PEvalBVTerm bv,
+    KnownNat n,
+    1 <= n
+  ) =>
+  Term (bv n) ->
+  Term (bv n) ->
+  Maybe (Term (bv n))
+doPevalFiniteBitsSymShiftShiftRightTerm (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)
-doPevalFiniteBitsSymShiftShiftRightTerm (ConTerm _ _ _ _ a) (ConTerm _ _ _ _ n)
+doPevalFiniteBitsSymShiftShiftRightTerm (ConTerm a) (ConTerm n)
   -- if n >= 0 then -n must be in the range
   | n >= 0 = Just $ conTerm $ symShift a (-n)
-doPevalFiniteBitsSymShiftShiftRightTerm x (ConTerm _ _ _ _ 0) = Just x
--- doPevalFiniteBitsSymShiftShiftRightTerm (ShiftRightTerm _ x (ConTerm _ _ _ _ n)) (ConTerm _ _ _ _ n1)
+doPevalFiniteBitsSymShiftShiftRightTerm x (ConTerm 0) = Just x
+-- doPevalFiniteBitsSymShiftShiftRightTerm (ShiftRightTerm _ x (ConTerm  n)) (ConTerm  n1)
 --   | n >= 0 && n1 >= 0 = Just $ pevalFiniteBitsSymShiftShiftRightTerm x (conTerm $ n + n1)
-doPevalFiniteBitsSymShiftShiftRightTerm _ (ConTerm _ _ _ _ n)
-  | not (isSigned n)
-      && (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n) =
+doPevalFiniteBitsSymShiftShiftRightTerm x (ConTerm shiftAmount)
+  | not (isSigned shiftAmount)
+      && (fromIntegral shiftAmount :: Integer) >= fromIntegral (finiteBitSize shiftAmount) =
       Just $ conTerm zeroBits
+  | isSigned shiftAmount
+      && (fromIntegral shiftAmount :: Integer) >= fromIntegral (finiteBitSize shiftAmount) =
+      Just $ pevalBVExtendTerm True nn $ unsafePevalBVSelectTerm nn nnp1 none x
+  where
+    nn = natRepr @n
+    none = natRepr @1
+    nnp1 = subNat nn none
+doPevalFiniteBitsSymShiftShiftRightTerm x (ConTerm shiftAmount)
+  | shiftAmount > 0 =
+      case (namount, nremaining) of
+        ( SomePositiveNatRepr namount,
+          SomePositiveNatRepr (nremaining :: NatRepr remaining)
+          ) ->
+            case unsafeLeqProof @remaining @n of
+              LeqProof ->
+                Just $
+                  pevalBVExtendTerm (isSigned shiftAmount) nn $
+                    unsafePevalBVSelectTerm nn namount nremaining x
+  where
+    nn = natRepr @n
+    namount = mkPositiveNatRepr $ fromIntegral shiftAmount
+    nremaining =
+      mkPositiveNatRepr $
+        fromIntegral (finiteBitSize shiftAmount) - fromIntegral shiftAmount
 doPevalFiniteBitsSymShiftShiftRightTerm _ _ = Nothing
 
 instance (KnownNat n, 1 <= n) => PEvalShiftTerm (IntN n) where
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/SupportedPrim.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/SupportedPrim.hs
deleted file mode 100644
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Instances/SupportedPrim.hs
+++ /dev/null
@@ -1,413 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# HLINT ignore "Eta reduce" #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
--- |
--- Module      :   Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim
-  ( bvIsNonZeroFromGEq1,
-  )
-where
-
-import Data.Coerce (coerce)
-import Data.Hashable (Hashable (hashWithSalt))
-import Data.List.NonEmpty (NonEmpty ((:|)), toList)
-import Data.Proxy (Proxy (Proxy))
-import Data.SBV (BVIsNonZero)
-import qualified Data.SBV as SBV
-import Data.Type.Equality ((:~:) (Refl), type (:~~:) (HRefl))
-import GHC.TypeNats (KnownNat, type (<=))
-import Grisette.Internal.Core.Data.Class.IEEEFP
-  ( fpIsNegativeZero,
-    fpIsPositiveZero,
-  )
-import Grisette.Internal.SymPrim.AlgReal (AlgReal, fromSBVAlgReal, toSBVAlgReal)
-import Grisette.Internal.SymPrim.BV (IntN, WordN)
-import Grisette.Internal.SymPrim.FP
-  ( FP (FP),
-    FPRoundingMode (RNA, RNE, RTN, RTP, RTZ),
-    ValidFP,
-  )
-import Grisette.Internal.SymPrim.Prim.Internal.Term
-  ( IsSymbolKind (decideSymbolKind),
-    NonFuncSBVRep (NonFuncSBVBaseType),
-    SBVRep
-      ( SBVType
-      ),
-    SupportedNonFuncPrim
-      ( conNonFuncSBVTerm,
-        symNonFuncSBVTerm,
-        withNonFuncPrim
-      ),
-    SupportedPrim
-      ( castTypedSymbol,
-        conSBVTerm,
-        defaultValue,
-        funcDummyConstraint,
-        hashConWithSalt,
-        parseSMTModelResult,
-        pevalDistinctTerm,
-        pevalEqTerm,
-        pevalITETerm,
-        pformatCon,
-        sameCon,
-        sbvDistinct,
-        sbvEq,
-        sbvIte,
-        symSBVName,
-        symSBVTerm,
-        withPrim
-      ),
-    SupportedPrimConstraint
-      ( PrimConstraint
-      ),
-    Term (ConTerm),
-    TypedSymbol (unTypedSymbol),
-    conTerm,
-    distinctTerm,
-    eqTerm,
-    parseScalarSMTModelResult,
-    pevalDefaultEqTerm,
-    pevalITEBasicTerm,
-    pevalNotTerm,
-    sbvFresh,
-    typedAnySymbol,
-    typedConstantSymbol,
-  )
-import Grisette.Internal.Utils.Parameterized (unsafeAxiom)
-
-defaultValueForInteger :: Integer
-defaultValueForInteger = 0
-
--- Basic Integer
-instance SBVRep Integer where
-  type SBVType Integer = SBV.SBV Integer
-
-instance SupportedPrimConstraint Integer where
-  type PrimConstraint Integer = (Integral (NonFuncSBVBaseType Integer))
-
-pairwiseHasConcreteEqual :: (SupportedNonFuncPrim a) => [Term a] -> Bool
-pairwiseHasConcreteEqual [] = False
-pairwiseHasConcreteEqual [_] = False
-pairwiseHasConcreteEqual (x : xs) =
-  go x xs || pairwiseHasConcreteEqual xs
-  where
-    go _ [] = False
-    go x (y : ys) = x == y || go x ys
-
-getAllConcrete :: [Term a] -> Maybe [a]
-getAllConcrete [] = return []
-getAllConcrete (ConTerm _ _ _ _ x : xs) = (x :) <$> getAllConcrete xs
-getAllConcrete _ = Nothing
-
-checkConcreteDistinct :: (Eq t) => [t] -> Bool
-checkConcreteDistinct [] = True
-checkConcreteDistinct (x : xs) = check0 x xs && checkConcreteDistinct xs
-  where
-    check0 _ [] = True
-    check0 x (y : ys) = x /= y && check0 x ys
-
-pevalGeneralDistinct ::
-  (SupportedNonFuncPrim a) => NonEmpty (Term a) -> Term Bool
-pevalGeneralDistinct (_ :| []) = conTerm True
-pevalGeneralDistinct (a :| [b]) = pevalNotTerm $ pevalEqTerm a b
-pevalGeneralDistinct l | pairwiseHasConcreteEqual $ toList l = conTerm False
-pevalGeneralDistinct l =
-  case getAllConcrete (toList l) of
-    Nothing -> distinctTerm l
-    Just xs -> conTerm $ checkConcreteDistinct xs
-
-instance SupportedPrim Integer where
-  pformatCon = show
-  defaultValue = defaultValueForInteger
-  pevalITETerm = pevalITEBasicTerm
-  pevalEqTerm = pevalDefaultEqTerm
-  pevalDistinctTerm = pevalGeneralDistinct
-  conSBVTerm n = fromInteger n
-  symSBVName symbol _ = show symbol
-  symSBVTerm name = sbvFresh name
-  parseSMTModelResult _ = parseScalarSMTModelResult id
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd Integer ->
-    Maybe (TypedSymbol knd' Integer)
-  castTypedSymbol s =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
-      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
-  funcDummyConstraint _ = SBV.sTrue
-
-instance NonFuncSBVRep Integer where
-  type NonFuncSBVBaseType Integer = Integer
-
-instance SupportedNonFuncPrim Integer where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @Integer
-  withNonFuncPrim r = r
-
--- Signed BV
-instance (KnownNat w, 1 <= w) => SupportedPrimConstraint (IntN w) where
-  type PrimConstraint (IntN w) = (KnownNat w, 1 <= w, BVIsNonZero w)
-
-instance (KnownNat w, 1 <= w) => SBVRep (IntN w) where
-  type SBVType (IntN w) = SBV.SBV (SBV.IntN w)
-
-instance (KnownNat w, 1 <= w) => SupportedPrim (IntN w) where
-  sbvDistinct = withPrim @(IntN w) $ SBV.distinct . toList
-  sbvEq = withPrim @(IntN w) (SBV..==)
-  pformatCon = show
-  defaultValue = 0
-  pevalITETerm = pevalITEBasicTerm
-  pevalEqTerm = pevalDefaultEqTerm
-  pevalDistinctTerm = pevalGeneralDistinct
-  conSBVTerm n = bvIsNonZeroFromGEq1 (Proxy @w) $ fromIntegral n
-  symSBVName symbol _ = show symbol
-  symSBVTerm name = bvIsNonZeroFromGEq1 (Proxy @w) $ sbvFresh name
-  withPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
-  {-# INLINE withPrim #-}
-  parseSMTModelResult _ cv =
-    withPrim @(IntN w) $
-      parseScalarSMTModelResult (\(x :: SBV.IntN w) -> fromIntegral x) cv
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd (IntN w) ->
-    Maybe (TypedSymbol knd' (IntN w))
-  castTypedSymbol s =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
-      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
-  funcDummyConstraint _ = SBV.sTrue
-
--- | Construct the 'SBV.BVIsNonZero' constraint from the proof that the width is
--- at least 1.
-bvIsNonZeroFromGEq1 ::
-  forall w r proxy.
-  (1 <= w) =>
-  proxy w ->
-  ((SBV.BVIsNonZero w) => r) ->
-  r
-bvIsNonZeroFromGEq1 _ r1 = case unsafeAxiom :: w :~: 1 of
-  Refl -> r1
-{-# INLINE bvIsNonZeroFromGEq1 #-}
-
-instance (KnownNat w, 1 <= w) => NonFuncSBVRep (IntN w) where
-  type NonFuncSBVBaseType (IntN w) = SBV.IntN w
-
-instance (KnownNat w, 1 <= w) => SupportedNonFuncPrim (IntN w) where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @(IntN w)
-  withNonFuncPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
-
--- Unsigned BV
-instance (KnownNat w, 1 <= w) => SupportedPrimConstraint (WordN w) where
-  type PrimConstraint (WordN w) = (KnownNat w, 1 <= w, BVIsNonZero w)
-
-instance (KnownNat w, 1 <= w) => SBVRep (WordN w) where
-  type SBVType (WordN w) = SBV.SBV (SBV.WordN w)
-
-instance (KnownNat w, 1 <= w) => SupportedPrim (WordN w) where
-  sbvDistinct = withPrim @(WordN w) $ SBV.distinct . toList
-  sbvEq = withPrim @(WordN w) (SBV..==)
-  pformatCon = show
-  defaultValue = 0
-  pevalITETerm = pevalITEBasicTerm
-  pevalEqTerm = pevalDefaultEqTerm
-  pevalDistinctTerm = pevalGeneralDistinct
-  conSBVTerm n = bvIsNonZeroFromGEq1 (Proxy @w) $ fromIntegral n
-  symSBVName symbol _ = show symbol
-  symSBVTerm name = bvIsNonZeroFromGEq1 (Proxy @w) $ sbvFresh name
-  withPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
-  {-# INLINE withPrim #-}
-  parseSMTModelResult _ cv =
-    withPrim @(IntN w) $
-      parseScalarSMTModelResult (\(x :: SBV.WordN w) -> fromIntegral x) cv
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd (WordN w) ->
-    Maybe (TypedSymbol knd' (WordN w))
-  castTypedSymbol s =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
-      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
-  funcDummyConstraint _ = SBV.sTrue
-
-instance (KnownNat w, 1 <= w) => NonFuncSBVRep (WordN w) where
-  type NonFuncSBVBaseType (WordN w) = SBV.WordN w
-
-instance (KnownNat w, 1 <= w) => SupportedNonFuncPrim (WordN w) where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @(WordN w)
-  withNonFuncPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
-
--- FP
-instance (ValidFP eb sb) => SupportedPrimConstraint (FP eb sb) where
-  type PrimConstraint (FP eb sb) = ValidFP eb sb
-
-instance (ValidFP eb sb) => SBVRep (FP eb sb) where
-  type SBVType (FP eb sb) = SBV.SBV (SBV.FloatingPoint eb sb)
-
-instance (ValidFP eb sb) => SupportedPrim (FP eb sb) where
-  sameCon a b
-    | isNaN a = isNaN b
-    | fpIsPositiveZero a = fpIsPositiveZero b
-    | fpIsNegativeZero a = fpIsNegativeZero b
-    | otherwise = a == b
-  hashConWithSalt s a
-    | isNaN a = hashWithSalt s (2654435761 :: Int)
-    | otherwise = hashWithSalt s a
-  defaultValue = 0
-  pevalITETerm = pevalITEBasicTerm
-  pevalEqTerm (ConTerm _ _ _ _ l) (ConTerm _ _ _ _ r) = conTerm $ l == r
-  pevalEqTerm l@ConTerm {} r = pevalEqTerm r l
-  pevalEqTerm l r = eqTerm l r
-  pevalDistinctTerm (_ :| []) = conTerm True
-  pevalDistinctTerm (a :| [b]) = pevalNotTerm $ pevalEqTerm a b
-  pevalDistinctTerm l =
-    case getAllConcrete (toList l) of
-      Nothing -> distinctTerm l
-      Just xs | any isNaN xs -> distinctTerm l
-      Just xs -> conTerm $ checkConcreteDistinct xs
-  conSBVTerm (FP fp) = SBV.literal fp
-  symSBVName symbol _ = show symbol
-  symSBVTerm name = sbvFresh name
-  parseSMTModelResult _ cv =
-    withPrim @(FP eb sb) $
-      parseScalarSMTModelResult (\(x :: SBV.FloatingPoint eb sb) -> coerce x) cv
-  funcDummyConstraint _ = SBV.sTrue
-
-  -- Workaround for sbv#702.
-  sbvIte = withPrim @(FP eb sb) $ \c a b ->
-    case (SBV.unliteral a, SBV.unliteral b) of
-      (Just a', Just b')
-        | isInfinite a' && isInfinite b' ->
-            let correspondingZero x = if x > 0 then 0 else -0
-             in 1
-                  / sbvIte @(FP eb sb)
-                    c
-                    (conSBVTerm @(FP eb sb) $ correspondingZero a')
-                    (conSBVTerm @(FP eb sb) $ correspondingZero b')
-      _ -> SBV.ite c a b
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd (FP eb sb) ->
-    Maybe (TypedSymbol knd' (FP eb sb))
-  castTypedSymbol s =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
-      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
-
-instance (ValidFP eb sb) => NonFuncSBVRep (FP eb sb) where
-  type NonFuncSBVBaseType (FP eb sb) = SBV.FloatingPoint eb sb
-
-instance (ValidFP eb sb) => SupportedNonFuncPrim (FP eb sb) where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @(FP eb sb)
-  withNonFuncPrim r = r
-
--- FPRoundingMode
-instance SupportedPrimConstraint FPRoundingMode
-
-instance SBVRep FPRoundingMode where
-  type SBVType FPRoundingMode = SBV.SBV SBV.RoundingMode
-
-instance SupportedPrim FPRoundingMode where
-  defaultValue = RNE
-  pevalITETerm = pevalITEBasicTerm
-  pevalEqTerm (ConTerm _ _ _ _ l) (ConTerm _ _ _ _ r) = conTerm $ l == r
-  pevalEqTerm l@ConTerm {} r = pevalEqTerm r l
-  pevalEqTerm l r = eqTerm l r
-  pevalDistinctTerm = pevalGeneralDistinct
-  conSBVTerm RNE = SBV.sRNE
-  conSBVTerm RNA = SBV.sRNA
-  conSBVTerm RTP = SBV.sRTP
-  conSBVTerm RTN = SBV.sRTN
-  conSBVTerm RTZ = SBV.sRTZ
-  symSBVName symbol _ = show symbol
-  symSBVTerm name = sbvFresh name
-  parseSMTModelResult _ cv =
-    withPrim @(FPRoundingMode) $
-      parseScalarSMTModelResult
-        ( \(x :: SBV.RoundingMode) -> case x of
-            SBV.RoundNearestTiesToEven -> RNE
-            SBV.RoundNearestTiesToAway -> RNA
-            SBV.RoundTowardPositive -> RTP
-            SBV.RoundTowardNegative -> RTN
-            SBV.RoundTowardZero -> RTZ
-        )
-        cv
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd FPRoundingMode ->
-    Maybe (TypedSymbol knd' FPRoundingMode)
-  castTypedSymbol s =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
-      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
-  funcDummyConstraint _ = SBV.sTrue
-
-instance NonFuncSBVRep FPRoundingMode where
-  type NonFuncSBVBaseType FPRoundingMode = SBV.RoundingMode
-
-instance SupportedNonFuncPrim FPRoundingMode where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @FPRoundingMode
-  withNonFuncPrim r = r
-
--- AlgReal
-
-instance SupportedPrimConstraint AlgReal
-
-instance SBVRep AlgReal where
-  type SBVType AlgReal = SBV.SBV SBV.AlgReal
-
-instance SupportedPrim AlgReal where
-  defaultValue = 0
-  pevalITETerm = pevalITEBasicTerm
-  pevalEqTerm (ConTerm _ _ _ _ l) (ConTerm _ _ _ _ r) = conTerm $ l == r
-  pevalEqTerm l@ConTerm {} r = pevalEqTerm r l
-  pevalEqTerm l r = eqTerm l r
-  pevalDistinctTerm = pevalGeneralDistinct
-  conSBVTerm = SBV.literal . toSBVAlgReal
-  symSBVName symbol _ = show symbol
-  symSBVTerm name = sbvFresh name
-  parseSMTModelResult _ cv =
-    withPrim @AlgReal $
-      parseScalarSMTModelResult fromSBVAlgReal cv
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd AlgReal ->
-    Maybe (TypedSymbol knd' AlgReal)
-  castTypedSymbol s =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
-      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
-  funcDummyConstraint _ = SBV.sTrue
-
-instance NonFuncSBVRep AlgReal where
-  type NonFuncSBVBaseType AlgReal = SBV.AlgReal
-
-instance SupportedNonFuncPrim AlgReal where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @AlgReal
-  withNonFuncPrim r = r
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Serialize.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Serialize.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Serialize.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Serialize.hs
@@ -57,9 +57,7 @@
   )
 import Grisette.Internal.SymPrim.GeneralFun (type (-->) (GeneralFun))
 import Grisette.Internal.SymPrim.Prim.Internal.Caches (Id)
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.BVPEval ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitCastTerm ()
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitwiseTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalDivModIntegralTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFloatingTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFractionalTerm ()
@@ -69,7 +67,6 @@
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalOrdTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalRotateTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalShiftTerm ()
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( FPBinaryOp,
     FPRoundingBinaryOp,
@@ -93,56 +90,7 @@
     SomeTypedSymbol (SomeTypedSymbol),
     SupportedNonFuncPrim,
     SupportedPrim (primTypeRep, withPrim),
-    Term
-      ( AbsNumTerm,
-        AddNumTerm,
-        AndBitsTerm,
-        AndTerm,
-        ApplyTerm,
-        BVConcatTerm,
-        BVExtendTerm,
-        BVSelectTerm,
-        BitCastOrTerm,
-        BitCastTerm,
-        ComplementBitsTerm,
-        ConTerm,
-        DistinctTerm,
-        DivIntegralTerm,
-        EqTerm,
-        ExistsTerm,
-        FPBinaryTerm,
-        FPFMATerm,
-        FPRoundingBinaryTerm,
-        FPRoundingUnaryTerm,
-        FPTraitTerm,
-        FPUnaryTerm,
-        FdivTerm,
-        FloatingUnaryTerm,
-        ForallTerm,
-        FromFPOrTerm,
-        FromIntegralTerm,
-        ITETerm,
-        LeOrdTerm,
-        LtOrdTerm,
-        ModIntegralTerm,
-        MulNumTerm,
-        NegNumTerm,
-        NotTerm,
-        OrBitsTerm,
-        OrTerm,
-        PowerTerm,
-        QuotIntegralTerm,
-        RecipTerm,
-        RemIntegralTerm,
-        RotateLeftTerm,
-        RotateRightTerm,
-        ShiftLeftTerm,
-        ShiftRightTerm,
-        SignumNumTerm,
-        SymTerm,
-        ToFPTerm,
-        XorBitsTerm
-      ),
+    Term,
     TypedAnySymbol,
     TypedConstantSymbol,
     TypedSymbol (TypedSymbol),
@@ -173,7 +121,6 @@
     fpUnaryTerm,
     fromFPOrTerm,
     fromIntegralTerm,
-    introSupportedPrimConstraint,
     iteTerm,
     leOrdTerm,
     ltOrdTerm,
@@ -196,8 +143,56 @@
     symTerm,
     termId,
     toFPTerm,
-    withSupportedPrimTypeable,
     xorBitsTerm,
+    pattern AbsNumTerm,
+    pattern AddNumTerm,
+    pattern AndBitsTerm,
+    pattern AndTerm,
+    pattern ApplyTerm,
+    pattern BVConcatTerm,
+    pattern BVExtendTerm,
+    pattern BVSelectTerm,
+    pattern BitCastOrTerm,
+    pattern BitCastTerm,
+    pattern ComplementBitsTerm,
+    pattern ConTerm,
+    pattern DistinctTerm,
+    pattern DivIntegralTerm,
+    pattern EqTerm,
+    pattern ExistsTerm,
+    pattern FPBinaryTerm,
+    pattern FPFMATerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPTraitTerm,
+    pattern FPUnaryTerm,
+    pattern FdivTerm,
+    pattern FloatingUnaryTerm,
+    pattern ForallTerm,
+    pattern FromFPOrTerm,
+    pattern FromIntegralTerm,
+    pattern ITETerm,
+    pattern LeOrdTerm,
+    pattern LtOrdTerm,
+    pattern ModIntegralTerm,
+    pattern MulNumTerm,
+    pattern NegNumTerm,
+    pattern NotTerm,
+    pattern OrBitsTerm,
+    pattern OrTerm,
+    pattern PowerTerm,
+    pattern QuotIntegralTerm,
+    pattern RecipTerm,
+    pattern RemIntegralTerm,
+    pattern RotateLeftTerm,
+    pattern RotateRightTerm,
+    pattern ShiftLeftTerm,
+    pattern ShiftRightTerm,
+    pattern SignumNumTerm,
+    pattern SupportedTerm,
+    pattern SymTerm,
+    pattern ToFPTerm,
+    pattern XorBitsTerm,
   )
 import Grisette.Internal.SymPrim.Prim.SomeTerm
   ( SomeTerm (SomeTerm),
@@ -900,11 +895,10 @@
   f $ t :| fmap (unsafeCastTerm t) ts
   where
     unsafeCastTerm :: Term a -> SomeTerm -> Term a
-    unsafeCastTerm t (SomeTerm b) =
-      introSupportedPrimConstraint t $
-        case castTerm b of
-          Just r -> r
-          Nothing -> error "asSameTypeNonEmptyTermList: type mismatch"
+    unsafeCastTerm _ (SomeTerm b) =
+      case castTerm b of
+        Just r -> r
+        Nothing -> error "asSameTypeNonEmptyTermList: type mismatch"
 
 asNumTypeTerm ::
   (HasCallStack) =>
@@ -1043,11 +1037,10 @@
 
 asSameType ::
   (HasCallStack) => Term a -> SomeTerm -> (Term a -> r) -> r
-asSameType (t1 :: Term a) (SomeTerm (t2 :: Term b)) f =
-  introSupportedPrimConstraint t1 $
-    case eqTypeRep (primTypeRep @a) (primTypeRep @b) of
-      Just HRefl -> f t2
-      Nothing -> error "asSameType: type mismatch"
+asSameType (SupportedTerm :: Term a) (SomeTerm (t2 :: Term b)) f =
+  case eqTypeRep (primTypeRep @a) (primTypeRep @b) of
+    Just HRefl -> f t2
+    Nothing -> error "asSameType: type mismatch"
 
 asFPRoundingTerm ::
   (HasCallStack) => SomeTerm -> (Term FPRoundingMode -> r) -> r
@@ -1302,39 +1295,37 @@
   Term a ->
   KnownType ->
   SomeTerm
-constructFromIntegralTerm' ta retType =
+constructFromIntegralTerm' ta@SupportedTerm retType =
   case witnessKnownType retType of
     KnownTypeWitness (_ :: Proxy b) -> do
       let tb = primTypeRep @b
-      introSupportedPrimConstraint ta $
-        withPrim @a $
-          withPrim @b $
-            case ( eqTypeRep tb (typeRep @Integer),
-                   eqTypeRep tb (typeRep @AlgReal),
-                   tb
-                 ) of
-              (Just HRefl, _, _) -> someTerm (fromIntegralTerm ta :: Term b)
-              (_, Just HRefl, _) -> someTerm (fromIntegralTerm ta :: Term b)
-              (_, _, App tw@Con {} _) ->
-                case ( eqTypeRep tw (typeRep @WordN),
-                       eqTypeRep tw (typeRep @IntN)
-                     ) of
-                  (Just HRefl, _) -> someTerm (fromIntegralTerm ta :: Term b)
-                  (_, Just HRefl) -> someTerm (fromIntegralTerm ta :: Term b)
-                  _ -> err
-              (_, _, App (App tw@Con {} _) _) ->
-                case eqTypeRep tw (typeRep @FP) of
-                  Just HRefl -> someTerm (fromIntegralTerm ta :: Term b)
-                  _ -> err
-              _ -> err
+      withPrim @a $
+        withPrim @b $
+          case ( eqTypeRep tb (typeRep @Integer),
+                 eqTypeRep tb (typeRep @AlgReal),
+                 tb
+               ) of
+            (Just HRefl, _, _) -> someTerm (fromIntegralTerm ta :: Term b)
+            (_, Just HRefl, _) -> someTerm (fromIntegralTerm ta :: Term b)
+            (_, _, App tw@Con {} _) ->
+              case ( eqTypeRep tw (typeRep @WordN),
+                     eqTypeRep tw (typeRep @IntN)
+                   ) of
+                (Just HRefl, _) -> someTerm (fromIntegralTerm ta :: Term b)
+                (_, Just HRefl) -> someTerm (fromIntegralTerm ta :: Term b)
+                _ -> err
+            (_, _, App (App tw@Con {} _) _) ->
+              case eqTypeRep tw (typeRep @FP) of
+                Just HRefl -> someTerm (fromIntegralTerm ta :: Term b)
+                _ -> err
+            _ -> err
   where
     err :: SomeTerm
     err =
-      introSupportedPrimConstraint ta $
-        error $
-          "constructFromIntegralTerm: unsupported type: "
-            <> show (primTypeRep @a)
-            <> show retType
+      error $
+        "constructFromIntegralTerm: unsupported type: "
+          <> show (primTypeRep @a)
+          <> show retType
 
 constructFromIntegralTerm ::
   (HasCallStack) => SomeTerm -> KnownType -> SomeTerm
@@ -1356,7 +1347,7 @@
     err = error $ "constructFromIntegralTerm: unsupported type: " <> show tra
 
 knownTypeTermId :: Term a -> (KnownType, Id)
-knownTypeTermId t = introSupportedPrimConstraint t (knownType t, termId t)
+knownTypeTermId t@SupportedTerm = (knownType t, termId t)
 
 statefulDeserializeSomeTerm ::
   (MonadGet m) =>
@@ -1659,7 +1650,7 @@
     then return ()
     else do
       case tm of
-        ConTerm _ _ _ _ (v :: v) -> do
+        ConTerm (v :: v) -> do
           serialize ktTmId
           putWord8 conTermTag
           let kt = knownType (Proxy @v)
@@ -1672,100 +1663,100 @@
                 Nothing ->
                   error
                     "serializeSingleSomeTerm: should not happen: type mismatch"
-        SymTerm _ _ _ _ (v :: TypedAnySymbol v) -> do
+        SymTerm (v :: TypedAnySymbol v) -> do
           serialize ktTmId
           putWord8 symTermTag
           serialize $ someTypedSymbol v
-        ForallTerm _ _ _ _ ts t -> serializeQuantified ktTmId forallTermTag ts t
-        ExistsTerm _ _ _ _ ts t -> serializeQuantified ktTmId existsTermTag ts t
-        NotTerm _ _ _ _ t -> do
+        ForallTerm ts t -> serializeQuantified ktTmId forallTermTag ts t
+        ExistsTerm ts t -> serializeQuantified ktTmId existsTermTag ts t
+        NotTerm t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           putWord8 notTermTag
           serialize $ knownTypeTermId t
-        OrTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId orTermTag t1 t2
-        AndTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId andTermTag t1 t2
-        EqTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId eqTermTag t1 t2
-        DistinctTerm _ _ _ _ ts -> do
+        OrTerm t1 t2 -> serializeBinary ktTmId orTermTag t1 t2
+        AndTerm t1 t2 -> serializeBinary ktTmId andTermTag t1 t2
+        EqTerm t1 t2 -> serializeBinary ktTmId eqTermTag t1 t2
+        DistinctTerm ts -> do
           traverse_ (serializeSingleSomeTerm . someTerm) ts
           serialize ktTmId
           putWord8 distinctTermTag
           serialize $ fmap knownTypeTermId ts
-        ITETerm _ _ _ _ t1 t2 t3 -> serializeTernary ktTmId iteTermTag t1 t2 t3
-        AddNumTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId addNumTermTag t1 t2
-        NegNumTerm _ _ _ _ t -> serializeUnary ktTmId negNumTermTag t
-        MulNumTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId mulNumTermTag t1 t2
-        AbsNumTerm _ _ _ _ t -> serializeUnary ktTmId absNumTermTag t
-        SignumNumTerm _ _ _ _ t -> serializeUnary ktTmId signumNumTermTag t
-        LtOrdTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId ltOrdTermTag t1 t2
-        LeOrdTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId leOrdTermTag t1 t2
-        AndBitsTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId andBitsTermTag t1 t2
-        OrBitsTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId orBitsTermTag t1 t2
-        XorBitsTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId xorBitsTermTag t1 t2
-        ComplementBitsTerm _ _ _ _ t ->
+        ITETerm t1 t2 t3 -> serializeTernary ktTmId iteTermTag t1 t2 t3
+        AddNumTerm t1 t2 -> serializeBinary ktTmId addNumTermTag t1 t2
+        NegNumTerm t -> serializeUnary ktTmId negNumTermTag t
+        MulNumTerm t1 t2 -> serializeBinary ktTmId mulNumTermTag t1 t2
+        AbsNumTerm t -> serializeUnary ktTmId absNumTermTag t
+        SignumNumTerm t -> serializeUnary ktTmId signumNumTermTag t
+        LtOrdTerm t1 t2 -> serializeBinary ktTmId ltOrdTermTag t1 t2
+        LeOrdTerm t1 t2 -> serializeBinary ktTmId leOrdTermTag t1 t2
+        AndBitsTerm t1 t2 -> serializeBinary ktTmId andBitsTermTag t1 t2
+        OrBitsTerm t1 t2 -> serializeBinary ktTmId orBitsTermTag t1 t2
+        XorBitsTerm t1 t2 -> serializeBinary ktTmId xorBitsTermTag t1 t2
+        ComplementBitsTerm t ->
           serializeUnary ktTmId complementBitsTermTag t
-        ShiftLeftTerm _ _ _ _ t1 t2 ->
+        ShiftLeftTerm t1 t2 ->
           serializeBinary ktTmId shiftLeftTermTag t1 t2
-        ShiftRightTerm _ _ _ _ t1 t2 ->
+        ShiftRightTerm t1 t2 ->
           serializeBinary ktTmId shiftRightTermTag t1 t2
-        RotateLeftTerm _ _ _ _ t1 t2 ->
+        RotateLeftTerm t1 t2 ->
           serializeBinary ktTmId rotateLeftTermTag t1 t2
-        RotateRightTerm _ _ _ _ t1 t2 ->
+        RotateRightTerm t1 t2 ->
           serializeBinary ktTmId rotateRightTermTag t1 t2
-        BitCastTerm _ _ _ _ t -> do
+        BitCastTerm t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize bitCastTermTag
           let kt = knownType (Proxy @t)
           serializeKnownType kt
           serialize $ knownTypeTermId t
-        BitCastOrTerm _ _ _ _ d t -> serializeBinary ktTmId bitCastOrTermTag d t
-        BVConcatTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId bvConcatTermTag t1 t2
-        BVSelectTerm _ _ _ _ ix w t -> do
+        BitCastOrTerm d t -> serializeBinary ktTmId bitCastOrTermTag d t
+        BVConcatTerm t1 t2 -> serializeBinary ktTmId bvConcatTermTag t1 t2
+        BVSelectTerm ix w t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize bvSelectTermTag
           serialize $ natVal ix
           serialize $ natVal w
           serialize $ knownTypeTermId t
-        BVExtendTerm _ _ _ _ signed r t -> do
+        BVExtendTerm signed r t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize bvExtendTermTag
           serialize signed
           serialize $ natVal r
           serialize $ knownTypeTermId t
-        ApplyTerm _ _ _ _ f ts -> serializeBinary ktTmId applyTermTag f ts
-        DivIntegralTerm _ _ _ _ t1 t2 ->
+        ApplyTerm f ts -> serializeBinary ktTmId applyTermTag f ts
+        DivIntegralTerm t1 t2 ->
           serializeBinary ktTmId divIntegralTermTag t1 t2
-        ModIntegralTerm _ _ _ _ t1 t2 ->
+        ModIntegralTerm t1 t2 ->
           serializeBinary ktTmId modIntegralTermTag t1 t2
-        QuotIntegralTerm _ _ _ _ t1 t2 ->
+        QuotIntegralTerm t1 t2 ->
           serializeBinary ktTmId quotIntegralTermTag t1 t2
-        RemIntegralTerm _ _ _ _ t1 t2 ->
+        RemIntegralTerm t1 t2 ->
           serializeBinary ktTmId remIntegralTermTag t1 t2
-        FPTraitTerm _ _ _ _ trait t -> do
+        FPTraitTerm trait t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize fpTraitTermTag
           serialize trait
           serialize $ knownTypeTermId t
-        FdivTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId fdivTermTag t1 t2
-        RecipTerm _ _ _ _ t -> serializeUnary ktTmId recipTermTag t
-        FloatingUnaryTerm _ _ _ _ op t -> do
+        FdivTerm t1 t2 -> serializeBinary ktTmId fdivTermTag t1 t2
+        RecipTerm t -> serializeUnary ktTmId recipTermTag t
+        FloatingUnaryTerm op t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize floatingUnaryTermTag
           serialize op
           serialize $ knownTypeTermId t
-        PowerTerm _ _ _ _ t1 t2 -> serializeBinary ktTmId powerTermTag t1 t2
-        FPUnaryTerm _ _ _ _ op t -> do
+        PowerTerm t1 t2 -> serializeBinary ktTmId powerTermTag t1 t2
+        FPUnaryTerm op t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize fpUnaryTermTag
           serialize op
           serialize $ knownTypeTermId t
-        FPBinaryTerm _ _ _ _ op t1 t2 -> do
+        FPBinaryTerm op t1 t2 -> do
           serializeSingleSomeTerm $ someTerm t1
           serializeSingleSomeTerm $ someTerm t2
           serialize ktTmId
@@ -1773,7 +1764,7 @@
           serialize op
           serialize $ knownTypeTermId t1
           serialize $ knownTypeTermId t2
-        FPRoundingUnaryTerm _ _ _ _ op rd t -> do
+        FPRoundingUnaryTerm op rd t -> do
           serializeSingleSomeTerm $ someTerm rd
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
@@ -1781,7 +1772,7 @@
           serialize op
           serialize $ knownTypeTermId rd
           serialize $ knownTypeTermId t
-        FPRoundingBinaryTerm _ _ _ _ op rd t1 t2 -> do
+        FPRoundingBinaryTerm op rd t1 t2 -> do
           serializeSingleSomeTerm $ someTerm rd
           serializeSingleSomeTerm $ someTerm t1
           serializeSingleSomeTerm $ someTerm t2
@@ -1791,7 +1782,7 @@
           serialize $ knownTypeTermId rd
           serialize $ knownTypeTermId t1
           serialize $ knownTypeTermId t2
-        FPFMATerm _ _ _ _ rd t1 t2 t3 -> do
+        FPFMATerm rd t1 t2 t3 -> do
           serializeSingleSomeTerm $ someTerm rd
           serializeSingleSomeTerm $ someTerm t1
           serializeSingleSomeTerm $ someTerm t2
@@ -1802,16 +1793,16 @@
           serialize $ knownTypeTermId t1
           serialize $ knownTypeTermId t2
           serialize $ knownTypeTermId t3
-        FromIntegralTerm _ _ _ _ t -> do
+        FromIntegralTerm t -> do
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
           serialize fromIntegralTermTag
           let kt = knownType (Proxy @t)
           serializeKnownType kt
           serialize $ knownTypeTermId t
-        FromFPOrTerm _ _ _ _ d rd t ->
+        FromFPOrTerm d rd t ->
           serializeTernary ktTmId fromFPOrTermTag d rd t
-        ToFPTerm _ _ _ _ rd t eb sb -> do
+        ToFPTerm rd t eb sb -> do
           serializeSingleSomeTerm $ someTerm rd
           serializeSingleSomeTerm $ someTerm t
           serialize ktTmId
@@ -1879,7 +1870,7 @@
   serialize = serializeSomeTerm . someTerm
   deserialize = do
     SomeTerm tm <- deserialize
-    withSupportedPrimTypeable @a $ case castTerm tm of
+    case castTerm tm of
       Just r -> return r
       Nothing -> fail "deserialize Term: type mismatch"
 
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Term.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Term.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Term.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Term.hs
@@ -8,5553 +8,8410 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveLift #-}
 {-# HLINT ignore "Eta reduce" #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE Strict #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-{-# OPTIONS_GHC -funbox-strict-fields #-}
-
--- |
--- Module      :   Grisette.Internal.SymPrim.Prim.Internal.Term
--- Copyright   :   (c) Sirui Lu 2021-2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.SymPrim.Prim.Internal.Term
-  ( -- * Supported primitive types
-    SupportedPrimConstraint (..),
-    SupportedPrim (..),
-    withSupportedPrimTypeable,
-    SymRep (..),
-    ConRep (..),
-    LinkedRep (..),
-
-    -- * Partial evaluation for the terms
-    PEvalApplyTerm (..),
-    PEvalBitwiseTerm (..),
-    PEvalShiftTerm (..),
-    PEvalRotateTerm (..),
-    PEvalNumTerm (..),
-    pevalSubNumTerm,
-    PEvalOrdTerm (..),
-    pevalGtOrdTerm,
-    pevalGeOrdTerm,
-    pevalNEqTerm,
-    PEvalDivModIntegralTerm (..),
-    PEvalBitCastTerm (..),
-    PEvalBitCastOrTerm (..),
-    PEvalBVTerm (..),
-    PEvalFractionalTerm (..),
-    PEvalFloatingTerm (..),
-    PEvalFromIntegralTerm (..),
-    PEvalIEEEFPConvertibleTerm (..),
-
-    -- * Typed symbols
-    SymbolKind (..),
-    TypedSymbol (TypedSymbol, unTypedSymbol),
-    typedConstantSymbol,
-    typedAnySymbol,
-    TypedConstantSymbol,
-    TypedAnySymbol,
-    SomeTypedSymbol (..),
-    SomeTypedConstantSymbol,
-    SomeTypedAnySymbol,
-    IsSymbolKind (..),
-    showUntyped,
-    withSymbolSupported,
-    withConstantSymbolSupported,
-    someTypedSymbol,
-    eqHeteroSymbol,
-    castSomeTypedSymbol,
-    withSymbolKind,
-
-    -- * Terms
-    FPTrait (..),
-    FPUnaryOp (..),
-    FPBinaryOp (..),
-    FPRoundingUnaryOp (..),
-    FPRoundingBinaryOp (..),
-    FloatingUnaryOp (..),
-    Term (..),
-    defaultValueDynamic,
-    pattern DynTerm,
-    toCurThread,
-    termId,
-    termIdent,
-    typeHashId,
-    introSupportedPrimConstraint,
-    pformatTerm,
-    ModelValue (..),
-    toModelValue,
-    unsafeFromModelValue,
-
-    -- * Interning
-    UTerm (..),
-    prettyPrintTerm,
-    forallTerm,
-    existsTerm,
-    conTerm,
-    symTerm,
-    ssymTerm,
-    isymTerm,
-    notTerm,
-    orTerm,
-    andTerm,
-    eqTerm,
-    distinctTerm,
-    iteTerm,
-    addNumTerm,
-    negNumTerm,
-    mulNumTerm,
-    absNumTerm,
-    signumNumTerm,
-    ltOrdTerm,
-    leOrdTerm,
-    andBitsTerm,
-    orBitsTerm,
-    xorBitsTerm,
-    complementBitsTerm,
-    shiftLeftTerm,
-    shiftRightTerm,
-    rotateLeftTerm,
-    rotateRightTerm,
-    bitCastTerm,
-    bitCastOrTerm,
-    bvConcatTerm,
-    bvSelectTerm,
-    bvExtendTerm,
-    bvsignExtendTerm,
-    bvzeroExtendTerm,
-    applyTerm,
-    divIntegralTerm,
-    modIntegralTerm,
-    quotIntegralTerm,
-    remIntegralTerm,
-    fpTraitTerm,
-    fdivTerm,
-    recipTerm,
-    floatingUnaryTerm,
-    powerTerm,
-    fpUnaryTerm,
-    fpBinaryTerm,
-    fpRoundingUnaryTerm,
-    fpRoundingBinaryTerm,
-    fpFMATerm,
-    fromIntegralTerm,
-    fromFPOrTerm,
-    toFPTerm,
-
-    -- * Support for boolean type
-    trueTerm,
-    falseTerm,
-    pattern BoolConTerm,
-    pattern TrueTerm,
-    pattern FalseTerm,
-    pattern BoolTerm,
-    pevalNotTerm,
-    pevalOrTerm,
-    pevalAndTerm,
-    pevalImplyTerm,
-    pevalXorTerm,
-    pevalITEBasic,
-    pevalITEBasicTerm,
-    pevalDefaultEqTerm,
-    NonFuncPrimConstraint,
-    NonFuncSBVRep (..),
-    SupportedNonFuncPrim (..),
-    SBVRep (..),
-    SBVFreshMonad (..),
-    translateTypeError,
-    parseSMTModelResultError,
-    partitionCVArg,
-    parseScalarSMTModelResult,
-  )
-where
-
-#if MIN_VERSION_prettyprinter(1,7,0)
-import Prettyprinter
-  ( column,
-    pageWidth,
-    Doc,
-    PageWidth(Unbounded, AvailablePerLine),
-    Pretty(pretty),
-  )
-#else
-import Data.Text.Prettyprint.Doc
-  ( column,
-    pageWidth,
-    Doc,
-    PageWidth(Unbounded, AvailablePerLine),
-    Pretty(pretty),
-  )
-#endif
-
-#if !MIN_VERSION_sbv(10,0,0)
-#define SMTDefinable Uninterpreted
-#endif
-
-#if MIN_VERSION_sbv(11,0,0)
-import qualified Data.SBV as SBVTC
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-import Language.Haskell.TH (Code, Quote)
-#else
-import Language.Haskell.TH (TExpQ)
-#endif
-
-import Control.DeepSeq (NFData (rnf))
-import Control.Monad (msum)
-import Control.Monad.IO.Class (MonadIO)
-import qualified Control.Monad.RWS.Lazy as Lazy
-import qualified Control.Monad.RWS.Strict as Strict
-import Control.Monad.Reader (MonadTrans (lift), ReaderT)
-import qualified Control.Monad.State.Lazy as Lazy
-import qualified Control.Monad.State.Strict as Strict
-import qualified Control.Monad.Writer.Lazy as Lazy
-import qualified Control.Monad.Writer.Strict as Strict
-import Data.Atomics (atomicModifyIORefCAS_)
-import qualified Data.Binary as Binary
-import Data.Bits (Bits)
-import Data.Bytes.Serial (Serial (deserialize, serialize))
-import qualified Data.HashMap.Strict as HM
-import Data.Hashable (Hashable (hashWithSalt))
-import Data.IORef (IORef, newIORef, readIORef)
-import Data.Kind (Constraint, Type)
-import Data.List.NonEmpty (NonEmpty ((:|)), toList)
-import Data.Maybe (fromMaybe)
-import qualified Data.SBV as SBV
-import qualified Data.SBV.Dynamic as SBVD
-import qualified Data.SBV.Trans as SBVT
-import qualified Data.SBV.Trans.Control as SBVTC
-import qualified Data.Serialize as Cereal
-import Data.String (IsString (fromString))
-import Data.Typeable (Proxy (Proxy), cast, typeRepFingerprint)
-import GHC.Exts (Any, sortWith)
-import GHC.Fingerprint (Fingerprint)
-import GHC.Generics (Generic)
-import GHC.IO (unsafePerformIO)
-import GHC.Stack (HasCallStack)
-import GHC.TypeNats (KnownNat, Nat, type (+), type (<=))
-import Grisette.Internal.Core.Data.Class.BitCast (BitCast, BitCastOr)
-import Grisette.Internal.Core.Data.Class.BitVector
-  ( SizedBV,
-  )
-import Grisette.Internal.Core.Data.Symbol
-  ( Identifier,
-    Symbol (IndexedSymbol, SimpleSymbol),
-  )
-import Grisette.Internal.SymPrim.FP (FP, FPRoundingMode, ValidFP)
-import Grisette.Internal.SymPrim.Prim.Internal.Caches
-  ( Digest,
-    Id,
-    Ident,
-    Interned
-      ( Description,
-        Uninterned,
-        describe,
-        descriptionDigest,
-        identify,
-        threadId
-      ),
-    intern,
-  )
-import Grisette.Internal.SymPrim.Prim.Internal.Utils
-  ( WeakThreadId,
-    myWeakThreadId,
-  )
-import Language.Haskell.TH.Syntax (Lift (liftTyped))
-import Type.Reflection
-  ( SomeTypeRep (SomeTypeRep),
-    TypeRep,
-    Typeable,
-    eqTypeRep,
-    someTypeRep,
-    typeRep,
-    withTypeable,
-    type (:~~:) (HRefl),
-  )
-import Unsafe.Coerce (unsafeCoerce)
-
--- $setup
--- >>> import Grisette.Core
--- >>> import Grisette.SymPrim
-
--- | Monads that supports generating sbv fresh variables.
-class (MonadIO m) => SBVFreshMonad m where
-  sbvFresh :: (SBV.SymVal a) => String -> m (SBV.SBV a)
-
-instance (MonadIO m) => SBVFreshMonad (SBVT.SymbolicT m) where
-  sbvFresh = SBVT.free
-  {-# INLINE sbvFresh #-}
-
-instance (MonadIO m) => SBVFreshMonad (SBVTC.QueryT m) where
-  sbvFresh = SBVTC.freshVar
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m) => SBVFreshMonad (ReaderT r m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Lazy.WriterT w m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Lazy.RWST r w s m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m) => SBVFreshMonad (Lazy.StateT s m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Strict.WriterT w m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Strict.RWST r w s m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
-instance (SBVFreshMonad m) => SBVFreshMonad (Strict.StateT s m) where
-  sbvFresh = lift . sbvFresh
-  {-# INLINE sbvFresh #-}
-
--- | Error message for unsupported types.
-translateTypeError :: (HasCallStack) => Maybe String -> TypeRep a -> b
-translateTypeError Nothing ta =
-  error $
-    "Don't know how to translate the type " ++ show ta ++ " to SMT"
-translateTypeError (Just reason) ta =
-  error $
-    "Don't know how to translate the type " ++ show ta ++ " to SMT: " <> reason
-
--- | Type class for resolving the base type for the SBV type for the primitive
--- type.
-class (SupportedPrim a, Ord a) => NonFuncSBVRep a where
-  type NonFuncSBVBaseType a
-
--- | Type class for resolving the constraint for a supported non-function
--- primitive type.
-type NonFuncPrimConstraint a =
-  ( SBV.SymVal (NonFuncSBVBaseType a),
-    SBV.EqSymbolic (SBVType a),
-    SBV.Mergeable (SBVType a),
-    SBV.SMTDefinable (SBVType a),
-    SBV.Mergeable (SBVType a),
-    SBVType a ~ SBV.SBV (NonFuncSBVBaseType a),
-    PrimConstraint a
-  )
-
--- | Indicates that a type is supported, can be represented as a symbolic term,
--- is not a function type, and can be lowered to an SBV term.
-class (NonFuncSBVRep a) => SupportedNonFuncPrim a where
-  conNonFuncSBVTerm :: a -> SBV.SBV (NonFuncSBVBaseType a)
-  symNonFuncSBVTerm ::
-    (SBVFreshMonad m) => String -> m (SBV.SBV (NonFuncSBVBaseType a))
-  withNonFuncPrim :: ((NonFuncPrimConstraint a) => r) -> r
-
--- | Partition the list of CVs for models for functions.
-partitionCVArg ::
-  forall a.
-  (SupportedNonFuncPrim a) =>
-  [([SBVD.CV], SBVD.CV)] ->
-  [(a, [([SBVD.CV], SBVD.CV)])]
-partitionCVArg cv =
-  partitionOrdCVArg $
-    parseFirstCVArg cv
-  where
-    parseFirstCVArg ::
-      forall a.
-      (SupportedNonFuncPrim a) =>
-      [([SBVD.CV], SBVD.CV)] ->
-      [(a, [([SBVD.CV], SBVD.CV)])]
-    parseFirstCVArg =
-      fmap
-        ( \case
-            (x : xs, v) ->
-              (parseSMTModelResult 0 ([], x), [(xs, v)])
-            _ -> error "impossible"
-        )
-    partitionOrdCVArg ::
-      forall a.
-      (SupportedNonFuncPrim a) =>
-      [(a, [([SBVD.CV], SBVD.CV)])] ->
-      [(a, [([SBVD.CV], SBVD.CV)])]
-    partitionOrdCVArg v = go sorted
-      where
-        sorted = sortWith fst v :: [(a, [([SBVD.CV], SBVD.CV)])]
-        go (x : x1 : xs) =
-          if fst x == fst x1
-            then go $ (fst x, snd x ++ snd x1) : xs
-            else x : go (x1 : xs)
-        go x = x
-
--- | Parse the scalar model result.
-parseScalarSMTModelResult ::
-  forall v r.
-  (SBV.SatModel r, Typeable v) =>
-  (r -> v) ->
-  ([([SBVD.CV], SBVD.CV)], SBVD.CV) ->
-  v
-parseScalarSMTModelResult convert cvs@([], v) = case SBV.parseCVs [v] of
-  Just (x, _) -> convert x
-  Nothing -> parseSMTModelResultError (typeRep @v) cvs
-parseScalarSMTModelResult _ cv = parseSMTModelResultError (typeRep @v) cv
-
--- | Type class for resolving the SBV type for the primitive type.
-class SBVRep t where
-  type SBVType t
-
--- | Type class for resolving the constraint for a supported primitive type.
-class SupportedPrimConstraint t where
-  type PrimConstraint t :: Constraint
-  type PrimConstraint _ = ()
-
--- | Indicates that a type is supported, can be represented as a symbolic term,
--- and can be lowered to an SBV term.
-class
-  ( Lift t,
-    NFData t,
-    SupportedPrimConstraint t,
-    SBVRep t
-  ) =>
-  SupportedPrim t
-  where
-  primTypeRep :: TypeRep t
-  default primTypeRep :: (Typeable t) => TypeRep t
-  primTypeRep = typeRep
-  sameCon :: t -> t -> Bool
-  default sameCon :: (Eq t) => t -> t -> Bool
-  sameCon = (==)
-  hashConWithSalt :: Int -> t -> Int
-  default hashConWithSalt :: (Hashable t) => Int -> t -> Int
-  hashConWithSalt = hashWithSalt
-  pformatCon :: t -> String
-  default pformatCon :: (Show t) => t -> String
-  pformatCon = show
-  defaultValue :: t
-  pevalITETerm :: Term Bool -> Term t -> Term t -> Term t
-  pevalEqTerm :: Term t -> Term t -> Term Bool
-  pevalDistinctTerm :: NonEmpty (Term t) -> Term Bool
-  conSBVTerm :: t -> SBVType t
-  symSBVName :: TypedSymbol 'AnyKind t -> Int -> String
-  symSBVTerm :: (SBVFreshMonad m) => String -> m (SBVType t)
-  default withPrim ::
-    ( PrimConstraint t,
-      SBV.SMTDefinable (SBVType t),
-      SBV.Mergeable (SBVType t),
-      Typeable (SBVType t)
-    ) =>
-    ( ( PrimConstraint t,
-        SBV.SMTDefinable (SBVType t),
-        SBV.Mergeable (SBVType t),
-        Typeable (SBVType t)
-      ) =>
-      a
-    ) ->
-    a
-  withPrim ::
-    ( ( PrimConstraint t,
-        SBV.SMTDefinable (SBVType t),
-        SBV.Mergeable (SBVType t),
-        Typeable (SBVType t)
-      ) =>
-      a
-    ) ->
-    a
-  withPrim i = i
-  {-# INLINE withPrim #-}
-  sbvIte :: SBV.SBV Bool -> SBVType t -> SBVType t -> SBVType t
-  sbvIte = withPrim @t SBV.ite
-  sbvEq :: SBVType t -> SBVType t -> SBV.SBV Bool
-  default sbvEq ::
-    (SBVT.EqSymbolic (SBVType t)) => SBVType t -> SBVType t -> SBV.SBV Bool
-  sbvEq = (SBV..==)
-  sbvDistinct :: NonEmpty (SBVType t) -> SBV.SBV Bool
-  default sbvDistinct ::
-    (SBVT.EqSymbolic (SBVType t)) => NonEmpty (SBVType t) -> SBV.SBV Bool
-  sbvDistinct = SBV.distinct . toList
-  parseSMTModelResult :: Int -> ([([SBVD.CV], SBVD.CV)], SBVD.CV) -> t
-  castTypedSymbol ::
-    (IsSymbolKind knd') => TypedSymbol knd t -> Maybe (TypedSymbol knd' t)
-  funcDummyConstraint :: SBVType t -> SBV.SBV Bool
-
--- | The default value in a dynamic t'ModelValue'.
-defaultValueDynamic ::
-  forall t proxy. (SupportedPrim t) => proxy t -> ModelValue
-defaultValueDynamic _ = toModelValue (defaultValue @t)
-
--- | A value with its type information.
-data ModelValue where
-  ModelValue :: forall v. (SupportedPrim v) => v -> ModelValue
-
-instance NFData ModelValue where
-  rnf (ModelValue v) = rnf v
-
-instance Lift ModelValue where
-  liftTyped (ModelValue v) = [||ModelValue v||]
-
-instance Show ModelValue where
-  show (ModelValue (v :: v)) = pformatCon v ++ " :: " ++ show (primTypeRep @v)
-
-instance Eq ModelValue where
-  (ModelValue (v1 :: v1)) == (ModelValue (v2 :: v2)) =
-    case eqTypeRep (primTypeRep @v1) (primTypeRep @v2) of
-      Just HRefl -> sameCon v1 v2
-      _ -> False
-
-instance Hashable ModelValue where
-  s `hashWithSalt` (ModelValue (v :: v)) =
-    (s `hashWithSalt` (primTypeRep @v)) `hashConWithSalt` v
-
--- | Convert from a model value. Crashes if the types does not match.
-unsafeFromModelValue :: forall a. (Typeable a) => ModelValue -> a
-unsafeFromModelValue (ModelValue (v :: v)) =
-  case eqTypeRep (primTypeRep @v) (typeRep @a) of
-    Just HRefl -> v
-    _ ->
-      error $
-        "Bad model value type, expected type: "
-          ++ show (typeRep @a)
-          ++ ", but got: "
-          ++ show (primTypeRep @v)
-
--- | Convert to a model value.
-toModelValue :: forall a. (SupportedPrim a) => a -> ModelValue
-toModelValue = ModelValue
-
--- | Cast a typed symbol to a different kind. Check if the kind is compatible.
-castSomeTypedSymbol ::
-  (IsSymbolKind knd') => SomeTypedSymbol knd -> Maybe (SomeTypedSymbol knd')
-castSomeTypedSymbol (SomeTypedSymbol s@TypedSymbol {}) =
-  SomeTypedSymbol <$> castTypedSymbol s
-{-# INLINE castSomeTypedSymbol #-}
-
--- | Error message for failure to parse the SBV model result.
-parseSMTModelResultError ::
-  (HasCallStack) => TypeRep a -> ([([SBVD.CV], SBVD.CV)], SBVD.CV) -> a
-parseSMTModelResultError ty cv =
-  error $
-    "BUG: cannot parse SBV model value \""
-      <> show cv
-      <> "\" to Grisette model value with the type "
-      <> show ty
-
--- | Partial evaluation for inequality terms.
-pevalNEqTerm :: (SupportedPrim a) => Term a -> Term a -> Term Bool
-pevalNEqTerm l r = pevalNotTerm $ pevalEqTerm l r
-{-# INLINE pevalNEqTerm #-}
-
--- | Type family to resolve the concrete type associated with a symbolic type.
-class ConRep sym where
-  type ConType sym
-
--- | Type family to resolve the symbolic type associated with a concrete type.
-class (SupportedPrim con) => SymRep con where
-  type SymType con
-
--- | One-to-one mapping between symbolic types and concrete types.
-class
-  (ConRep sym, SymRep con, sym ~ SymType con, con ~ ConType sym) =>
-  LinkedRep con sym
-    | con -> sym,
-      sym -> con
-  where
-  underlyingTerm :: sym -> Term con
-  wrapTerm :: Term con -> sym
-
--- | Partial evaluation and lowering for function application terms.
-class PEvalApplyTerm f a b | f -> a b where
-  pevalApplyTerm :: Term f -> Term a -> Term b
-  sbvApplyTerm :: SBVType f -> SBVType a -> SBVType b
-
--- | Partial evaluation and lowering for bitwise operation terms.
-class PEvalBitwiseTerm t where
-  pevalAndBitsTerm :: Term t -> Term t -> Term t
-  pevalOrBitsTerm :: Term t -> Term t -> Term t
-  pevalXorBitsTerm :: Term t -> Term t -> Term t
-  pevalComplementBitsTerm :: Term t -> Term t
-  withSbvBitwiseTermConstraint :: (((Bits (SBVType t)) => r)) -> r
-  sbvAndBitsTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvAndBitsTerm = withSbvBitwiseTermConstraint @t (SBV..&.)
-  sbvOrBitsTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvOrBitsTerm = withSbvBitwiseTermConstraint @t (SBV..|.)
-  sbvXorBitsTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvXorBitsTerm = withSbvBitwiseTermConstraint @t SBV.xor
-  sbvComplementBitsTerm :: SBVType t -> SBVType t
-  sbvComplementBitsTerm = withSbvBitwiseTermConstraint @t SBV.complement
-
--- | Partial evaluation and lowering for symbolic shifting terms.
-class PEvalShiftTerm t where
-  pevalShiftLeftTerm :: Term t -> Term t -> Term t
-  pevalShiftRightTerm :: Term t -> Term t -> Term t
-  withSbvShiftTermConstraint ::
-    (((SBV.SIntegral (NonFuncSBVBaseType t)) => r)) -> r
-  sbvShiftLeftTerm :: SBVType t -> SBVType t -> SBVType t
-  default sbvShiftLeftTerm ::
-    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
-  sbvShiftLeftTerm l r =
-    withNonFuncPrim @t $ withSbvShiftTermConstraint @t $ SBV.sShiftLeft l r
-  default sbvShiftRightTerm ::
-    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
-  sbvShiftRightTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvShiftRightTerm l r =
-    withNonFuncPrim @t $ withSbvShiftTermConstraint @t $ SBV.sShiftRight l r
-
--- | Partial evaluation and lowering for symbolic rotate terms.
-class PEvalRotateTerm t where
-  pevalRotateLeftTerm :: Term t -> Term t -> Term t
-  pevalRotateRightTerm :: Term t -> Term t -> Term t
-  withSbvRotateTermConstraint ::
-    (((SBV.SIntegral (NonFuncSBVBaseType t)) => r)) -> r
-  sbvRotateLeftTerm :: SBVType t -> SBVType t -> SBVType t
-  default sbvRotateLeftTerm ::
-    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
-  sbvRotateLeftTerm l r =
-    withNonFuncPrim @t $ withSbvRotateTermConstraint @t $ SBV.sRotateLeft l r
-  sbvRotateRightTerm :: SBVType t -> SBVType t -> SBVType t
-  default sbvRotateRightTerm ::
-    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
-  sbvRotateRightTerm l r =
-    withNonFuncPrim @t $ withSbvRotateTermConstraint @t $ SBV.sRotateRight l r
-
--- | Partial evaluation and lowering for number terms.
-class (Num t) => PEvalNumTerm t where
-  pevalAddNumTerm :: Term t -> Term t -> Term t
-  pevalNegNumTerm :: Term t -> Term t
-  pevalMulNumTerm :: Term t -> Term t -> Term t
-  pevalAbsNumTerm :: Term t -> Term t
-  pevalSignumNumTerm :: Term t -> Term t
-  withSbvNumTermConstraint :: (((Num (SBVType t)) => r)) -> r
-  sbvAddNumTerm ::
-    SBVType t ->
-    SBVType t ->
-    SBVType t
-  sbvAddNumTerm l r = withSbvNumTermConstraint @t $ l + r
-  sbvNegNumTerm ::
-    SBVType t ->
-    SBVType t
-  sbvNegNumTerm l = withSbvNumTermConstraint @t $ -l
-  sbvMulNumTerm ::
-    SBVType t ->
-    SBVType t ->
-    SBVType t
-  sbvMulNumTerm l r = withSbvNumTermConstraint @t $ l * r
-  sbvAbsNumTerm ::
-    SBVType t ->
-    SBVType t
-  sbvAbsNumTerm l = withSbvNumTermConstraint @t $ abs l
-  sbvSignumNumTerm ::
-    SBVType t ->
-    SBVType t
-  sbvSignumNumTerm l = withSbvNumTermConstraint @t $ signum l
-
--- | Partial evaluation for subtraction terms.
-pevalSubNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> Term a
-pevalSubNumTerm l r = pevalAddNumTerm l (pevalNegNumTerm r)
-
--- | Partial evaluation and lowering for comparison terms.
-class PEvalOrdTerm t where
-  pevalLtOrdTerm :: Term t -> Term t -> Term Bool
-  pevalLeOrdTerm :: Term t -> Term t -> Term Bool
-  withSbvOrdTermConstraint :: (((SBV.OrdSymbolic (SBVType t)) => r)) -> r
-  sbvLtOrdTerm ::
-    SBVType t ->
-    SBVType t ->
-    SBV.SBV Bool
-  sbvLtOrdTerm l r = withSbvOrdTermConstraint @t $ l SBV..< r
-  sbvLeOrdTerm :: SBVType t -> SBVType t -> SBV.SBV Bool
-  sbvLeOrdTerm l r = withSbvOrdTermConstraint @t $ l SBV..<= r
-
--- | Partial evaluation for greater than terms.
-pevalGtOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
-pevalGtOrdTerm = flip pevalLtOrdTerm
-{-# INLINE pevalGtOrdTerm #-}
-
--- | Partial evaluation for greater than or equal to terms.
-pevalGeOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
-pevalGeOrdTerm = flip pevalLeOrdTerm
-{-# INLINE pevalGeOrdTerm #-}
-
--- | Partial evaluation and lowering for integer division and modulo terms.
-class PEvalDivModIntegralTerm t where
-  pevalDivIntegralTerm :: Term t -> Term t -> Term t
-  pevalModIntegralTerm :: Term t -> Term t -> Term t
-  pevalQuotIntegralTerm :: Term t -> Term t -> Term t
-  pevalRemIntegralTerm :: Term t -> Term t -> Term t
-  withSbvDivModIntegralTermConstraint ::
-    (((SBV.SDivisible (SBVType t)) => r)) -> r
-  sbvDivIntegralTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvDivIntegralTerm l r =
-    withSbvDivModIntegralTermConstraint @t $ l `SBV.sDiv` r
-  sbvModIntegralTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvModIntegralTerm l r =
-    withSbvDivModIntegralTermConstraint @t $ l `SBV.sMod` r
-  sbvQuotIntegralTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvQuotIntegralTerm l r =
-    withSbvDivModIntegralTermConstraint @t $ l `SBV.sQuot` r
-  sbvRemIntegralTerm :: SBVType t -> SBVType t -> SBVType t
-  sbvRemIntegralTerm l r =
-    withSbvDivModIntegralTermConstraint @t $ l `SBV.sRem` r
-
--- | Partial evaluation and lowering for bitcast terms.
-class (BitCast a b) => PEvalBitCastTerm a b where
-  pevalBitCastTerm :: Term a -> Term b
-  sbvBitCast :: SBVType a -> SBVType b
-
--- | Partial evaluation and lowering for bitcast or default value terms.
-class
-  (BitCastOr a b) =>
-  PEvalBitCastOrTerm a b
-  where
-  pevalBitCastOrTerm :: Term b -> Term a -> Term b
-  sbvBitCastOr :: SBVType b -> SBVType a -> SBVType b
-
--- | Partial evaluation and lowering for bit-vector terms.
-class (SizedBV bv) => PEvalBVTerm bv where
-  pevalBVConcatTerm ::
-    (KnownNat l, KnownNat r, 1 <= l, 1 <= r) =>
-    Term (bv l) ->
-    Term (bv r) ->
-    Term (bv (l + r))
-  pevalBVExtendTerm ::
-    (KnownNat l, KnownNat r, 1 <= l, 1 <= r, l <= r) =>
-    Bool ->
-    proxy r ->
-    Term (bv l) ->
-    Term (bv r)
-  pevalBVSelectTerm ::
-    (KnownNat n, KnownNat ix, KnownNat w, 1 <= n, 1 <= w, ix + w <= n) =>
-    p ix ->
-    q w ->
-    Term (bv n) ->
-    Term (bv w)
-  sbvBVConcatTerm ::
-    (KnownNat l, KnownNat r, 1 <= l, 1 <= r) =>
-    p1 l ->
-    p2 r ->
-    SBVType (bv l) ->
-    SBVType (bv r) ->
-    SBVType (bv (l + r))
-  sbvBVExtendTerm ::
-    (KnownNat l, KnownNat r, 1 <= l, 1 <= r, l <= r) =>
-    p1 l ->
-    p2 r ->
-    Bool ->
-    SBVType (bv l) ->
-    SBVType (bv r)
-  sbvBVSelectTerm ::
-    ( KnownNat ix,
-      KnownNat w,
-      KnownNat n,
-      1 <= n,
-      1 <= w,
-      ix + w <= n
-    ) =>
-    p1 ix ->
-    p2 w ->
-    p3 n ->
-    SBVType (bv n) ->
-    SBVType (bv w)
-
--- | Partial evaluation and lowering for fractional terms.
-class (Fractional t) => PEvalFractionalTerm t where
-  pevalFdivTerm :: Term t -> Term t -> Term t
-  pevalRecipTerm :: Term t -> Term t
-  withSbvFractionalTermConstraint ::
-    (((Fractional (SBVType t)) => r)) ->
-    r
-  sbvFdivTerm ::
-    SBVType t ->
-    SBVType t ->
-    SBVType t
-  sbvFdivTerm l r = withSbvFractionalTermConstraint @t $ l / r
-  sbvRecipTerm ::
-    SBVType t ->
-    SBVType t
-  sbvRecipTerm l = withSbvFractionalTermConstraint @t $ recip l
-
--- | Unary floating point operations.
-data FloatingUnaryOp
-  = FloatingExp
-  | FloatingLog
-  | FloatingSqrt
-  | FloatingSin
-  | FloatingCos
-  | FloatingTan
-  | FloatingAsin
-  | FloatingAcos
-  | FloatingAtan
-  | FloatingSinh
-  | FloatingCosh
-  | FloatingTanh
-  | FloatingAsinh
-  | FloatingAcosh
-  | FloatingAtanh
-  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
-
-instance Cereal.Serialize FloatingUnaryOp where
-  put = serialize
-  get = deserialize
-
-instance Binary.Binary FloatingUnaryOp where
-  put = serialize
-  get = deserialize
-
-instance Show FloatingUnaryOp where
-  show FloatingExp = "exp"
-  show FloatingLog = "log"
-  show FloatingSqrt = "sqrt"
-  show FloatingSin = "sin"
-  show FloatingCos = "cos"
-  show FloatingTan = "tan"
-  show FloatingAsin = "asin"
-  show FloatingAcos = "acos"
-  show FloatingAtan = "atan"
-  show FloatingSinh = "sinh"
-  show FloatingCosh = "cosh"
-  show FloatingTanh = "tanh"
-  show FloatingAsinh = "asinh"
-  show FloatingAcosh = "acosh"
-  show FloatingAtanh = "atanh"
-
--- | Partial evaluation and lowering for floating point terms.
-class PEvalFloatingTerm t where
-  pevalFloatingUnaryTerm :: FloatingUnaryOp -> Term t -> Term t
-  pevalPowerTerm :: Term t -> Term t -> Term t
-  withSbvFloatingTermConstraint ::
-    (((Floating (SBVType t)) => r)) ->
-    r
-  sbvPowerTerm ::
-    SBVType t ->
-    SBVType t ->
-    SBVType t
-  sbvPowerTerm = withSbvFloatingTermConstraint @t (**)
-  sbvFloatingUnaryTerm ::
-    FloatingUnaryOp ->
-    SBVType t ->
-    SBVType t
-  sbvFloatingUnaryTerm op l =
-    withSbvFloatingTermConstraint @t $
-      case op of
-        FloatingExp -> exp l
-        FloatingLog -> log l
-        FloatingSqrt -> sqrt l
-        FloatingSin -> sin l
-        FloatingCos -> cos l
-        FloatingTan -> tan l
-        FloatingAsin -> asin l
-        FloatingAcos -> acos l
-        FloatingAtan -> atan l
-        FloatingSinh -> sinh l
-        FloatingCosh -> cosh l
-        FloatingTanh -> tanh l
-        FloatingAsinh -> asinh l
-        FloatingAcosh -> acosh l
-        FloatingAtanh -> atanh l
-
--- | Partial evaluation and lowering for integral terms.
-class (Integral a, Num b) => PEvalFromIntegralTerm a b where
-  pevalFromIntegralTerm :: Term a -> Term b
-  sbvFromIntegralTerm :: SBVType a -> SBVType b
-
--- | Partial evaluation and lowering for converting from and to IEEE floating
--- point terms.
-class PEvalIEEEFPConvertibleTerm a where
-  pevalFromFPOrTerm ::
-    (ValidFP eb sb) =>
-    Term a ->
-    Term FPRoundingMode ->
-    Term (FP eb sb) ->
-    Term a
-  pevalToFPTerm ::
-    (ValidFP eb sb) => Term FPRoundingMode -> Term a -> Term (FP eb sb)
-  sbvFromFPOrTerm ::
-    (ValidFP eb sb) =>
-    SBVType a ->
-    SBVType FPRoundingMode ->
-    SBVType (FP eb sb) ->
-    SBVType a
-  sbvToFPTerm ::
-    (ValidFP eb sb) =>
-    SBVType FPRoundingMode ->
-    SBVType a ->
-    SBVType (FP eb sb)
-
--- Typed Symbols
-
--- | The kind of a symbol.
---
--- All symbols are 'AnyKind', and all symbols other than general/tabular
--- functions are 'ConstantKind'.
-data SymbolKind = ConstantKind | AnyKind
-
--- | Decision procedure for symbol kinds.
-class IsSymbolKind (ty :: SymbolKind) where
-  type SymbolKindConstraint ty :: Type -> Constraint
-  decideSymbolKind :: Either (ty :~~: 'ConstantKind) (ty :~~: 'AnyKind)
-
-instance IsSymbolKind 'ConstantKind where
-  type SymbolKindConstraint 'ConstantKind = SupportedNonFuncPrim
-  decideSymbolKind = Left HRefl
-
-instance IsSymbolKind 'AnyKind where
-  type SymbolKindConstraint 'AnyKind = SupportedPrim
-  decideSymbolKind = Right HRefl
-
--- | A typed symbol is a symbol that is associated with a type. Note that the
--- same symbol bodies with different types are considered different symbols
--- and can coexist in a term.
---
--- Simple symbols can be created with the @OverloadedStrings@ extension:
---
--- >>> "a" :: TypedSymbol 'AnyKind Bool
--- a :: Bool
-data TypedSymbol (knd :: SymbolKind) t where
-  TypedSymbol ::
-    ( SupportedPrim t,
-      SymbolKindConstraint knd t,
-      IsSymbolKind knd
-    ) =>
-    {unTypedSymbol :: Symbol} ->
-    TypedSymbol knd t
-
--- | Create a typed symbol with constant kinds.
-typedConstantSymbol ::
-  forall t. (SupportedNonFuncPrim t) => Symbol -> TypedSymbol 'ConstantKind t
-typedConstantSymbol = typedConstantSymbol' getPhantomNonFuncDict
-{-# INLINE typedConstantSymbol #-}
-
-{-# NOINLINE typedConstantSymbol' #-}
-typedConstantSymbol' ::
-  forall t. PhantomNonFuncDict t -> Symbol -> TypedSymbol 'ConstantKind t
-typedConstantSymbol' PhantomNonFuncDict symbol = TypedSymbol symbol
-
--- | Create a typed symbol with any kinds.
-typedAnySymbol ::
-  forall t. (SupportedPrim t) => Symbol -> TypedSymbol 'AnyKind t
-typedAnySymbol = typedAnySymbol' getPhantomDict
-{-# INLINE typedAnySymbol #-}
-
-{-# NOINLINE typedAnySymbol' #-}
-typedAnySymbol' ::
-  forall t. PhantomDict t -> Symbol -> TypedSymbol 'AnyKind t
-typedAnySymbol' PhantomDict symbol = TypedSymbol symbol
-
--- | Constant symbol
-type TypedConstantSymbol = TypedSymbol 'ConstantKind
-
--- | Any symbol
-type TypedAnySymbol = TypedSymbol 'AnyKind
-
-instance Eq (TypedSymbol knd t) where
-  TypedSymbol x == TypedSymbol y = x == y
-
-instance Ord (TypedSymbol knd t) where
-  TypedSymbol x <= TypedSymbol y = x <= y
-
-instance Lift (TypedSymbol knd t) where
-  liftTyped (TypedSymbol x) = [||TypedSymbol x||]
-
-instance Show (TypedSymbol knd t) where
-  show (TypedSymbol symbol) = show symbol ++ " :: " ++ show (primTypeRep @t)
-
--- | Show a typed symbol without the type information.
-showUntyped :: TypedSymbol knd t -> String
-showUntyped (TypedSymbol symbol) = show symbol
-
-instance Hashable (TypedSymbol knd t) where
-  s `hashWithSalt` TypedSymbol x = s `hashWithSalt` x
-
-instance NFData (TypedSymbol knd t) where
-  rnf (TypedSymbol str) = rnf str
-
-instance
-  ( SupportedPrim t,
-    SymbolKindConstraint knd t,
-    IsSymbolKind knd
-  ) =>
-  IsString (TypedSymbol knd t)
-  where
-  fromString = TypedSymbol . fromString
-
--- | Introduce the 'SupportedPrim' constraint from the t'TypedSymbol'.
-withSymbolSupported ::
-  forall knd t a.
-  TypedSymbol knd t ->
-  ((SupportedPrim t, Typeable t) => a) ->
-  a
-withSymbolSupported (TypedSymbol _) a =
-  withSupportedPrimTypeable @t $ a
-{-# INLINE withSymbolSupported #-}
-
--- | Introduce the 'SupportedPrim' constraint from the t'TypedSymbol'.
-withConstantSymbolSupported ::
-  forall t a.
-  TypedSymbol 'ConstantKind t ->
-  ((SupportedNonFuncPrim t, Typeable t) => a) ->
-  a
-withConstantSymbolSupported (TypedSymbol _) a =
-  withSupportedPrimTypeable @t $ a
-{-# INLINE withConstantSymbolSupported #-}
-
--- | Introduce the 'IsSymbolKind' constraint from the t'TypedSymbol'.
-withSymbolKind :: TypedSymbol knd t -> ((IsSymbolKind knd) => a) -> a
-withSymbolKind (TypedSymbol _) a = a
-{-# INLINE withSymbolKind #-}
-
--- | A non-indexed symbol. Type information are checked at runtime.
-data SomeTypedSymbol knd where
-  SomeTypedSymbol ::
-    forall knd t.
-    TypedSymbol knd t ->
-    SomeTypedSymbol knd
-
--- | Non-indexed constant symbol
-type SomeTypedConstantSymbol = SomeTypedSymbol 'ConstantKind
-
--- | Non-indexed any symbol
-type SomeTypedAnySymbol = SomeTypedSymbol 'AnyKind
-
-instance NFData (SomeTypedSymbol knd) where
-  rnf (SomeTypedSymbol s) = rnf s
-  {-# INLINE rnf #-}
-
-instance Lift (SomeTypedSymbol knd) where
-  liftTyped (SomeTypedSymbol s) = [||SomeTypedSymbol s||]
-
-instance Eq (SomeTypedSymbol knd) where
-  (SomeTypedSymbol (s1 :: TypedSymbol knd a))
-    == (SomeTypedSymbol (s2 :: TypedSymbol knd b)) =
-      withSymbolSupported s1 $
-        withSymbolSupported s2 $
-          case eqTypeRep (primTypeRep @a) (primTypeRep @b) of
-            Just HRefl -> s1 == s2
-            _ -> False
-  {-# INLINE (==) #-}
-
-instance Ord (SomeTypedSymbol knd) where
-  (SomeTypedSymbol (s1 :: TypedSymbol knd a))
-    <= (SomeTypedSymbol (s2 :: TypedSymbol knd b)) =
-      withSymbolSupported s1 $
-        withSymbolSupported s2 $
-          let t1 = primTypeRep @a
-              t2 = primTypeRep @b
-           in SomeTypeRep t1 < SomeTypeRep t2
-                || ( case eqTypeRep t1 t2 of
-                       Just HRefl -> s1 <= s2
-                       _ -> False
-                   )
-
-instance Hashable (SomeTypedSymbol knd) where
-  hashWithSalt s (SomeTypedSymbol s1) = s `hashWithSalt` s1
-  {-# INLINE hashWithSalt #-}
-
-instance Show (SomeTypedSymbol knd) where
-  show (SomeTypedSymbol s) = show s
-
--- | Construct a t'SomeTypedSymbol' from a t'TypedSymbol'.
-someTypedSymbol :: forall knd t. TypedSymbol knd t -> SomeTypedSymbol knd
-someTypedSymbol s@(TypedSymbol _) = SomeTypedSymbol s
-{-# INLINE someTypedSymbol #-}
-
--- Terms
-
--- | Traits for IEEE floating point numbers.
-data FPTrait
-  = FPIsNaN
-  | FPIsPositive
-  | FPIsNegative
-  | FPIsPositiveInfinite
-  | FPIsNegativeInfinite
-  | FPIsInfinite
-  | FPIsPositiveZero
-  | FPIsNegativeZero
-  | FPIsZero
-  | FPIsNormal
-  | FPIsSubnormal
-  | FPIsPoint
-  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
-
-instance Cereal.Serialize FPTrait where
-  put = serialize
-  get = deserialize
-
-instance Binary.Binary FPTrait where
-  put = serialize
-  get = deserialize
-
-instance Show FPTrait where
-  show FPIsNaN = "is_nan"
-  show FPIsPositive = "is_pos"
-  show FPIsNegative = "is_neg"
-  show FPIsPositiveInfinite = "is_pos_inf"
-  show FPIsNegativeInfinite = "is_neg_inf"
-  show FPIsInfinite = "is_inf"
-  show FPIsPositiveZero = "is_pos_zero"
-  show FPIsNegativeZero = "is_neg_zero"
-  show FPIsZero = "is_zero"
-  show FPIsNormal = "is_normal"
-  show FPIsSubnormal = "is_subnormal"
-  show FPIsPoint = "is_point"
-
--- | Unary floating point operations.
-data FPUnaryOp = FPAbs | FPNeg
-  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
-
-instance Cereal.Serialize FPUnaryOp where
-  put = serialize
-  get = deserialize
-
-instance Binary.Binary FPUnaryOp where
-  put = serialize
-  get = deserialize
-
-instance Show FPUnaryOp where
-  show FPAbs = "fp.abs"
-  show FPNeg = "fp.neg"
-
--- | Binary floating point operations.
-data FPBinaryOp
-  = FPRem
-  | FPMinimum
-  | FPMinimumNumber
-  | FPMaximum
-  | FPMaximumNumber
-  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
-
-instance Cereal.Serialize FPBinaryOp where
-  put = serialize
-  get = deserialize
-
-instance Binary.Binary FPBinaryOp where
-  put = serialize
-  get = deserialize
-
-instance Show FPBinaryOp where
-  show FPRem = "fp.rem"
-  show FPMinimum = "fp.minimum"
-  show FPMinimumNumber = "fp.minimumNumber"
-  show FPMaximum = "fp.maximum"
-  show FPMaximumNumber = "fp.maximumNumber"
-
--- | Unary floating point operations with rounding modes.
-data FPRoundingUnaryOp = FPSqrt | FPRoundToIntegral
-  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
-
-instance Cereal.Serialize FPRoundingUnaryOp where
-  put = serialize
-  get = deserialize
-
-instance Binary.Binary FPRoundingUnaryOp where
-  put = serialize
-  get = deserialize
-
-instance Show FPRoundingUnaryOp where
-  show FPSqrt = "fp.sqrt"
-  show FPRoundToIntegral = "fp.roundToIntegral"
-
--- | Binary floating point operations with rounding modes.
-data FPRoundingBinaryOp = FPAdd | FPSub | FPMul | FPDiv
-  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
-
-instance Cereal.Serialize FPRoundingBinaryOp where
-  put = serialize
-  get = deserialize
-
-instance Binary.Binary FPRoundingBinaryOp where
-  put = serialize
-  get = deserialize
-
-instance Show FPRoundingBinaryOp where
-  show FPAdd = "fp.add"
-  show FPSub = "fp.sub"
-  show FPMul = "fp.mul"
-  show FPDiv = "fp.div"
-
--- | Internal representation for Grisette symbolic terms.
-data Term t where
-  ConTerm ::
-    (SupportedPrim t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !t ->
-    Term t
-  SymTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(TypedSymbol 'AnyKind t) ->
-    Term t
-  ForallTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(TypedSymbol 'ConstantKind t) ->
-    !(Term Bool) ->
-    Term Bool
-  ExistsTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(TypedSymbol 'ConstantKind t) ->
-    !(Term Bool) ->
-    Term Bool
-  NotTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term Bool) ->
-    Term Bool
-  OrTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term Bool) ->
-    !(Term Bool) ->
-    Term Bool
-  AndTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term Bool) ->
-    !(Term Bool) ->
-    Term Bool
-  EqTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term Bool
-  DistinctTerm ::
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(NonEmpty (Term t)) ->
-    Term Bool
-  ITETerm ::
-    (SupportedPrim t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term Bool) ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  AddNumTerm ::
-    (SupportedPrim t, PEvalNumTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  NegNumTerm ::
-    (SupportedPrim t, PEvalNumTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    Term t
-  MulNumTerm ::
-    (SupportedPrim t, PEvalNumTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  AbsNumTerm ::
-    (SupportedPrim t, PEvalNumTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    Term t
-  SignumNumTerm ::
-    (SupportedPrim t, PEvalNumTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    Term t
-  LtOrdTerm ::
-    (SupportedPrim t, PEvalOrdTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term Bool
-  LeOrdTerm ::
-    (SupportedPrim t, PEvalOrdTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term Bool
-  AndBitsTerm ::
-    (SupportedPrim t, PEvalBitwiseTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  OrBitsTerm ::
-    (SupportedPrim t, PEvalBitwiseTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  XorBitsTerm ::
-    (SupportedPrim t, PEvalBitwiseTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  ComplementBitsTerm ::
-    (SupportedPrim t, PEvalBitwiseTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    Term t
-  ShiftLeftTerm ::
-    (SupportedPrim t, PEvalShiftTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  ShiftRightTerm ::
-    (SupportedPrim t, PEvalShiftTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  RotateLeftTerm ::
-    (SupportedPrim t, PEvalRotateTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  RotateRightTerm ::
-    (SupportedPrim t, PEvalRotateTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  BitCastTerm ::
-    (SupportedPrim b, PEvalBitCastTerm a b) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term a) ->
-    Term b
-  BitCastOrTerm ::
-    (SupportedPrim b, PEvalBitCastOrTerm a b) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term b) ->
-    !(Term a) ->
-    Term b
-  BVConcatTerm ::
-    ( PEvalBVTerm bv,
-      KnownNat l,
-      KnownNat r,
-      KnownNat (l + r),
-      1 <= l,
-      1 <= r,
-      1 <= l + r,
-      SupportedPrim (bv (l + r))
-    ) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term (bv l)) ->
-    !(Term (bv r)) ->
-    Term (bv (l + r))
-  BVSelectTerm ::
-    ( PEvalBVTerm bv,
-      KnownNat n,
-      KnownNat ix,
-      KnownNat w,
-      1 <= n,
-      1 <= w,
-      ix + w <= n,
-      SupportedPrim (bv w)
-    ) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Proxy ix) ->
-    !(Proxy w) ->
-    !(Term (bv n)) ->
-    Term (bv w)
-  BVExtendTerm ::
-    ( PEvalBVTerm bv,
-      KnownNat l,
-      KnownNat r,
-      1 <= l,
-      1 <= r,
-      l <= r,
-      SupportedPrim (bv r)
-    ) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !Bool ->
-    !(Proxy r) ->
-    !(Term (bv l)) ->
-    Term (bv r)
-  ApplyTerm ::
-    (PEvalApplyTerm f a b, SupportedPrim b) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term f) ->
-    !(Term a) ->
-    Term b
-  DivIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  ModIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  QuotIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  RemIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  FPTraitTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !FPTrait ->
-    !(Term (FP eb sb)) ->
-    Term Bool
-  FdivTerm ::
-    (SupportedPrim t, PEvalFractionalTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  RecipTerm ::
-    (SupportedPrim t, PEvalFractionalTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    Term t
-  FloatingUnaryTerm ::
-    (SupportedPrim t, PEvalFloatingTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !FloatingUnaryOp ->
-    !(Term t) ->
-    Term t
-  PowerTerm ::
-    (SupportedPrim t, PEvalFloatingTerm t) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term t) ->
-    !(Term t) ->
-    Term t
-  FPUnaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !FPUnaryOp ->
-    !(Term (FP eb sb)) ->
-    Term (FP eb sb)
-  FPBinaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !FPBinaryOp ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    Term (FP eb sb)
-  FPRoundingUnaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !FPRoundingUnaryOp ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    Term (FP eb sb)
-  FPRoundingBinaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !FPRoundingBinaryOp ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    Term (FP eb sb)
-  FPFMATerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    Term (FP eb sb)
-  FromIntegralTerm ::
-    (PEvalFromIntegralTerm a b, SupportedPrim b) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term a) ->
-    Term b
-  FromFPOrTerm ::
-    ( PEvalIEEEFPConvertibleTerm a,
-      ValidFP eb sb,
-      SupportedPrim a
-    ) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term a) ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    Term a
-  ToFPTerm ::
-    ( PEvalIEEEFPConvertibleTerm a,
-      ValidFP eb sb,
-      SupportedPrim (FP eb sb)
-    ) =>
-    WeakThreadId ->
-    {-# UNPACK #-} !Digest ->
-    Id ->
-    Ident ->
-    !(Term FPRoundingMode) ->
-    !(Term a) ->
-    Proxy eb ->
-    Proxy sb ->
-    Term (FP eb sb)
-
--- | Pattern for term with dynamic typing.
-pattern DynTerm :: forall a b. (SupportedPrim a) => Term a -> Term b
-pattern DynTerm x <-
-  ( ( \v ->
-        introSupportedPrimConstraint v $
-          withSupportedPrimTypeable @a $
-            cast v
-    ) ->
-      Just x
-    )
-
--- | The identity of the term.
-termIdent :: Term t -> Ident
-termIdent (ConTerm _ _ _ i _) = i
-termIdent (SymTerm _ _ _ i _) = i
-termIdent (ForallTerm _ _ _ i _ _) = i
-termIdent (ExistsTerm _ _ _ i _ _) = i
-termIdent (NotTerm _ _ _ i _) = i
-termIdent (OrTerm _ _ _ i _ _) = i
-termIdent (AndTerm _ _ _ i _ _) = i
-termIdent (EqTerm _ _ _ i _ _) = i
-termIdent (DistinctTerm _ _ _ i _) = i
-termIdent (ITETerm _ _ _ i _ _ _) = i
-termIdent (AddNumTerm _ _ _ i _ _) = i
-termIdent (NegNumTerm _ _ _ i _) = i
-termIdent (MulNumTerm _ _ _ i _ _) = i
-termIdent (AbsNumTerm _ _ _ i _) = i
-termIdent (SignumNumTerm _ _ _ i _) = i
-termIdent (LtOrdTerm _ _ _ i _ _) = i
-termIdent (LeOrdTerm _ _ _ i _ _) = i
-termIdent (AndBitsTerm _ _ _ i _ _) = i
-termIdent (OrBitsTerm _ _ _ i _ _) = i
-termIdent (XorBitsTerm _ _ _ i _ _) = i
-termIdent (ComplementBitsTerm _ _ _ i _) = i
-termIdent (ShiftLeftTerm _ _ _ i _ _) = i
-termIdent (ShiftRightTerm _ _ _ i _ _) = i
-termIdent (RotateLeftTerm _ _ _ i _ _) = i
-termIdent (RotateRightTerm _ _ _ i _ _) = i
-termIdent (BitCastTerm _ _ _ i _) = i
-termIdent (BitCastOrTerm _ _ _ i _ _) = i
-termIdent (BVConcatTerm _ _ _ i _ _) = i
-termIdent (BVSelectTerm _ _ _ i _ _ _) = i
-termIdent (BVExtendTerm _ _ _ i _ _ _) = i
-termIdent (ApplyTerm _ _ _ i _ _) = i
-termIdent (DivIntegralTerm _ _ _ i _ _) = i
-termIdent (ModIntegralTerm _ _ _ i _ _) = i
-termIdent (QuotIntegralTerm _ _ _ i _ _) = i
-termIdent (RemIntegralTerm _ _ _ i _ _) = i
-termIdent (FPTraitTerm _ _ _ i _ _) = i
-termIdent (FdivTerm _ _ _ i _ _) = i
-termIdent (RecipTerm _ _ _ i _) = i
-termIdent (FloatingUnaryTerm _ _ _ i _ _) = i
-termIdent (PowerTerm _ _ _ i _ _) = i
-termIdent (FPUnaryTerm _ _ _ i _ _) = i
-termIdent (FPBinaryTerm _ _ _ i _ _ _) = i
-termIdent (FPRoundingUnaryTerm _ _ _ i _ _ _) = i
-termIdent (FPRoundingBinaryTerm _ _ _ i _ _ _ _) = i
-termIdent (FPFMATerm _ _ _ i _ _ _ _) = i
-termIdent (FromIntegralTerm _ _ _ i _) = i
-termIdent (FromFPOrTerm _ _ _ i _ _ _) = i
-termIdent (ToFPTerm _ _ _ i _ _ _ _) = i
-{-# INLINE termIdent #-}
-
--- | Return the ID of a term.
-termId :: Term t -> Id
-termId t = case hashId t of
-  HashId _ i -> i
-{-# INLINE termId #-}
-
-baseHash :: Term t -> Digest
-baseHash t = case hashId t of
-  HashId h _ -> h
-{-# INLINE baseHash #-}
-
-data HashId = HashId {-# UNPACK #-} !Digest Id deriving (Show)
-
-instance Eq HashId where
-  HashId _ l == HashId _ r = l == r
-  {-# INLINE (==) #-}
-
-instance Hashable HashId where
-  hashWithSalt s (HashId i _) = hashWithSalt s i
-  {-# INLINE hashWithSalt #-}
-
-eqHashId :: HashId -> HashId -> Bool
-eqHashId = (==)
-{-# INLINE eqHashId #-}
-
-data TypeHashId = TypeHashId {-# UNPACK #-} !Fingerprint {-# UNPACK #-} !HashId
-  deriving (Show)
-
-instance Eq TypeHashId where
-  TypeHashId l li == TypeHashId r ri = l == r && li == ri
-  {-# INLINE (==) #-}
-
-instance Hashable TypeHashId where
-  hashWithSalt s (TypeHashId tp i) = s `hashWithSalt` tp `hashWithSalt` i
-  {-# INLINE hashWithSalt #-}
-
-hashId :: Term t -> HashId
-hashId t = case typeHashId t of
-  TypeHashId _ hi -> hi
-{-# INLINE hashId #-}
-
-typeFingerprint :: forall t. (SupportedPrim t) => Fingerprint
-typeFingerprint = typeRepFingerprint $ SomeTypeRep $ primTypeRep @t
-{-# INLINE typeFingerprint #-}
-
--- | Return the ID and the type representation of a term.
-typeHashId :: forall t. Term t -> TypeHashId
-typeHashId (ConTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (SymTerm _ ha i _ TypedSymbol {}) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ForallTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ExistsTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (NotTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (OrTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (AndTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (EqTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (DistinctTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ITETerm _ ha i _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (AddNumTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (NegNumTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (MulNumTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (AbsNumTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (SignumNumTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (LtOrdTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (LeOrdTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (AndBitsTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (OrBitsTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (XorBitsTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ComplementBitsTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ShiftLeftTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ShiftRightTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (RotateLeftTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (RotateRightTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (BitCastTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (BitCastOrTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (BVConcatTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (BVSelectTerm _ ha i _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (BVExtendTerm _ ha i _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ApplyTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (DivIntegralTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ModIntegralTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (QuotIntegralTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (RemIntegralTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FPTraitTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FdivTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (RecipTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FloatingUnaryTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (PowerTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FPUnaryTerm _ ha i _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FPBinaryTerm _ ha i _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FPRoundingUnaryTerm _ ha i _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FPRoundingBinaryTerm _ ha i _ _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FPFMATerm _ ha i _ _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FromIntegralTerm _ ha i _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (FromFPOrTerm _ ha i _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-typeHashId (ToFPTerm _ ha i _ _ _ _ _) = TypeHashId (typeFingerprint @t) $ HashId ha i
-
--- {-# NOINLINE typeHashId #-}
-
-introSupportedPrimConstraint0 :: forall t a. Term t -> ((SupportedPrim t) => a) -> a
-introSupportedPrimConstraint0 ConTerm {} x = x
-introSupportedPrimConstraint0 (SymTerm _ _ _ _ t) x = withSymbolSupported t x
-introSupportedPrimConstraint0 ForallTerm {} x = x
-introSupportedPrimConstraint0 ExistsTerm {} x = x
-introSupportedPrimConstraint0 NotTerm {} x = x
-introSupportedPrimConstraint0 OrTerm {} x = x
-introSupportedPrimConstraint0 AndTerm {} x = x
-introSupportedPrimConstraint0 EqTerm {} x = x
-introSupportedPrimConstraint0 DistinctTerm {} x = x
-introSupportedPrimConstraint0 ITETerm {} x = x
-introSupportedPrimConstraint0 AddNumTerm {} x = x
-introSupportedPrimConstraint0 NegNumTerm {} x = x
-introSupportedPrimConstraint0 MulNumTerm {} x = x
-introSupportedPrimConstraint0 AbsNumTerm {} x = x
-introSupportedPrimConstraint0 SignumNumTerm {} x = x
-introSupportedPrimConstraint0 LtOrdTerm {} x = x
-introSupportedPrimConstraint0 LeOrdTerm {} x = x
-introSupportedPrimConstraint0 AndBitsTerm {} x = x
-introSupportedPrimConstraint0 OrBitsTerm {} x = x
-introSupportedPrimConstraint0 XorBitsTerm {} x = x
-introSupportedPrimConstraint0 ComplementBitsTerm {} x = x
-introSupportedPrimConstraint0 ShiftLeftTerm {} x = x
-introSupportedPrimConstraint0 RotateLeftTerm {} x = x
-introSupportedPrimConstraint0 ShiftRightTerm {} x = x
-introSupportedPrimConstraint0 RotateRightTerm {} x = x
-introSupportedPrimConstraint0 BitCastTerm {} x = x
-introSupportedPrimConstraint0 BitCastOrTerm {} x = x
-introSupportedPrimConstraint0 BVConcatTerm {} x = x
-introSupportedPrimConstraint0 BVSelectTerm {} x = x
-introSupportedPrimConstraint0 BVExtendTerm {} x = x
-introSupportedPrimConstraint0 ApplyTerm {} x = x
-introSupportedPrimConstraint0 DivIntegralTerm {} x = x
-introSupportedPrimConstraint0 ModIntegralTerm {} x = x
-introSupportedPrimConstraint0 QuotIntegralTerm {} x = x
-introSupportedPrimConstraint0 RemIntegralTerm {} x = x
-introSupportedPrimConstraint0 FPTraitTerm {} x = x
-introSupportedPrimConstraint0 FdivTerm {} x = x
-introSupportedPrimConstraint0 RecipTerm {} x = x
-introSupportedPrimConstraint0 FloatingUnaryTerm {} x = x
-introSupportedPrimConstraint0 PowerTerm {} x = x
-introSupportedPrimConstraint0 FPUnaryTerm {} x = x
-introSupportedPrimConstraint0 FPBinaryTerm {} x = x
-introSupportedPrimConstraint0 FPRoundingUnaryTerm {} x = x
-introSupportedPrimConstraint0 FPRoundingBinaryTerm {} x = x
-introSupportedPrimConstraint0 FPFMATerm {} x = x
-introSupportedPrimConstraint0 FromIntegralTerm {} x = x
-introSupportedPrimConstraint0 FromFPOrTerm {} x = x
-introSupportedPrimConstraint0 ToFPTerm {} x = x
-
--- | Introduce the 'SupportedPrim' constraint from a term.
-introSupportedPrimConstraint ::
-  forall t a. Term t -> ((SupportedPrim t, Typeable t) => a) -> a
-introSupportedPrimConstraint t a =
-  introSupportedPrimConstraint0 t $ withSupportedPrimTypeable @t $ a
-{-# INLINE introSupportedPrimConstraint #-}
-
--- | Introduce the 'Typeable' constraint from 'SupportedPrim'.
-withSupportedPrimTypeable ::
-  forall a b. (SupportedPrim a) => ((Typeable a) => b) -> b
-withSupportedPrimTypeable = withTypeable (primTypeRep @a)
-{-# INLINE withSupportedPrimTypeable #-}
-
--- {-# INLINE introSupportedPrimConstraint #-}
-
--- | Pretty-print a term.
-pformatTerm :: forall t. Term t -> String
-pformatTerm (ConTerm _ _ _ _ t) = pformatCon t
-pformatTerm (SymTerm _ _ _ _ sym) = showUntyped sym
-pformatTerm (ForallTerm _ _ _ _ sym arg) = "(forall " ++ show sym ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (ExistsTerm _ _ _ _ sym arg) = "(exists " ++ show sym ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (NotTerm _ _ _ _ arg) = "(! " ++ pformatTerm arg ++ ")"
-pformatTerm (OrTerm _ _ _ _ arg1 arg2) = "(|| " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (AndTerm _ _ _ _ arg1 arg2) = "(&& " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (EqTerm _ _ _ _ arg1 arg2) = "(= " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (DistinctTerm _ _ _ _ args) = "(distinct " ++ unwords (map pformatTerm $ toList args) ++ ")"
-pformatTerm (ITETerm _ _ _ _ cond arg1 arg2) = "(ite " ++ pformatTerm cond ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (AddNumTerm _ _ _ _ arg1 arg2) = "(+ " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (NegNumTerm _ _ _ _ arg) = "(- " ++ pformatTerm arg ++ ")"
-pformatTerm (MulNumTerm _ _ _ _ arg1 arg2) = "(* " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (AbsNumTerm _ _ _ _ arg) = "(abs " ++ pformatTerm arg ++ ")"
-pformatTerm (SignumNumTerm _ _ _ _ arg) = "(signum " ++ pformatTerm arg ++ ")"
-pformatTerm (LtOrdTerm _ _ _ _ arg1 arg2) = "(< " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (LeOrdTerm _ _ _ _ arg1 arg2) = "(<= " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (AndBitsTerm _ _ _ _ arg1 arg2) = "(& " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (OrBitsTerm _ _ _ _ arg1 arg2) = "(| " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (XorBitsTerm _ _ _ _ arg1 arg2) = "(^ " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (ComplementBitsTerm _ _ _ _ arg) = "(~ " ++ pformatTerm arg ++ ")"
-pformatTerm (ShiftLeftTerm _ _ _ _ arg n) = "(shl " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
-pformatTerm (ShiftRightTerm _ _ _ _ arg n) = "(shr " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
-pformatTerm (RotateLeftTerm _ _ _ _ arg n) = "(rotl " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
-pformatTerm (RotateRightTerm _ _ _ _ arg n) = "(rotr " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
-pformatTerm (BitCastTerm _ _ _ _ arg) = "(bitcast " ++ pformatTerm arg ++ ")"
-pformatTerm (BitCastOrTerm _ _ _ _ d arg) = "(bitcast_or " ++ pformatTerm d ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (BVConcatTerm _ _ _ _ arg1 arg2) = "(bvconcat " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (BVSelectTerm _ _ _ _ (_ :: Proxy ix) (_ :: Proxy w) arg) =
-  "(bvselect " ++ show (typeRep @ix) ++ " " ++ show (typeRep @w) ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (BVExtendTerm _ _ _ _ signed (_ :: Proxy n) arg) =
-  (if signed then "(bvsext " else "(bvzext ") ++ show (typeRep @n) ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (ApplyTerm _ _ _ _ func arg) = "(apply " ++ pformatTerm func ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (DivIntegralTerm _ _ _ _ arg1 arg2) = "(div " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (ModIntegralTerm _ _ _ _ arg1 arg2) = "(mod " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (QuotIntegralTerm _ _ _ _ arg1 arg2) = "(quot " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (RemIntegralTerm _ _ _ _ arg1 arg2) = "(rem " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (FPTraitTerm _ _ _ _ trait arg) = "(" ++ show trait ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (FdivTerm _ _ _ _ arg1 arg2) = "(fdiv " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (RecipTerm _ _ _ _ arg) = "(recip " ++ pformatTerm arg ++ ")"
-pformatTerm (FloatingUnaryTerm _ _ _ _ op arg) = "(" ++ show op ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (PowerTerm _ _ _ _ arg1 arg2) = "(** " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (FPUnaryTerm _ _ _ _ op arg) = "(" ++ show op ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (FPBinaryTerm _ _ _ _ op arg1 arg2) = "(" ++ show op ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (FPRoundingUnaryTerm _ _ _ _ op mode arg) = "(" ++ show op ++ " " ++ pformatTerm mode ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (FPRoundingBinaryTerm _ _ _ _ op mode arg1 arg2) =
-  "(" ++ show op ++ " " ++ pformatTerm mode ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
-pformatTerm (FPFMATerm _ _ _ _ mode arg1 arg2 arg3) =
-  "(fp.fma " ++ pformatTerm mode ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ " " ++ pformatTerm arg3 ++ ")"
-pformatTerm (FromIntegralTerm _ _ _ _ arg) = "(from_integral " ++ pformatTerm arg ++ ")"
-pformatTerm (FromFPOrTerm _ _ _ _ d r arg) = "(from_fp_or " ++ pformatTerm d ++ " " ++ pformatTerm r ++ " " ++ pformatTerm arg ++ ")"
-pformatTerm (ToFPTerm _ _ _ _ r arg _ _) = "(to_fp " ++ pformatTerm r ++ " " ++ pformatTerm arg ++ ")"
-
--- {-# INLINE pformatTerm #-}
-
-instance NFData (Term a) where
-  rnf i = rnf (termId i) `seq` rnf (termIdent i)
-  {-# INLINE rnf #-}
-
-#if MIN_VERSION_base(4,15,0)
-type CODE x = forall qq. Quote qq => Code qq (x)
-#else
-type CODE x = TExpQ x
-#endif
-
-instance Lift (Term t) where
-  liftTyped (ConTerm _ _ _ _ v) = [||conTerm v||]
-  liftTyped (SymTerm _ _ _ _ t) = [||symTerm t||]
-  liftTyped (ForallTerm _ _ _ _ t1 t2) = [||forallTerm t1 t2||]
-  liftTyped (ExistsTerm _ _ _ _ t1 t2) = [||existsTerm t1 t2||]
-  liftTyped (NotTerm _ _ _ _ t) = [||notTerm t||]
-  liftTyped (OrTerm _ _ _ _ t1 t2) = [||orTerm t1 t2||]
-  liftTyped (AndTerm _ _ _ _ t1 t2) = [||andTerm t1 t2||]
-  liftTyped (EqTerm _ _ _ _ t1 t2) = [||eqTerm t1 t2||]
-  liftTyped (DistinctTerm _ _ _ _ t) = [||distinctTerm t||]
-  liftTyped (ITETerm _ _ _ _ t1 t2 t3) = [||iteTerm t1 t2 t3||]
-  liftTyped (AddNumTerm _ _ _ _ t1 t2) = [||addNumTerm t1 t2||]
-  liftTyped (NegNumTerm _ _ _ _ t) = [||negNumTerm t||]
-  liftTyped (MulNumTerm _ _ _ _ t1 t2) = [||mulNumTerm t1 t2||]
-  liftTyped (AbsNumTerm _ _ _ _ t) = [||absNumTerm t||]
-  liftTyped (SignumNumTerm _ _ _ _ t) = [||signumNumTerm t||]
-  liftTyped (LtOrdTerm _ _ _ _ t1 t2) = [||ltOrdTerm t1 t2||]
-  liftTyped (LeOrdTerm _ _ _ _ t1 t2) = [||leOrdTerm t1 t2||]
-  liftTyped (AndBitsTerm _ _ _ _ t1 t2) = [||andBitsTerm t1 t2||]
-  liftTyped (OrBitsTerm _ _ _ _ t1 t2) = [||orBitsTerm t1 t2||]
-  liftTyped (XorBitsTerm _ _ _ _ t1 t2) = [||xorBitsTerm t1 t2||]
-  liftTyped (ComplementBitsTerm _ _ _ _ t) = [||complementBitsTerm t||]
-  liftTyped (ShiftLeftTerm _ _ _ _ t1 t2) = [||shiftLeftTerm t1 t2||]
-  liftTyped (ShiftRightTerm _ _ _ _ t1 t2) = [||shiftRightTerm t1 t2||]
-  liftTyped (RotateLeftTerm _ _ _ _ t1 t2) = [||rotateLeftTerm t1 t2||]
-  liftTyped (RotateRightTerm _ _ _ _ t1 t2) = [||rotateRightTerm t1 t2||]
-  liftTyped (BitCastTerm _ _ _ _ t) = [||bitCastTerm t||]
-  liftTyped (BitCastOrTerm _ _ _ _ t1 t2) = [||bitCastOrTerm t1 t2||]
-  liftTyped (BVConcatTerm _ _ _ _ t1 t2) = [||bvConcatTerm t1 t2||]
-  liftTyped (BVSelectTerm _ _ _ _ (_ :: p ix) (_ :: q w) t3) =
-    let pix = [||Proxy||] :: CODE (Proxy ix)
-        pw = [||Proxy||] :: CODE (Proxy w)
-     in [||bvSelectTerm $$pix $$pw t3||]
-  liftTyped (BVExtendTerm _ _ _ _ b (_ :: p r) t2) =
-    let pr = [||Proxy||] :: CODE (Proxy r)
-     in [||bvExtendTerm b $$pr t2||]
-  liftTyped (ApplyTerm _ _ _ _ t1 t2) = [||applyTerm t1 t2||]
-  liftTyped (DivIntegralTerm _ _ _ _ t1 t2) = [||divIntegralTerm t1 t2||]
-  liftTyped (ModIntegralTerm _ _ _ _ t1 t2) = [||modIntegralTerm t1 t2||]
-  liftTyped (QuotIntegralTerm _ _ _ _ t1 t2) = [||quotIntegralTerm t1 t2||]
-  liftTyped (RemIntegralTerm _ _ _ _ t1 t2) = [||remIntegralTerm t1 t2||]
-  liftTyped (FPTraitTerm _ _ _ _ t1 t2) = [||fpTraitTerm t1 t2||]
-  liftTyped (FdivTerm _ _ _ _ t1 t2) = [||fdivTerm t1 t2||]
-  liftTyped (RecipTerm _ _ _ _ t) = [||recipTerm t||]
-  liftTyped (FloatingUnaryTerm _ _ _ _ t1 t2) = [||floatingUnaryTerm t1 t2||]
-  liftTyped (PowerTerm _ _ _ _ t1 t2) = [||powerTerm t1 t2||]
-  liftTyped (FPUnaryTerm _ _ _ _ t1 t2) = [||fpUnaryTerm t1 t2||]
-  liftTyped (FPBinaryTerm _ _ _ _ t1 t2 t3) = [||fpBinaryTerm t1 t2 t3||]
-  liftTyped (FPRoundingUnaryTerm _ _ _ _ t1 t2 t3) =
-    [||fpRoundingUnaryTerm t1 t2 t3||]
-  liftTyped (FPRoundingBinaryTerm _ _ _ _ t1 t2 t3 t4) =
-    [||fpRoundingBinaryTerm t1 t2 t3 t4||]
-  liftTyped (FPFMATerm _ _ _ _ t1 t2 t3 t4) = [||fpFMATerm t1 t2 t3 t4||]
-  liftTyped (FromIntegralTerm _ _ _ _ t) = [||fromIntegralTerm t||]
-  liftTyped (FromFPOrTerm _ _ _ _ t1 t2 t3) = [||fromFPOrTerm t1 t2 t3||]
-  liftTyped (ToFPTerm _ _ _ _ t1 t2 _ _) =
-    [||toFPTerm t1 t2||]
-
-instance Show (Term ty) where
-  show (ConTerm tid _ i _ v) =
-    "ConTerm{tid=" ++ show tid ++ ", id=" ++ show i ++ ", v=" ++ pformatCon v ++ "}"
-  show (SymTerm tid _ i _ name@TypedSymbol {}) =
-    "SymTerm{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", name="
-      ++ show name
-      ++ ", type="
-      ++ show (primTypeRep @ty)
-      ++ "}"
-  show (ForallTerm tid _ i _ sym arg) =
-    "Forall{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", sym="
-      ++ show sym
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (ExistsTerm tid _ i _ sym arg) =
-    "Exists{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", sym="
-      ++ show sym
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (NotTerm tid _ i _ arg) =
-    "Not{tid=" ++ show tid ++ ", id=" ++ show i ++ ", arg=" ++ show arg ++ "}"
-  show (OrTerm tid _ i _ arg1 arg2) =
-    "Or{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (AndTerm tid _ i _ arg1 arg2) =
-    "And{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (EqTerm tid _ i _ arg1 arg2) =
-    "Eqv{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (DistinctTerm tid _ i _ args) =
-    "Distinct{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", args="
-      ++ show args
-      ++ "}"
-  show (ITETerm tid _ i _ cond l r) =
-    "ITE{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", cond="
-      ++ show cond
-      ++ ", then="
-      ++ show l
-      ++ ", else="
-      ++ show r
-      ++ "}"
-  show (AddNumTerm tid _ i _ arg1 arg2) =
-    "AddNum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (NegNumTerm tid _ i _ arg) =
-    "NegNum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (MulNumTerm tid _ i _ arg1 arg2) =
-    "MulNum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (AbsNumTerm tid _ i _ arg) =
-    "AbsNum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (SignumNumTerm tid _ i _ arg) =
-    "SignumNum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (LtOrdTerm tid _ i _ arg1 arg2) =
-    "LTNum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (LeOrdTerm tid _ i _ arg1 arg2) =
-    "LENum{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (AndBitsTerm tid _ i _ arg1 arg2) =
-    "AndBits{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (OrBitsTerm tid _ i _ arg1 arg2) =
-    "OrBits{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (XorBitsTerm tid _ i _ arg1 arg2) =
-    "XorBits{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (ComplementBitsTerm tid _ i _ arg) =
-    "ComplementBits{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (ShiftLeftTerm tid _ i _ arg n) =
-    "ShiftLeft{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ ", n="
-      ++ show n
-      ++ "}"
-  show (ShiftRightTerm tid _ i _ arg n) =
-    "ShiftRight{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ ", n="
-      ++ show n
-      ++ "}"
-  show (RotateLeftTerm tid _ i _ arg n) =
-    "RotateLeft{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ ", n="
-      ++ show n
-      ++ "}"
-  show (RotateRightTerm tid _ i _ arg n) =
-    "RotateRight{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ ", n="
-      ++ show n
-      ++ "}"
-  show (BitCastTerm tid _ i _ arg) =
-    "BitCast{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (BitCastOrTerm tid _ i _ d arg) =
-    "BitCastOr{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", default="
-      ++ show d
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (BVConcatTerm tid _ i _ arg1 arg2) =
-    "BVConcat{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (BVSelectTerm tid _ i _ ix w arg) =
-    "BVSelect{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", ix="
-      ++ show ix
-      ++ ", w="
-      ++ show w
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (BVExtendTerm tid _ i _ signed n arg) =
-    "BVExtend{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", signed="
-      ++ show signed
-      ++ ", n="
-      ++ show n
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (ApplyTerm tid _ i _ f arg) =
-    "Apply{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", f="
-      ++ show f
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (DivIntegralTerm tid _ i _ arg1 arg2) =
-    "DivIntegral{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (ModIntegralTerm tid _ i _ arg1 arg2) =
-    "ModIntegral{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (QuotIntegralTerm tid _ i _ arg1 arg2) =
-    "QuotIntegral{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (RemIntegralTerm tid _ i _ arg1 arg2) =
-    "RemIntegral{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (FPTraitTerm tid _ i _ trait arg) =
-    "FPTrait{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", trait="
-      ++ show trait
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (FdivTerm tid _ i _ arg1 arg2) =
-    "Fdiv{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (RecipTerm tid _ i _ arg) =
-    "Recip{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (FloatingUnaryTerm tid _ i _ op arg) =
-    "FloatingUnary{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", op="
-      ++ show op
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (PowerTerm tid _ i _ arg1 arg2) =
-    "Power{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (FPUnaryTerm tid _ i _ op arg) =
-    "FPUnary{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", op="
-      ++ show op
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (FPBinaryTerm tid _ i _ op arg1 arg2) =
-    "FPBinary{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", op="
-      ++ show op
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (FPRoundingUnaryTerm tid _ i _ op mode arg) =
-    "FPRoundingUnary{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", op="
-      ++ show op
-      ++ ", mode="
-      ++ show mode
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (FPRoundingBinaryTerm tid _ i _ op mode arg1 arg2) =
-    "FPRoundingBinary{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", op="
-      ++ show op
-      ++ ", mode="
-      ++ show mode
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ "}"
-  show (FPFMATerm tid _ i _ mode arg1 arg2 arg3) =
-    "FPFMA{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", mode="
-      ++ show mode
-      ++ ", arg1="
-      ++ show arg1
-      ++ ", arg2="
-      ++ show arg2
-      ++ ", arg3="
-      ++ show arg3
-      ++ "}"
-  show (FromIntegralTerm tid _ i _ arg) =
-    "FromIntegral{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (FromFPOrTerm tid _ i _ d mode arg) =
-    "FromFPTerm{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", default="
-      ++ show d
-      ++ ", mode="
-      ++ show mode
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-  show (ToFPTerm tid _ i _ mode arg _ _) =
-    "ToFPTerm{tid="
-      ++ show tid
-      ++ ", id="
-      ++ show i
-      ++ ", mode="
-      ++ show mode
-      ++ ", arg="
-      ++ show arg
-      ++ "}"
-
--- {-# INLINE show #-}
-
--- | Pretty-print a term, possibly eliding parts of it.
-prettyPrintTerm :: Term t -> Doc ann
-prettyPrintTerm v =
-  column
-    ( \c ->
-        pageWidth $ \case
-          AvailablePerLine i r ->
-            if fromIntegral (c + len) > fromIntegral i * r
-              then "..."
-              else pretty formatted
-          Unbounded -> pretty formatted
-    )
-  where
-    formatted = introSupportedPrimConstraint v $ pformatTerm v
-    len = length formatted
-
-instance (SupportedPrim t) => Eq (Term t) where
-  a == b =
-    if threadId a == threadId b
-      then termId a == termId b
-      else unsafePerformIO $ do
-        tid <- myWeakThreadId
-        a' <- toCurThreadImpl tid a
-        b' <- toCurThreadImpl tid b
-        return $ a' == b'
-
-instance (SupportedPrim t) => Hashable (Term t) where
-  hashWithSalt s t = hashWithSalt s $ baseHash t
-  {-# INLINE hashWithSalt #-}
-
--- | Term without identity (before internalizing).
-data UTerm t where
-  UConTerm :: (SupportedPrim t) => !t -> UTerm t
-  USymTerm :: !(TypedSymbol 'AnyKind t) -> UTerm t
-  UForallTerm ::
-    !(TypedSymbol 'ConstantKind t) ->
-    !(Term Bool) ->
-    UTerm Bool
-  UExistsTerm ::
-    !(TypedSymbol 'ConstantKind t) ->
-    !(Term Bool) ->
-    UTerm Bool
-  UNotTerm :: !(Term Bool) -> UTerm Bool
-  UOrTerm :: !(Term Bool) -> !(Term Bool) -> UTerm Bool
-  UAndTerm :: !(Term Bool) -> !(Term Bool) -> UTerm Bool
-  UEqTerm :: !(Term t) -> !(Term t) -> UTerm Bool
-  UDistinctTerm :: !(NonEmpty (Term t)) -> UTerm Bool
-  UITETerm ::
-    (SupportedPrim t) =>
-    !(Term Bool) ->
-    !(Term t) ->
-    !(Term t) ->
-    UTerm t
-  UAddNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UNegNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> UTerm t
-  UMulNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UAbsNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> UTerm t
-  USignumNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> UTerm t
-  ULtOrdTerm :: (SupportedPrim t, PEvalOrdTerm t) => !(Term t) -> !(Term t) -> UTerm Bool
-  ULeOrdTerm :: (SupportedPrim t, PEvalOrdTerm t) => !(Term t) -> !(Term t) -> UTerm Bool
-  UAndBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UOrBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UXorBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UComplementBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> UTerm t
-  UShiftLeftTerm ::
-    (SupportedPrim t, PEvalShiftTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UShiftRightTerm ::
-    (SupportedPrim t, PEvalShiftTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  URotateLeftTerm ::
-    (SupportedPrim t, PEvalRotateTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  URotateRightTerm ::
-    (SupportedPrim t, PEvalRotateTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UBitCastTerm ::
-    (SupportedPrim b, PEvalBitCastTerm a b) =>
-    !(Term a) ->
-    UTerm b
-  UBitCastOrTerm ::
-    (SupportedPrim b, PEvalBitCastOrTerm a b) =>
-    !(Term b) ->
-    !(Term a) ->
-    UTerm b
-  UBVConcatTerm ::
-    ( PEvalBVTerm bv,
-      KnownNat l,
-      KnownNat r,
-      KnownNat (l + r),
-      1 <= l,
-      1 <= r,
-      1 <= l + r,
-      SupportedPrim (bv (l + r))
-    ) =>
-    !(Term (bv l)) ->
-    !(Term (bv r)) ->
-    UTerm (bv (l + r))
-  UBVSelectTerm ::
-    ( PEvalBVTerm bv,
-      KnownNat n,
-      KnownNat ix,
-      KnownNat w,
-      1 <= n,
-      1 <= w,
-      ix + w <= n,
-      SupportedPrim (bv w)
-    ) =>
-    !(Proxy ix) ->
-    !(Proxy w) ->
-    !(Term (bv n)) ->
-    UTerm (bv w)
-  UBVExtendTerm ::
-    ( PEvalBVTerm bv,
-      KnownNat l,
-      KnownNat r,
-      1 <= l,
-      1 <= r,
-      l <= r,
-      SupportedPrim (bv r)
-    ) =>
-    !Bool ->
-    !(Proxy r) ->
-    !(Term (bv l)) ->
-    UTerm (bv r)
-  UApplyTerm ::
-    (PEvalApplyTerm f a b, SupportedPrim b) =>
-    Term f ->
-    Term a ->
-    UTerm b
-  UDivIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    !(Term t) ->
-    !(Term t) ->
-    UTerm t
-  UModIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    !(Term t) ->
-    !(Term t) ->
-    UTerm t
-  UQuotIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    !(Term t) ->
-    !(Term t) ->
-    UTerm t
-  URemIntegralTerm ::
-    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
-    !(Term t) ->
-    !(Term t) ->
-    UTerm t
-  UFPTraitTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    !FPTrait ->
-    !(Term (FP eb sb)) ->
-    UTerm Bool
-  UFdivTerm ::
-    (SupportedPrim t, PEvalFractionalTerm t) =>
-    !(Term t) ->
-    !(Term t) ->
-    UTerm t
-  URecipTerm :: (SupportedPrim t, PEvalFractionalTerm t) => !(Term t) -> UTerm t
-  UFloatingUnaryTerm ::
-    (SupportedPrim t, PEvalFloatingTerm t) =>
-    !FloatingUnaryOp ->
-    !(Term t) ->
-    UTerm t
-  UPowerTerm ::
-    (SupportedPrim t, PEvalFloatingTerm t) => !(Term t) -> !(Term t) -> UTerm t
-  UFPUnaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    !FPUnaryOp ->
-    !(Term (FP eb sb)) ->
-    UTerm (FP eb sb)
-  UFPBinaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    !FPBinaryOp ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    UTerm (FP eb sb)
-  UFPRoundingUnaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    !FPRoundingUnaryOp ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    UTerm (FP eb sb)
-  UFPRoundingBinaryTerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    !FPRoundingBinaryOp ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    UTerm (FP eb sb)
-  UFPFMATerm ::
-    (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    !(Term (FP eb sb)) ->
-    UTerm (FP eb sb)
-  UFromIntegralTerm ::
-    (PEvalFromIntegralTerm a b, SupportedPrim b) =>
-    !(Term a) ->
-    UTerm b
-  UFromFPOrTerm ::
-    ( PEvalIEEEFPConvertibleTerm a,
-      SupportedPrim a,
-      ValidFP eb sb
-    ) =>
-    Term a ->
-    !(Term FPRoundingMode) ->
-    !(Term (FP eb sb)) ->
-    UTerm a
-  UToFPTerm ::
-    ( PEvalIEEEFPConvertibleTerm a,
-      ValidFP eb sb,
-      SupportedPrim (FP eb sb)
-    ) =>
-    !(Term FPRoundingMode) ->
-    !(Term a) ->
-    Proxy eb ->
-    Proxy sb ->
-    UTerm (FP eb sb)
-
--- | Compare two t'TypedSymbol's for equality.
-eqHeteroSymbol :: forall ta a tb b. TypedSymbol ta a -> TypedSymbol tb b -> Bool
-eqHeteroSymbol (TypedSymbol taga) (TypedSymbol tagb) =
-  case eqTypeRep (primTypeRep @a) (primTypeRep @b) of
-    Just HRefl -> taga == tagb
-    Nothing -> False
-{-# INLINE eqHeteroSymbol #-}
-
-preHashConDescription :: (SupportedPrim t) => t -> Digest
-preHashConDescription = fromIntegral . hashConWithSalt 0
-{-# INLINE preHashConDescription #-}
-
-preHashSymDescription :: TypedSymbol 'AnyKind t -> Digest
-preHashSymDescription = fromIntegral . hashWithSalt 1
-{-# INLINE preHashSymDescription #-}
-
-preHashForallDescription ::
-  TypedSymbol 'ConstantKind t -> HashId -> Digest
-preHashForallDescription sym h =
-  fromIntegral
-    ( 2
-        `hashWithSalt` sym
-        `hashWithSalt` h
-    )
-{-# INLINE preHashForallDescription #-}
-
-preHashExistsDescription ::
-  TypedSymbol 'ConstantKind t -> HashId -> Digest
-preHashExistsDescription sym h =
-  fromIntegral
-    ( 3
-        `hashWithSalt` sym
-        `hashWithSalt` h
-    )
-{-# INLINE preHashExistsDescription #-}
-
-preHashNotDescription :: HashId -> Digest
-preHashNotDescription = fromIntegral . hashWithSalt 7
-{-# INLINE preHashNotDescription #-}
-
-preHashOrDescription :: HashId -> HashId -> Digest
-preHashOrDescription h1 h2 =
-  fromIntegral (8 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashOrDescription #-}
-
-preHashAndDescription :: HashId -> HashId -> Digest
-preHashAndDescription h1 h2 =
-  fromIntegral (9 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashAndDescription #-}
-
-preHashEqDescription :: Fingerprint -> HashId -> HashId -> Digest
-preHashEqDescription tp h1 h2 =
-  fromIntegral (10 `hashWithSalt` tp `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashEqDescription #-}
-
-preHashDistinctDescription :: Fingerprint -> NonEmpty HashId -> Digest
-preHashDistinctDescription tp hs =
-  fromIntegral (11 `hashWithSalt` tp `hashWithSalt` hs)
-{-# INLINE preHashDistinctDescription #-}
-
-preHashITEDescription :: HashId -> HashId -> HashId -> Digest
-preHashITEDescription h1 h2 h3 =
-  fromIntegral (12 `hashWithSalt` h1 `hashWithSalt` h2 `hashWithSalt` h3)
-{-# INLINE preHashITEDescription #-}
-
-preHashAddNumDescription :: HashId -> HashId -> Digest
-preHashAddNumDescription h1 h2 =
-  fromIntegral (13 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashAddNumDescription #-}
-
-preHashNegNumDescription :: HashId -> Digest
-preHashNegNumDescription =
-  fromIntegral . hashWithSalt 14
-{-# INLINE preHashNegNumDescription #-}
-
-preHashMulNumDescription :: HashId -> HashId -> Digest
-preHashMulNumDescription h1 h2 =
-  fromIntegral (15 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashMulNumDescription #-}
-
-preHashAbsNumDescription :: HashId -> Digest
-preHashAbsNumDescription = fromIntegral . hashWithSalt 16
-{-# INLINE preHashAbsNumDescription #-}
-
-preHashSignumNumDescription :: HashId -> Digest
-preHashSignumNumDescription = fromIntegral . hashWithSalt 17
-{-# INLINE preHashSignumNumDescription #-}
-
-preHashLtOrdDescription :: Fingerprint -> HashId -> HashId -> Digest
-preHashLtOrdDescription tp h1 h2 =
-  fromIntegral (18 `hashWithSalt` tp `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashLtOrdDescription #-}
-
-preHashLeOrdDescription :: Fingerprint -> HashId -> HashId -> Digest
-preHashLeOrdDescription tp h1 h2 =
-  fromIntegral (19 `hashWithSalt` tp `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashLeOrdDescription #-}
-
-preHashAndBitsDescription :: HashId -> HashId -> Digest
-preHashAndBitsDescription h1 h2 =
-  fromIntegral (20 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashAndBitsDescription #-}
-
-preHashOrBitsDescription :: HashId -> HashId -> Digest
-preHashOrBitsDescription h1 h2 =
-  fromIntegral (21 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashOrBitsDescription #-}
-
-preHashXorBitsDescription :: HashId -> HashId -> Digest
-preHashXorBitsDescription h1 h2 =
-  fromIntegral (22 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashXorBitsDescription #-}
-
-preHashComplementBitsDescription :: HashId -> Digest
-preHashComplementBitsDescription = fromIntegral . hashWithSalt 23
-{-# INLINE preHashComplementBitsDescription #-}
-
-preHashShiftLeftDescription :: HashId -> HashId -> Digest
-preHashShiftLeftDescription h1 h2 =
-  fromIntegral (24 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashShiftLeftDescription #-}
-
-preHashShiftRightDescription :: HashId -> HashId -> Digest
-preHashShiftRightDescription h1 h2 =
-  fromIntegral (25 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashShiftRightDescription #-}
-
-preHashRotateLeftDescription :: HashId -> HashId -> Digest
-preHashRotateLeftDescription h1 h2 =
-  fromIntegral (26 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashRotateLeftDescription #-}
-
-preHashRotateRightDescription :: HashId -> HashId -> Digest
-preHashRotateRightDescription h1 h2 =
-  fromIntegral (27 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashRotateRightDescription #-}
-
-preHashBVConcatDescription :: TypeHashId -> TypeHashId -> Digest
-preHashBVConcatDescription h1 h2 =
-  fromIntegral
-    ( 28
-        `hashWithSalt` h1
-        `hashWithSalt` h2
-    )
-
-preHashBVSelectDescription :: Fingerprint -> TypeHashId -> Digest
-preHashBVSelectDescription tp h =
-  fromIntegral (29 `hashWithSalt` tp `hashWithSalt` h)
-
-preHashBVExtendDescription :: Bool -> TypeHashId -> Digest
-preHashBVExtendDescription signed h =
-  fromIntegral (30 `hashWithSalt` signed `hashWithSalt` h)
-
-preHashBitCastDescription :: TypeHashId -> Digest
-preHashBitCastDescription = fromIntegral . hashWithSalt 31
-{-# INLINE preHashBitCastDescription #-}
-
-preHashBitCastOrDescription :: HashId -> TypeHashId -> Digest
-preHashBitCastOrDescription h1 h2 =
-  fromIntegral (32 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashBitCastOrDescription #-}
-
-preHashApplyDescription :: TypeHashId -> TypeHashId -> Digest
-preHashApplyDescription h1 h2 =
-  fromIntegral (33 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashApplyDescription #-}
-
-preHashDivIntegralDescription :: HashId -> HashId -> Digest
-preHashDivIntegralDescription h1 h2 =
-  fromIntegral (34 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashDivIntegralDescription #-}
-
-preHashModIntegralDescription :: HashId -> HashId -> Digest
-preHashModIntegralDescription h1 h2 =
-  fromIntegral (35 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashModIntegralDescription #-}
-
-preHashQuotIntegralDescription :: HashId -> HashId -> Digest
-preHashQuotIntegralDescription h1 h2 =
-  fromIntegral (36 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashQuotIntegralDescription #-}
-
-preHashRemIntegralDescription :: HashId -> HashId -> Digest
-preHashRemIntegralDescription h1 h2 =
-  fromIntegral (37 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashRemIntegralDescription #-}
-
-preHashFPTraitDescription :: FPTrait -> TypeHashId -> Digest
-preHashFPTraitDescription trait h =
-  fromIntegral (38 `hashWithSalt` trait `hashWithSalt` h)
-{-# INLINE preHashFPTraitDescription #-}
-
-preHashFdivDescription :: HashId -> HashId -> Digest
-preHashFdivDescription h1 h2 =
-  fromIntegral (39 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashFdivDescription #-}
-
-preHashRecipDescription :: HashId -> Digest
-preHashRecipDescription = fromIntegral . hashWithSalt 40
-{-# INLINE preHashRecipDescription #-}
-
-preHashFloatingUnaryDescription :: FloatingUnaryOp -> HashId -> Digest
-preHashFloatingUnaryDescription op h =
-  fromIntegral (41 `hashWithSalt` op `hashWithSalt` h)
-{-# INLINE preHashFloatingUnaryDescription #-}
-
-preHashPowerDescription :: HashId -> HashId -> Digest
-preHashPowerDescription h1 h2 =
-  fromIntegral (42 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashPowerDescription #-}
-
-preHashFPUnaryDescription :: FPUnaryOp -> HashId -> Digest
-preHashFPUnaryDescription op h =
-  fromIntegral (43 `hashWithSalt` op `hashWithSalt` h)
-{-# INLINE preHashFPUnaryDescription #-}
-
-preHashFPBinaryDescription :: FPBinaryOp -> HashId -> HashId -> Digest
-preHashFPBinaryDescription op h1 h2 =
-  fromIntegral (44 `hashWithSalt` op `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashFPBinaryDescription #-}
-
-preHashFPRoundingUnaryDescription ::
-  FPRoundingUnaryOp -> HashId -> HashId -> Digest
-preHashFPRoundingUnaryDescription op mode h =
-  fromIntegral (45 `hashWithSalt` op `hashWithSalt` mode `hashWithSalt` h)
-{-# INLINE preHashFPRoundingUnaryDescription #-}
-
-preHashFPRoundingBinaryDescription ::
-  FPRoundingBinaryOp -> HashId -> HashId -> HashId -> Digest
-preHashFPRoundingBinaryDescription op mode h1 h2 =
-  fromIntegral
-    ( 46
-        `hashWithSalt` op
-        `hashWithSalt` mode
-        `hashWithSalt` h1
-        `hashWithSalt` h2
-    )
-
-preHashFPFMADescription ::
-  HashId -> HashId -> HashId -> HashId -> Digest
-preHashFPFMADescription mode h1 h2 h3 =
-  fromIntegral
-    ( 47
-        `hashWithSalt` mode
-        `hashWithSalt` h1
-        `hashWithSalt` h2
-        `hashWithSalt` h3
-    )
-{-# INLINE preHashFPFMADescription #-}
-
-preHashFromIntegralDescription :: TypeHashId -> Digest
-preHashFromIntegralDescription = fromIntegral . hashWithSalt 48
-{-# INLINE preHashFromIntegralDescription #-}
-
-preHashFromFPOrDescription ::
-  HashId -> HashId -> TypeHashId -> Digest
-preHashFromFPOrDescription h1 h2 h3 =
-  fromIntegral (49 `hashWithSalt` h1 `hashWithSalt` h2 `hashWithSalt` h3)
-{-# INLINE preHashFromFPOrDescription #-}
-
-preHashToFPTermDescription :: HashId -> TypeHashId -> Digest
-preHashToFPTermDescription h1 h2 =
-  fromIntegral (50 `hashWithSalt` h1 `hashWithSalt` h2)
-{-# INLINE preHashToFPTermDescription #-}
-
-instance Interned (Term t) where
-  type Uninterned (Term t) = UTerm t
-  data Description (Term t) where
-    DConTerm ::
-      (t -> t -> Bool) -> {-# UNPACK #-} !Digest -> t -> Description (Term t)
-    DSymTerm ::
-      {-# UNPACK #-} !Digest ->
-      TypedSymbol 'AnyKind t ->
-      Description (Term t)
-    DForallTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !(TypedSymbol 'ConstantKind t) ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DExistsTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !(TypedSymbol 'ConstantKind t) ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DNotTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DOrTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DAndTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DEqTerm ::
-      {-# UNPACK #-} !Digest ->
-      Fingerprint ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DDistinctTerm ::
-      {-# UNPACK #-} !Digest ->
-      Fingerprint ->
-      !(NonEmpty HashId) ->
-      Description (Term Bool)
-    DITETerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DAddNumTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DNegNumTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DMulNumTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DAbsNumTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DSignumNumTerm ::
-      {-# UNPACK #-} !Digest -> {-# UNPACK #-} !HashId -> Description (Term t)
-    DLtOrdTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !Fingerprint ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DLeOrdTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !Fingerprint ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term Bool)
-    DAndBitsTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DOrBitsTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DXorBitsTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DComplementBitsTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DShiftLeftTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DShiftRightTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DRotateLeftTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DRotateRightTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term t)
-    DBVConcatTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !TypeHashId ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term t)
-    DBitCastTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term b)
-    DBitCastOrTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term b)
-    DBVSelectTerm ::
-      forall bv (w :: Nat).
-      {-# UNPACK #-} !Digest ->
-      !Fingerprint ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term (bv w))
-    DBVExtendTerm ::
-      forall bv (r :: Nat).
-      {-# UNPACK #-} !Digest ->
-      !Bool ->
-      !(Proxy r) ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term (bv r))
-    DApplyTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !TypeHashId ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term b)
-    DDivIntegralTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DModIntegralTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DQuotIntegralTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DRemIntegralTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DFPTraitTerm ::
-      {-# UNPACK #-} !Digest ->
-      FPTrait ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term Bool)
-    DFdivTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DRecipTerm ::
-      {-# UNPACK #-} !Digest -> {-# UNPACK #-} !HashId -> Description (Term a)
-    DFloatingUnaryTerm ::
-      {-# UNPACK #-} !Digest ->
-      FloatingUnaryOp ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DPowerTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term a)
-    DFPUnaryTerm ::
-      {-# UNPACK #-} !Digest ->
-      FPUnaryOp ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term (FP eb sb))
-    DFPBinaryTerm ::
-      {-# UNPACK #-} !Digest ->
-      FPBinaryOp ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term (FP eb sb))
-    DFPRoundingUnaryTerm ::
-      {-# UNPACK #-} !Digest ->
-      FPRoundingUnaryOp ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term (FP eb sb))
-    DFPRoundingBinaryTerm ::
-      {-# UNPACK #-} !Digest ->
-      FPRoundingBinaryOp ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term (FP eb sb))
-    DFPFMATerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      Description (Term (FP eb sb))
-    DFromIntegralTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term b)
-    DFromFPOrTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term a)
-    DToFPTerm ::
-      {-# UNPACK #-} !Digest ->
-      {-# UNPACK #-} !HashId ->
-      {-# UNPACK #-} !TypeHashId ->
-      Description (Term (FP eb sb))
-
-  describe (UConTerm v) = DConTerm sameCon (preHashConDescription v) v
-  describe ((USymTerm name) :: UTerm t) =
-    DSymTerm @t (preHashSymDescription name) name
-  describe (UForallTerm (sym :: TypedSymbol 'ConstantKind arg) arg) =
-    let argHashId = hashId arg
-     in DForallTerm (preHashForallDescription sym argHashId) sym argHashId
-  describe (UExistsTerm (sym :: TypedSymbol 'ConstantKind arg) arg) =
-    let argHashId = hashId arg
-     in DExistsTerm (preHashExistsDescription sym argHashId) sym argHashId
-  describe (UNotTerm arg) =
-    let argHashId = hashId arg
-     in DNotTerm (preHashNotDescription argHashId) argHashId
-  describe (UOrTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DOrTerm
-          (preHashOrDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UAndTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DAndTerm
-          (preHashAndDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UEqTerm (arg1 :: Term arg) arg2) = do
-    let fingerprint =
-          introSupportedPrimConstraint arg1 $ typeFingerprint @arg
-        arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DEqTerm
-          (preHashEqDescription fingerprint arg1HashId arg2HashId)
-          fingerprint
-          arg1HashId
-          arg2HashId
-  describe (UDistinctTerm args@((arg1 :: Term arg) :| _)) =
-    let fingerprint =
-          introSupportedPrimConstraint arg1 $ typeFingerprint @arg
-        argsHashId = hashId <$> args
-     in DDistinctTerm
-          (preHashDistinctDescription fingerprint argsHashId)
-          fingerprint
-          argsHashId
-  describe (UITETerm cond (l :: Term arg) r) =
-    let condHashId = hashId cond
-        lHashId = hashId l
-        rHashId = hashId r
-     in DITETerm
-          (preHashITEDescription condHashId lHashId rHashId)
-          condHashId
-          lHashId
-          rHashId
-  describe (UAddNumTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DAddNumTerm
-          (preHashAddNumDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UNegNumTerm arg) =
-    let argHashId = hashId arg
-     in DNegNumTerm (preHashNegNumDescription argHashId) argHashId
-  describe (UMulNumTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DMulNumTerm
-          (preHashMulNumDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UAbsNumTerm arg) =
-    let argHashId = hashId arg
-     in DAbsNumTerm (preHashAbsNumDescription argHashId) argHashId
-  describe (USignumNumTerm arg) =
-    let argHashId = hashId arg
-     in DSignumNumTerm (preHashSignumNumDescription argHashId) argHashId
-  describe (ULtOrdTerm (arg1 :: Term arg) arg2) =
-    let tr = typeFingerprint @arg
-        arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DLtOrdTerm
-          (preHashLtOrdDescription tr arg1HashId arg2HashId)
-          tr
-          arg1HashId
-          arg2HashId
-  describe (ULeOrdTerm (arg1 :: Term arg) arg2) =
-    let tr = typeFingerprint @arg
-        arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DLeOrdTerm
-          (preHashLeOrdDescription tr arg1HashId arg2HashId)
-          tr
-          arg1HashId
-          arg2HashId
-  describe (UAndBitsTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DAndBitsTerm
-          (preHashAndBitsDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UOrBitsTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DOrBitsTerm
-          (preHashOrBitsDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UXorBitsTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DXorBitsTerm
-          (preHashXorBitsDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UComplementBitsTerm arg) =
-    let argHashId = hashId arg
-     in DComplementBitsTerm
-          (preHashComplementBitsDescription argHashId)
-          argHashId
-  describe (UShiftLeftTerm arg n) =
-    let argHashId = hashId arg
-        nHashId = hashId n
-     in DShiftLeftTerm
-          (preHashShiftLeftDescription argHashId nHashId)
-          argHashId
-          nHashId
-  describe (UShiftRightTerm arg n) =
-    let argHashId = hashId arg
-        nHashId = hashId n
-     in DShiftRightTerm
-          (preHashShiftRightDescription argHashId nHashId)
-          argHashId
-          nHashId
-  describe (URotateLeftTerm arg n) =
-    let argHashId = hashId arg
-        nHashId = hashId n
-     in DRotateLeftTerm
-          (preHashRotateLeftDescription argHashId nHashId)
-          argHashId
-          nHashId
-  describe (URotateRightTerm arg n) =
-    let argHashId = hashId arg
-        nHashId = hashId n
-     in DRotateRightTerm
-          (preHashRotateRightDescription argHashId nHashId)
-          argHashId
-          nHashId
-  describe (UBitCastTerm (arg :: Term a)) =
-    let argHashId = typeHashId arg
-     in DBitCastTerm (preHashBitCastDescription argHashId) argHashId
-  describe (UBitCastOrTerm d (arg :: Term a)) =
-    let dHashId = hashId d
-        argHashId = typeHashId arg
-     in DBitCastOrTerm
-          (preHashBitCastOrDescription dHashId argHashId)
-          dHashId
-          argHashId
-  describe (UBVConcatTerm (arg1 :: Term bv1) (arg2 :: Term bv2)) =
-    let arg1HashId = typeHashId arg1
-        arg2HashId = typeHashId arg2
-     in DBVConcatTerm
-          (preHashBVConcatDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UBVSelectTerm (ix :: Proxy ix) _ (arg :: Term arg)) =
-    let ixFingerprint = typeRepFingerprint $ someTypeRep ix
-        argHashId = typeHashId arg
-     in DBVSelectTerm
-          (preHashBVSelectDescription ixFingerprint argHashId)
-          ixFingerprint
-          argHashId
-  describe (UBVExtendTerm signed (n :: Proxy n) (arg :: Term arg)) =
-    let argHashId = typeHashId arg
-     in DBVExtendTerm
-          (preHashBVExtendDescription signed argHashId)
-          signed
-          n
-          argHashId
-  describe (UApplyTerm (f :: Term f) (arg :: Term a)) =
-    let fHashId = typeHashId f
-        argHashId = typeHashId arg
-     in DApplyTerm
-          (preHashApplyDescription fHashId argHashId)
-          fHashId
-          argHashId
-  describe (UDivIntegralTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DDivIntegralTerm
-          (preHashDivIntegralDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UModIntegralTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DModIntegralTerm
-          (preHashModIntegralDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UQuotIntegralTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DQuotIntegralTerm
-          (preHashQuotIntegralDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (URemIntegralTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DRemIntegralTerm
-          (preHashRemIntegralDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UFPTraitTerm trait (arg :: Term arg)) =
-    let argHashId = typeHashId arg
-     in DFPTraitTerm
-          (preHashFPTraitDescription trait argHashId)
-          trait
-          argHashId
-  describe (UFdivTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DFdivTerm
-          (preHashFdivDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (URecipTerm arg) =
-    let argHashId = hashId arg
-     in DRecipTerm (preHashRecipDescription argHashId) argHashId
-  describe (UFloatingUnaryTerm op arg) =
-    let argHashId = hashId arg
-     in DFloatingUnaryTerm
-          (preHashFloatingUnaryDescription op argHashId)
-          op
-          argHashId
-  describe (UPowerTerm arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DPowerTerm
-          (preHashPowerDescription arg1HashId arg2HashId)
-          arg1HashId
-          arg2HashId
-  describe (UFPUnaryTerm op arg) =
-    let argHashId = hashId arg
-     in DFPUnaryTerm
-          (preHashFPUnaryDescription op argHashId)
-          op
-          argHashId
-  describe (UFPBinaryTerm op arg1 arg2) =
-    let arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DFPBinaryTerm
-          (preHashFPBinaryDescription op arg1HashId arg2HashId)
-          op
-          arg1HashId
-          arg2HashId
-  describe (UFPRoundingUnaryTerm op mode arg) =
-    let modeHashId = hashId mode
-        argHashId = hashId arg
-     in DFPRoundingUnaryTerm
-          (preHashFPRoundingUnaryDescription op modeHashId argHashId)
-          op
-          modeHashId
-          argHashId
-  describe (UFPRoundingBinaryTerm op mode arg1 arg2) =
-    let modeHashId = hashId mode
-        arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-     in DFPRoundingBinaryTerm
-          ( preHashFPRoundingBinaryDescription
-              op
-              modeHashId
-              arg1HashId
-              arg2HashId
-          )
-          op
-          modeHashId
-          arg1HashId
-          arg2HashId
-  describe (UFPFMATerm mode arg1 arg2 arg3) =
-    let modeHashId = hashId mode
-        arg1HashId = hashId arg1
-        arg2HashId = hashId arg2
-        arg3HashId = hashId arg3
-     in DFPFMATerm
-          (preHashFPFMADescription modeHashId arg1HashId arg2HashId arg3HashId)
-          modeHashId
-          arg1HashId
-          arg2HashId
-          arg3HashId
-  describe (UFromIntegralTerm (arg :: Term a)) =
-    let argHashId = typeHashId arg
-     in DFromIntegralTerm (preHashFromIntegralDescription argHashId) argHashId
-  describe (UFromFPOrTerm d mode (arg :: Term a)) =
-    let dHashId = hashId d
-        modeHashId = hashId mode
-        argHashId = typeHashId arg
-     in DFromFPOrTerm
-          (preHashFromFPOrDescription dHashId modeHashId argHashId)
-          dHashId
-          modeHashId
-          argHashId
-  describe (UToFPTerm mode (arg :: Term a) _ _) =
-    let modeHashId = hashId mode
-        argHashId = typeHashId arg
-     in DToFPTerm
-          (preHashToFPTermDescription modeHashId argHashId)
-          modeHashId
-          argHashId
-
-  -- {-# INLINE describe #-}
-
-  identify tid ha i ident = go
-    where
-      go (UConTerm v) = goPhantomCon tid ha i ident getPhantomDict v
-      go (USymTerm v) = SymTerm tid ha i ident v
-      go (UForallTerm sym arg) = ForallTerm tid ha i ident sym arg
-      go (UExistsTerm sym arg) = ExistsTerm tid ha i ident sym arg
-      go (UNotTerm arg) = NotTerm tid ha i ident arg
-      go (UOrTerm arg1 arg2) = OrTerm tid ha i ident arg1 arg2
-      go (UAndTerm arg1 arg2) = AndTerm tid ha i ident arg1 arg2
-      go (UEqTerm arg1 arg2) = EqTerm tid ha i ident arg1 arg2
-      go (UDistinctTerm args) = DistinctTerm tid ha i ident args
-      -- ITE is propagated
-      go (UITETerm cond l r) = ITETerm tid ha i ident cond l r
-      go (UAddNumTerm arg1 arg2) = AddNumTerm tid ha i ident arg1 arg2
-      go (UNegNumTerm arg) = NegNumTerm tid ha i ident arg
-      go (UMulNumTerm arg1 arg2) = MulNumTerm tid ha i ident arg1 arg2
-      go (UAbsNumTerm arg) = AbsNumTerm tid ha i ident arg
-      go (USignumNumTerm arg) = SignumNumTerm tid ha i ident arg
-      go (ULtOrdTerm arg1 arg2) = LtOrdTerm tid ha i ident arg1 arg2
-      go (ULeOrdTerm arg1 arg2) = LeOrdTerm tid ha i ident arg1 arg2
-      go (UAndBitsTerm arg1 arg2) = AndBitsTerm tid ha i ident arg1 arg2
-      go (UOrBitsTerm arg1 arg2) = OrBitsTerm tid ha i ident arg1 arg2
-      go (UXorBitsTerm arg1 arg2) = XorBitsTerm tid ha i ident arg1 arg2
-      go (UComplementBitsTerm arg) = ComplementBitsTerm tid ha i ident arg
-      go (UShiftLeftTerm arg n) = ShiftLeftTerm tid ha i ident arg n
-      go (UShiftRightTerm arg n) = ShiftRightTerm tid ha i ident arg n
-      go (URotateLeftTerm arg n) = RotateLeftTerm tid ha i ident arg n
-      go (URotateRightTerm arg n) = RotateRightTerm tid ha i ident arg n
-      go (UBitCastTerm arg) = goPhantomBitCast tid ha i ident getPhantomDict arg
-      go (UBitCastOrTerm d arg) = BitCastOrTerm tid ha i ident d arg
-      go (UBVConcatTerm arg1 arg2) =
-        goPhantomBVConcat tid ha i ident getPhantomDict arg1 arg2
-      go (UBVSelectTerm ix w arg) =
-        goPhantomBVSelect tid ha i ident getPhantomDict ix w arg
-      go (UBVExtendTerm signed n arg) =
-        goPhantomBVExtend tid ha i ident getPhantomDict signed n arg
-      go (UApplyTerm f arg) = goPhantomApply tid ha i ident getPhantomDict f arg
-      go (UDivIntegralTerm arg1 arg2) = DivIntegralTerm tid ha i ident arg1 arg2
-      go (UModIntegralTerm arg1 arg2) = ModIntegralTerm tid ha i ident arg1 arg2
-      go (UQuotIntegralTerm arg1 arg2) = QuotIntegralTerm tid ha i ident arg1 arg2
-      go (URemIntegralTerm arg1 arg2) = RemIntegralTerm tid ha i ident arg1 arg2
-      go (UFPTraitTerm trait arg) =
-        goPhantomFPTrait tid ha i ident getPhantomDict trait arg
-      go (UFdivTerm arg1 arg2) = FdivTerm tid ha i ident arg1 arg2
-      go (URecipTerm arg) = RecipTerm tid ha i ident arg
-      go (UFloatingUnaryTerm op arg) = FloatingUnaryTerm tid ha i ident op arg
-      go (UPowerTerm arg1 arg2) = PowerTerm tid ha i ident arg1 arg2
-      go (UFPUnaryTerm op arg) = goPhantomFPUnary tid ha i ident getPhantomDict op arg
-      go (UFPBinaryTerm op arg1 arg2) =
-        goPhantomFPBinary tid ha i ident getPhantomDict op arg1 arg2
-      go (UFPRoundingUnaryTerm op mode arg) =
-        goPhantomFPRoundingUnary tid ha i ident getPhantomDict op mode arg
-      go (UFPRoundingBinaryTerm op mode arg1 arg2) =
-        goPhantomFPRoundingBinary tid ha i ident getPhantomDict op mode arg1 arg2
-      go (UFPFMATerm mode arg1 arg2 arg3) =
-        goPhantomFPFMA tid ha i ident getPhantomDict mode arg1 arg2 arg3
-      go (UFromIntegralTerm arg) =
-        goPhantomFromIntegral tid ha i ident getPhantomDict arg
-      go (UFromFPOrTerm d mode arg) = FromFPOrTerm tid ha i ident d mode arg
-      go (UToFPTerm mode arg _ _) =
-        goPhantomToFP tid ha i ident getPhantomDict mode arg
-      {-# INLINE go #-}
-
-  -- {-# INLINE identify #-}
-  threadId = termThreadId
-  {-# INLINE threadId #-}
-
-  descriptionDigest (DConTerm _ h _) = h
-  descriptionDigest (DSymTerm h _) = h
-  descriptionDigest (DForallTerm h _ _) = h
-  descriptionDigest (DExistsTerm h _ _) = h
-  descriptionDigest (DNotTerm h _) = h
-  descriptionDigest (DOrTerm h _ _) = h
-  descriptionDigest (DAndTerm h _ _) = h
-  descriptionDigest (DEqTerm h _ _ _) = h
-  descriptionDigest (DDistinctTerm h _ _) = h
-  descriptionDigest (DITETerm h _ _ _) = h
-  descriptionDigest (DAddNumTerm h _ _) = h
-  descriptionDigest (DNegNumTerm h _) = h
-  descriptionDigest (DMulNumTerm h _ _) = h
-  descriptionDigest (DAbsNumTerm h _) = h
-  descriptionDigest (DSignumNumTerm h _) = h
-  descriptionDigest (DLtOrdTerm h _ _ _) = h
-  descriptionDigest (DLeOrdTerm h _ _ _) = h
-  descriptionDigest (DAndBitsTerm h _ _) = h
-  descriptionDigest (DOrBitsTerm h _ _) = h
-  descriptionDigest (DXorBitsTerm h _ _) = h
-  descriptionDigest (DComplementBitsTerm h _) = h
-  descriptionDigest (DShiftLeftTerm h _ _) = h
-  descriptionDigest (DShiftRightTerm h _ _) = h
-  descriptionDigest (DRotateLeftTerm h _ _) = h
-  descriptionDigest (DRotateRightTerm h _ _) = h
-  descriptionDigest (DBitCastTerm h _) = h
-  descriptionDigest (DBitCastOrTerm h _ _) = h
-  descriptionDigest (DBVConcatTerm h _ _) = h
-  descriptionDigest (DBVSelectTerm h _ _) = h
-  descriptionDigest (DBVExtendTerm h _ _ _) = h
-  descriptionDigest (DDivIntegralTerm h _ _) = h
-  descriptionDigest (DModIntegralTerm h _ _) = h
-  descriptionDigest (DQuotIntegralTerm h _ _) = h
-  descriptionDigest (DRemIntegralTerm h _ _) = h
-  descriptionDigest (DApplyTerm h _ _) = h
-  descriptionDigest (DFPTraitTerm h _ _) = h
-  descriptionDigest (DFdivTerm h _ _) = h
-  descriptionDigest (DRecipTerm h _) = h
-  descriptionDigest (DFloatingUnaryTerm h _ _) = h
-  descriptionDigest (DPowerTerm h _ _) = h
-  descriptionDigest (DFPUnaryTerm h _ _) = h
-  descriptionDigest (DFPBinaryTerm h _ _ _) = h
-  descriptionDigest (DFPRoundingUnaryTerm h _ _ _) = h
-  descriptionDigest (DFPRoundingBinaryTerm h _ _ _ _) = h
-  descriptionDigest (DFPFMATerm h _ _ _ _) = h
-  descriptionDigest (DFromIntegralTerm h _) = h
-  descriptionDigest (DFromFPOrTerm h _ _ _) = h
-  descriptionDigest (DToFPTerm h _ _) = h
-
--- {-# INLINE descriptionDigest #-}
-{-# NOINLINE goPhantomCon #-}
-goPhantomCon ::
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict t ->
-  t ->
-  Term t
-goPhantomCon tid ha i ident PhantomDict v = ConTerm tid ha i ident v
-
-{-# NOINLINE goPhantomBitCast #-}
-goPhantomBitCast ::
-  (PEvalBitCastTerm a t) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict t ->
-  Term a ->
-  Term t
-goPhantomBitCast tid ha i ident PhantomDict arg = BitCastTerm tid ha i ident arg
-
-{-# NOINLINE goPhantomBVConcat #-}
-goPhantomBVConcat ::
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    KnownNat (l + r),
-    1 <= l,
-    1 <= r,
-    1 <= l + r
-  ) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (bv (l + r)) ->
-  Term (bv l) ->
-  Term (bv r) ->
-  Term (bv (l + r))
-goPhantomBVConcat tid ha i ident PhantomDict arg1 arg2 =
-  BVConcatTerm tid ha i ident arg1 arg2
-
-{-# NOINLINE goPhantomBVSelect #-}
-goPhantomBVSelect ::
-  ( PEvalBVTerm bv,
-    KnownNat n,
-    KnownNat ix,
-    KnownNat w,
-    1 <= n,
-    1 <= w,
-    ix + w <= n
-  ) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (bv w) ->
-  Proxy ix ->
-  Proxy w ->
-  Term (bv n) ->
-  Term (bv w)
-goPhantomBVSelect tid ha i ident PhantomDict ix w arg =
-  BVSelectTerm tid ha i ident ix w arg
-
-{-# NOINLINE goPhantomBVExtend #-}
-goPhantomBVExtend ::
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r
-  ) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (bv r) ->
-  Bool ->
-  Proxy r ->
-  Term (bv l) ->
-  Term (bv r)
-goPhantomBVExtend tid ha i ident PhantomDict signed n arg =
-  BVExtendTerm tid ha i ident signed n arg
-
-{-# NOINLINE goPhantomApply #-}
-goPhantomApply ::
-  (PEvalApplyTerm f a t) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict t ->
-  Term f ->
-  Term a ->
-  Term t
-goPhantomApply tid ha i ident PhantomDict f arg = ApplyTerm tid ha i ident f arg
-
-{-# NOINLINE goPhantomFPTrait #-}
-goPhantomFPTrait ::
-  (ValidFP eb sb) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  FPTrait ->
-  Term (FP eb sb) ->
-  Term Bool
-goPhantomFPTrait tid ha i ident PhantomDict trait arg = FPTraitTerm tid ha i ident trait arg
-
-{-# NOINLINE goPhantomFPUnary #-}
-goPhantomFPUnary ::
-  (ValidFP eb sb) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  FPUnaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-goPhantomFPUnary tid ha i ident PhantomDict op arg = FPUnaryTerm tid ha i ident op arg
-
-{-# NOINLINE goPhantomFPBinary #-}
-goPhantomFPBinary ::
-  (ValidFP eb sb) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  FPBinaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-goPhantomFPBinary tid ha i ident PhantomDict op arg1 arg2 =
-  FPBinaryTerm tid ha i ident op arg1 arg2
-
-{-# NOINLINE goPhantomFPRoundingUnary #-}
-goPhantomFPRoundingUnary ::
-  (ValidFP eb sb) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  FPRoundingUnaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-goPhantomFPRoundingUnary tid ha i ident PhantomDict op mode arg =
-  FPRoundingUnaryTerm tid ha i ident op mode arg
-
-{-# NOINLINE goPhantomFPRoundingBinary #-}
-goPhantomFPRoundingBinary ::
-  (ValidFP eb sb) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  FPRoundingBinaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-goPhantomFPRoundingBinary tid ha i ident PhantomDict op mode arg1 arg2 =
-  FPRoundingBinaryTerm tid ha i ident op mode arg1 arg2
-
-{-# NOINLINE goPhantomFPFMA #-}
-goPhantomFPFMA ::
-  (ValidFP eb sb) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-goPhantomFPFMA tid ha i ident PhantomDict mode arg1 arg2 arg3 =
-  FPFMATerm tid ha i ident mode arg1 arg2 arg3
-
-{-# NOINLINE goPhantomFromIntegral #-}
-goPhantomFromIntegral ::
-  (PEvalFromIntegralTerm a b) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict b ->
-  Term a ->
-  Term b
-goPhantomFromIntegral tid ha i ident PhantomDict arg = FromIntegralTerm tid ha i ident arg
-
-{-# NOINLINE goPhantomToFP #-}
-goPhantomToFP ::
-  forall a eb sb.
-  (ValidFP eb sb, PEvalIEEEFPConvertibleTerm a) =>
-  WeakThreadId ->
-  Digest ->
-  Id ->
-  Ident ->
-  PhantomDict (FP eb sb) ->
-  Term FPRoundingMode ->
-  Term a ->
-  Term (FP eb sb)
-goPhantomToFP tid ha i ident PhantomDict mode arg =
-  ToFPTerm tid ha i ident mode arg (Proxy @eb) (Proxy @sb)
-
-termThreadId :: Term t -> WeakThreadId
-termThreadId (ConTerm tid _ _ _ _) = tid
-termThreadId (SymTerm tid _ _ _ _) = tid
-termThreadId (ForallTerm tid _ _ _ _ _) = tid
-termThreadId (ExistsTerm tid _ _ _ _ _) = tid
-termThreadId (NotTerm tid _ _ _ _) = tid
-termThreadId (OrTerm tid _ _ _ _ _) = tid
-termThreadId (AndTerm tid _ _ _ _ _) = tid
-termThreadId (EqTerm tid _ _ _ _ _) = tid
-termThreadId (DistinctTerm tid _ _ _ _) = tid
-termThreadId (ITETerm tid _ _ _ _ _ _) = tid
-termThreadId (AddNumTerm tid _ _ _ _ _) = tid
-termThreadId (NegNumTerm tid _ _ _ _) = tid
-termThreadId (MulNumTerm tid _ _ _ _ _) = tid
-termThreadId (AbsNumTerm tid _ _ _ _) = tid
-termThreadId (SignumNumTerm tid _ _ _ _) = tid
-termThreadId (LtOrdTerm tid _ _ _ _ _) = tid
-termThreadId (LeOrdTerm tid _ _ _ _ _) = tid
-termThreadId (AndBitsTerm tid _ _ _ _ _) = tid
-termThreadId (OrBitsTerm tid _ _ _ _ _) = tid
-termThreadId (XorBitsTerm tid _ _ _ _ _) = tid
-termThreadId (ComplementBitsTerm tid _ _ _ _) = tid
-termThreadId (ShiftLeftTerm tid _ _ _ _ _) = tid
-termThreadId (ShiftRightTerm tid _ _ _ _ _) = tid
-termThreadId (RotateLeftTerm tid _ _ _ _ _) = tid
-termThreadId (RotateRightTerm tid _ _ _ _ _) = tid
-termThreadId (BitCastTerm tid _ _ _ _) = tid
-termThreadId (BitCastOrTerm tid _ _ _ _ _) = tid
-termThreadId (BVConcatTerm tid _ _ _ _ _) = tid
-termThreadId (BVSelectTerm tid _ _ _ _ _ _) = tid
-termThreadId (BVExtendTerm tid _ _ _ _ _ _) = tid
-termThreadId (ApplyTerm tid _ _ _ _ _) = tid
-termThreadId (DivIntegralTerm tid _ _ _ _ _) = tid
-termThreadId (ModIntegralTerm tid _ _ _ _ _) = tid
-termThreadId (QuotIntegralTerm tid _ _ _ _ _) = tid
-termThreadId (RemIntegralTerm tid _ _ _ _ _) = tid
-termThreadId (FPTraitTerm tid _ _ _ _ _) = tid
-termThreadId (FdivTerm tid _ _ _ _ _) = tid
-termThreadId (RecipTerm tid _ _ _ _) = tid
-termThreadId (FloatingUnaryTerm tid _ _ _ _ _) = tid
-termThreadId (PowerTerm tid _ _ _ _ _) = tid
-termThreadId (FPUnaryTerm tid _ _ _ _ _) = tid
-termThreadId (FPBinaryTerm tid _ _ _ _ _ _) = tid
-termThreadId (FPRoundingUnaryTerm tid _ _ _ _ _ _) = tid
-termThreadId (FPRoundingBinaryTerm tid _ _ _ _ _ _ _) = tid
-termThreadId (FPFMATerm tid _ _ _ _ _ _ _) = tid
-termThreadId (FromIntegralTerm tid _ _ _ _) = tid
-termThreadId (FromFPOrTerm tid _ _ _ _ _ _) = tid
-termThreadId (ToFPTerm tid _ _ _ _ _ _ _) = tid
-
--- {-# INLINE termThreadId #-}
-
-instance Eq (Description (Term t)) where
-  DConTerm eqFunc _ l == DConTerm _ _ r =
-    eqFunc l r
-  DSymTerm _ ls == DSymTerm _ rs = ls == rs
-  DForallTerm _ ls li == DForallTerm _ rs ri =
-    eqHeteroSymbol ls rs && eqHashId li ri
-  DExistsTerm _ ls li == DExistsTerm _ rs ri =
-    eqHeteroSymbol ls rs && eqHashId li ri
-  DNotTerm _ li == DNotTerm _ ri = eqHashId li ri
-  DOrTerm _ li1 li2 == DOrTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DAndTerm _ li1 li2 == DAndTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DEqTerm _ lfp li1 li2 == DEqTerm _ rfp ri1 ri2 = lfp == rfp && eqHashId li1 ri1 && eqHashId li2 ri2
-  DDistinctTerm _ lfp li == DDistinctTerm _ rfp ri =
-    lfp == rfp
-      && length li == length ri
-      && and (zipWith eqHashId (toList li) (toList ri))
-  DITETerm _ lc li1 li2 == DITETerm _ rc ri1 ri2 = eqHashId lc rc && eqHashId li1 ri1 && eqHashId li2 ri2
-  DAddNumTerm _ li1 li2 == DAddNumTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DNegNumTerm _ li == DNegNumTerm _ ri = eqHashId li ri
-  DMulNumTerm _ li1 li2 == DMulNumTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DAbsNumTerm _ li == DAbsNumTerm _ ri = eqHashId li ri
-  DSignumNumTerm _ li == DSignumNumTerm _ ri = eqHashId li ri
-  DLtOrdTerm _ lrep li1 li2 == DLtOrdTerm _ rrep ri1 ri2 = lrep == rrep && eqHashId li1 ri1 && eqHashId li2 ri2
-  DLeOrdTerm _ lrep li1 li2 == DLeOrdTerm _ rrep ri1 ri2 = lrep == rrep && eqHashId li1 ri1 && eqHashId li2 ri2
-  DAndBitsTerm _ li1 li2 == DAndBitsTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DOrBitsTerm _ li1 li2 == DOrBitsTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DXorBitsTerm _ li1 li2 == DXorBitsTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DComplementBitsTerm _ li == DComplementBitsTerm _ ri = eqHashId li ri
-  DShiftLeftTerm _ li ln == DShiftLeftTerm _ ri rn = eqHashId li ri && eqHashId ln rn
-  DShiftRightTerm _ li ln == DShiftRightTerm _ ri rn = eqHashId li ri && eqHashId ln rn
-  DRotateLeftTerm _ li ln == DRotateLeftTerm _ ri rn = eqHashId li ri && eqHashId ln rn
-  DRotateRightTerm _ li ln == DRotateRightTerm _ ri rn = eqHashId li ri && eqHashId ln rn
-  DBitCastTerm _ li == DBitCastTerm _ ri = li == ri
-  DBitCastOrTerm _ ld li == DBitCastOrTerm _ rd ri = ld == rd && li == ri
-  DBVConcatTerm _ li1 li2 == DBVConcatTerm _ ri1 ri2 = li1 == ri1 && li2 == ri2
-  DBVSelectTerm _ lix li == DBVSelectTerm _ rix ri =
-    lix == rix && li == ri
-  DBVExtendTerm _ lIsSigned _ li == DBVExtendTerm _ rIsSigned _ ri =
-    lIsSigned == rIsSigned
-      && li == ri
-  DApplyTerm _ lf li == DApplyTerm _ rf ri = lf == rf && li == ri
-  DDivIntegralTerm _ li1 li2 == DDivIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DModIntegralTerm _ li1 li2 == DModIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DQuotIntegralTerm _ li1 li2 == DQuotIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DRemIntegralTerm _ li1 li2 == DRemIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DFPTraitTerm _ lt li == DFPTraitTerm _ rt ri = lt == rt && li == ri
-  DFdivTerm _ li1 li2 == DFdivTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DRecipTerm _ li == DRecipTerm _ ri = eqHashId li ri
-  DFloatingUnaryTerm _ lop li == DFloatingUnaryTerm _ rop ri = lop == rop && eqHashId li ri
-  DPowerTerm _ li1 li2 == DPowerTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
-  DFPUnaryTerm _ lop li == DFPUnaryTerm _ rop ri = lop == rop && eqHashId li ri
-  DFPBinaryTerm _ lop li1 li2 == DFPBinaryTerm _ rop ri1 ri2 = lop == rop && eqHashId li1 ri1 && eqHashId li2 ri2
-  DFPRoundingUnaryTerm _ lop lmode li == DFPRoundingUnaryTerm _ rop rmode ri =
-    lop == rop && eqHashId lmode rmode && eqHashId li ri
-  DFPRoundingBinaryTerm _ lop lmode li1 li2 == DFPRoundingBinaryTerm _ rop rmode ri1 ri2 =
-    lop == rop && eqHashId lmode rmode && eqHashId li1 ri1 && eqHashId li2 ri2
-  DFPFMATerm _ lmode li1 li2 li3 == DFPFMATerm _ rmode ri1 ri2 ri3 =
-    eqHashId lmode rmode && eqHashId li1 ri1 && eqHashId li2 ri2 && eqHashId li3 ri3
-  DFromIntegralTerm _ li == DFromIntegralTerm _ ri = li == ri
-  DFromFPOrTerm _ ld li lai == DFromFPOrTerm _ rd ri rai = eqHashId ld rd && eqHashId li ri && lai == rai
-  DToFPTerm _ li lai == DToFPTerm _ ri rai = eqHashId li ri && lai == rai
-  _ == _ = False
-
--- {-# INLINE (==) #-}
-
-instance Hashable (Description (Term t)) where
-  hashWithSalt s = hashWithSalt s . descriptionDigest
-  {-# INLINE hashWithSalt #-}
-
-fullReconstructTerm1 ::
-  forall a b.
-  (Term a -> IO (Term b)) ->
-  Term a ->
-  IO (Term b)
-fullReconstructTerm1 f x = fullReconstructTerm x >>= f
-{-# INLINE fullReconstructTerm1 #-}
-
-fullReconstructTerm2 ::
-  forall a b c.
-  (Term a -> Term b -> IO (Term c)) ->
-  Term a ->
-  Term b ->
-  IO (Term c)
-fullReconstructTerm2 f x y = do
-  rx <- fullReconstructTerm x
-  ry <- fullReconstructTerm y
-  f rx ry
-{-# INLINE fullReconstructTerm2 #-}
-
-fullReconstructTerm3 ::
-  forall a b c d.
-  (Term a -> Term b -> Term c -> IO (Term d)) ->
-  Term a ->
-  Term b ->
-  Term c ->
-  IO (Term d)
-fullReconstructTerm3 f x y z = do
-  rx <- fullReconstructTerm x
-  ry <- fullReconstructTerm y
-  rz <- fullReconstructTerm z
-  f rx ry rz
-{-# INLINE fullReconstructTerm3 #-}
-
-fullReconstructTerm :: forall t. Term t -> IO (Term t)
-fullReconstructTerm (ConTerm _ _ _ _ i) = curThreadConTerm i
-fullReconstructTerm (SymTerm _ _ _ _ sym) = curThreadSymTerm sym
-fullReconstructTerm (ForallTerm _ _ _ _ sym arg) =
-  fullReconstructTerm1 (curThreadForallTerm sym) arg
-fullReconstructTerm (ExistsTerm _ _ _ _ sym arg) =
-  fullReconstructTerm1 (curThreadExistsTerm sym) arg
-fullReconstructTerm (NotTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadNotTerm arg
-fullReconstructTerm (OrTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadOrTerm arg1 arg2
-fullReconstructTerm (AndTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadAndTerm arg1 arg2
-fullReconstructTerm (EqTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadEqTerm arg1 arg2
-fullReconstructTerm (DistinctTerm _ _ _ _ args) =
-  traverse fullReconstructTerm args >>= curThreadDistinctTerm
-fullReconstructTerm (ITETerm _ _ _ _ cond arg1 arg2) =
-  fullReconstructTerm3 curThreadIteTerm cond arg1 arg2
-fullReconstructTerm (AddNumTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadAddNumTerm arg1 arg2
-fullReconstructTerm (NegNumTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadNegNumTerm arg
-fullReconstructTerm (MulNumTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadMulNumTerm arg1 arg2
-fullReconstructTerm (AbsNumTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadAbsNumTerm arg
-fullReconstructTerm (SignumNumTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadSignumNumTerm arg
-fullReconstructTerm (LtOrdTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadLtOrdTerm arg1 arg2
-fullReconstructTerm (LeOrdTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadLeOrdTerm arg1 arg2
-fullReconstructTerm (AndBitsTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadAndBitsTerm arg1 arg2
-fullReconstructTerm (OrBitsTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadOrBitsTerm arg1 arg2
-fullReconstructTerm (XorBitsTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadXorBitsTerm arg1 arg2
-fullReconstructTerm (ComplementBitsTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadComplementBitsTerm arg
-fullReconstructTerm (ShiftLeftTerm _ _ _ _ arg n) =
-  fullReconstructTerm1 (curThreadShiftLeftTerm arg) n
-fullReconstructTerm (ShiftRightTerm _ _ _ _ arg n) =
-  fullReconstructTerm1 (curThreadShiftRightTerm arg) n
-fullReconstructTerm (RotateLeftTerm _ _ _ _ arg n) =
-  fullReconstructTerm1 (curThreadRotateLeftTerm arg) n
-fullReconstructTerm (RotateRightTerm _ _ _ _ arg n) =
-  fullReconstructTerm1 (curThreadRotateRightTerm arg) n
-fullReconstructTerm (BitCastTerm _ _ _ _ v) =
-  fullReconstructTerm1 curThreadBitCastTerm v
-fullReconstructTerm (BitCastOrTerm _ _ _ _ d v) =
-  fullReconstructTerm2 curThreadBitCastOrTerm d v
-fullReconstructTerm (BVConcatTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadBVConcatTerm arg1 arg2
-fullReconstructTerm (BVSelectTerm _ _ _ _ (_ :: Proxy ix) (_ :: Proxy w) arg) =
-  fullReconstructTerm1 (curThreadBVSelectTerm (Proxy @ix) (Proxy @w)) arg
-fullReconstructTerm (BVExtendTerm _ _ _ _ signed p arg) =
-  fullReconstructTerm1 (curThreadBVExtendTerm signed p) arg
-fullReconstructTerm (ApplyTerm _ _ _ _ f arg) =
-  fullReconstructTerm2 curThreadApplyTerm f arg
-fullReconstructTerm (DivIntegralTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadDivIntegralTerm arg1 arg2
-fullReconstructTerm (ModIntegralTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadModIntegralTerm arg1 arg2
-fullReconstructTerm (QuotIntegralTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadQuotIntegralTerm arg1 arg2
-fullReconstructTerm (RemIntegralTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadRemIntegralTerm arg1 arg2
-fullReconstructTerm (FPTraitTerm _ _ _ _ trait arg) =
-  fullReconstructTerm1 (curThreadFpTraitTerm trait) arg
-fullReconstructTerm (FdivTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadFdivTerm arg1 arg2
-fullReconstructTerm (RecipTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadRecipTerm arg
-fullReconstructTerm (FloatingUnaryTerm _ _ _ _ op arg) =
-  fullReconstructTerm1 (curThreadFloatingUnaryTerm op) arg
-fullReconstructTerm (PowerTerm _ _ _ _ arg1 arg2) =
-  fullReconstructTerm2 curThreadPowerTerm arg1 arg2
-fullReconstructTerm (FPUnaryTerm _ _ _ _ op arg) =
-  fullReconstructTerm1 (curThreadFpUnaryTerm op) arg
-fullReconstructTerm (FPBinaryTerm _ _ _ _ op arg1 arg2) =
-  fullReconstructTerm2 (curThreadFpBinaryTerm op) arg1 arg2
-fullReconstructTerm (FPRoundingUnaryTerm _ _ _ _ op mode arg) =
-  introSupportedPrimConstraint mode $
-    fullReconstructTerm2 (curThreadFpRoundingUnaryTerm op) mode arg
-fullReconstructTerm (FPRoundingBinaryTerm _ _ _ _ op mode arg1 arg2) =
-  introSupportedPrimConstraint mode $
-    fullReconstructTerm3 (curThreadFpRoundingBinaryTerm op) mode arg1 arg2
-fullReconstructTerm (FPFMATerm _ _ _ _ mode arg1 arg2 arg3) =
-  introSupportedPrimConstraint mode $ do
-    rmode <- fullReconstructTerm mode
-    rarg1 <- fullReconstructTerm arg1
-    rarg2 <- fullReconstructTerm arg2
-    rarg3 <- fullReconstructTerm arg3
-    curThreadFpFMATerm rmode rarg1 rarg2 rarg3
-fullReconstructTerm (FromIntegralTerm _ _ _ _ arg) =
-  fullReconstructTerm1 curThreadFromIntegralTerm arg
-fullReconstructTerm (FromFPOrTerm _ _ _ _ d r arg) =
-  introSupportedPrimConstraint r $
-    introSupportedPrimConstraint arg $
-      fullReconstructTerm3 curThreadFromFPOrTerm d r arg
-fullReconstructTerm (ToFPTerm _ _ _ _ r arg _ _) =
-  introSupportedPrimConstraint r $
-    fullReconstructTerm2 curThreadToFPTerm r arg
-
-toCurThreadImpl :: forall t. WeakThreadId -> Term t -> IO (Term t)
-toCurThreadImpl tid t | termThreadId t == tid = return t
-toCurThreadImpl _ t = fullReconstructTerm t
-{-# INLINE toCurThreadImpl #-}
-
--- | Convert a term to the current thread.
-toCurThread :: forall t. Term t -> IO (Term t)
-toCurThread t = do
-  tid <- myWeakThreadId
-  toCurThreadImpl tid t
-{-# INLINE toCurThread #-}
-
--- | Construct and internalizing a 'ConTerm'.
-curThreadConTerm :: forall t. (SupportedPrim t) => t -> IO (Term t)
-curThreadConTerm t =
-  withSupportedPrimTypeable @t $
-    intern $
-      UConTerm t
-{-# INLINE curThreadConTerm #-}
-
--- | Construct and internalizing a 'SymTerm'.
-curThreadSymTerm :: forall knd t. TypedSymbol knd t -> IO (Term t)
-curThreadSymTerm (TypedSymbol s) =
-  withSupportedPrimTypeable @t $ intern $ USymTerm $ TypedSymbol s
-{-# INLINE curThreadSymTerm #-}
-
--- | Construct and internalizing a 'ForallTerm'.
-curThreadForallTerm ::
-  TypedSymbol 'ConstantKind t ->
-  Term Bool ->
-  IO (Term Bool)
-curThreadForallTerm sym arg = intern $ UForallTerm sym arg
-{-# INLINE curThreadForallTerm #-}
-
--- | Construct and internalizing a 'ExistsTerm'.
-curThreadExistsTerm ::
-  TypedSymbol 'ConstantKind t ->
-  Term Bool ->
-  IO (Term Bool)
-curThreadExistsTerm sym arg = intern $ UExistsTerm sym arg
-{-# INLINE curThreadExistsTerm #-}
-
--- | Construct and internalizing a 'SymTerm' with an identifier, using simple
--- symbols.
-curThreadSsymTerm :: (SupportedPrim t) => Identifier -> IO (Term t)
-curThreadSsymTerm ident =
-  curThreadSymTerm @AnyKind $ TypedSymbol $ SimpleSymbol ident
-{-# INLINE curThreadSsymTerm #-}
-
--- | Construct and internalizing a 'SymTerm' with an identifier and an index,
--- using indexed symbols.
-curThreadIsymTerm :: (SupportedPrim t) => Identifier -> Int -> IO (Term t)
-curThreadIsymTerm str idx =
-  curThreadSymTerm @AnyKind $ TypedSymbol $ IndexedSymbol str idx
-{-# INLINE curThreadIsymTerm #-}
-
--- | Construct and internalizing a 'NotTerm'.
-curThreadNotTerm :: Term Bool -> IO (Term Bool)
-curThreadNotTerm = intern . UNotTerm
-{-# INLINE curThreadNotTerm #-}
-
--- | Construct and internalizing a 'OrTerm'.
-curThreadOrTerm :: Term Bool -> Term Bool -> IO (Term Bool)
-curThreadOrTerm l r = intern $ UOrTerm l r
-{-# INLINE curThreadOrTerm #-}
-
--- | Construct and internalizing a 'AndTerm'.
-curThreadAndTerm :: Term Bool -> Term Bool -> IO (Term Bool)
-curThreadAndTerm l r = intern $ UAndTerm l r
-{-# INLINE curThreadAndTerm #-}
-
--- | Construct and internalizing a 'EqTerm'.
-curThreadEqTerm :: Term a -> Term a -> IO (Term Bool)
-curThreadEqTerm l r = intern $ UEqTerm l r
-{-# INLINE curThreadEqTerm #-}
-
--- | Construct and internalizing a 'DistinctTerm'.
-curThreadDistinctTerm :: NonEmpty (Term a) -> IO (Term Bool)
-curThreadDistinctTerm args = intern $ UDistinctTerm args
-{-# INLINE curThreadDistinctTerm #-}
-
--- | Construct and internalizing a 'ITETerm'.
-curThreadIteTerm :: Term Bool -> Term a -> Term a -> IO (Term a)
-curThreadIteTerm c l r =
-  introSupportedPrimConstraint l $
-    intern $
-      UITETerm c l r
-{-# INLINE curThreadIteTerm #-}
-
--- | Construct and internalizing a 'AddNumTerm'.
-curThreadAddNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> IO (Term a)
-curThreadAddNumTerm l r =
-  introSupportedPrimConstraint l $ intern $ UAddNumTerm l r
-{-# INLINE curThreadAddNumTerm #-}
-
--- | Construct and internalizing a 'NegNumTerm'.
-curThreadNegNumTerm :: (PEvalNumTerm a) => Term a -> IO (Term a)
-curThreadNegNumTerm l = introSupportedPrimConstraint l $ intern $ UNegNumTerm l
-{-# INLINE curThreadNegNumTerm #-}
-
--- | Construct and internalizing a 'MulNumTerm'.
-curThreadMulNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> IO (Term a)
-curThreadMulNumTerm l r =
-  introSupportedPrimConstraint l $ intern $ UMulNumTerm l r
-{-# INLINE curThreadMulNumTerm #-}
-
--- | Construct and internalizing a 'AbsNumTerm'.
-curThreadAbsNumTerm :: (PEvalNumTerm a) => Term a -> IO (Term a)
-curThreadAbsNumTerm l = introSupportedPrimConstraint l $ intern $ UAbsNumTerm l
-{-# INLINE curThreadAbsNumTerm #-}
-
--- | Construct and internalizing a 'SignumNumTerm'.
-curThreadSignumNumTerm :: (PEvalNumTerm a) => Term a -> IO (Term a)
-curThreadSignumNumTerm l =
-  introSupportedPrimConstraint l $ intern $ USignumNumTerm l
-{-# INLINE curThreadSignumNumTerm #-}
-
--- | Construct and internalizing a 'LtOrdTerm'.
-curThreadLtOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> IO (Term Bool)
-curThreadLtOrdTerm l r =
-  introSupportedPrimConstraint l $ intern $ ULtOrdTerm l r
-{-# INLINE curThreadLtOrdTerm #-}
-
--- | Construct and internalizing a 'LeOrdTerm'.
-curThreadLeOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> IO (Term Bool)
-curThreadLeOrdTerm l r =
-  introSupportedPrimConstraint l $ intern $ ULeOrdTerm l r
-{-# INLINE curThreadLeOrdTerm #-}
-
--- | Construct and internalizing a 'AndBitsTerm'.
-curThreadAndBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> IO (Term a)
-curThreadAndBitsTerm l r =
-  introSupportedPrimConstraint l $ intern $ UAndBitsTerm l r
-{-# INLINE curThreadAndBitsTerm #-}
-
--- | Construct and internalizing a 'OrBitsTerm'.
-curThreadOrBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> IO (Term a)
-curThreadOrBitsTerm l r =
-  introSupportedPrimConstraint l $ intern $ UOrBitsTerm l r
-{-# INLINE curThreadOrBitsTerm #-}
-
--- | Construct and internalizing a 'XorBitsTerm'.
-curThreadXorBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> IO (Term a)
-curThreadXorBitsTerm l r =
-  introSupportedPrimConstraint l $ intern $ UXorBitsTerm l r
-{-# INLINE curThreadXorBitsTerm #-}
-
--- | Construct and internalizing a 'ComplementBitsTerm'.
-curThreadComplementBitsTerm :: (PEvalBitwiseTerm a) => Term a -> IO (Term a)
-curThreadComplementBitsTerm l =
-  introSupportedPrimConstraint l $ intern $ UComplementBitsTerm l
-{-# INLINE curThreadComplementBitsTerm #-}
-
--- | Construct and internalizing a 'ShiftLeftTerm'.
-curThreadShiftLeftTerm :: (PEvalShiftTerm a) => Term a -> Term a -> IO (Term a)
-curThreadShiftLeftTerm t n =
-  introSupportedPrimConstraint t $ intern $ UShiftLeftTerm t n
-{-# INLINE curThreadShiftLeftTerm #-}
-
--- | Construct and internalizing a 'ShiftRightTerm'.
-curThreadShiftRightTerm :: (PEvalShiftTerm a) => Term a -> Term a -> IO (Term a)
-curThreadShiftRightTerm t n =
-  introSupportedPrimConstraint t $ intern $ UShiftRightTerm t n
-{-# INLINE curThreadShiftRightTerm #-}
-
--- | Construct and internalizing a 'RotateLeftTerm'.
-curThreadRotateLeftTerm ::
-  (PEvalRotateTerm a) => Term a -> Term a -> IO (Term a)
-curThreadRotateLeftTerm t n =
-  introSupportedPrimConstraint t $ intern $ URotateLeftTerm t n
-{-# INLINE curThreadRotateLeftTerm #-}
-
--- | Construct and internalizing a 'RotateRightTerm'.
-curThreadRotateRightTerm ::
-  (PEvalRotateTerm a) => Term a -> Term a -> IO (Term a)
-curThreadRotateRightTerm t n =
-  introSupportedPrimConstraint t $ intern $ URotateRightTerm t n
-{-# INLINE curThreadRotateRightTerm #-}
-
--- | Construct and internalizing a 'BitCastTerm'.
-curThreadBitCastTerm ::
-  forall a b.
-  (SupportedPrim b, PEvalBitCastTerm a b) =>
-  Term a ->
-  IO (Term b)
-curThreadBitCastTerm =
-  withSupportedPrimTypeable @b $
-    intern . UBitCastTerm
-{-# INLINE curThreadBitCastTerm #-}
-
--- | Construct and internalizing a 'BitCastOrTerm'.
-curThreadBitCastOrTerm ::
-  (PEvalBitCastOrTerm a b) =>
-  Term b ->
-  Term a ->
-  IO (Term b)
-curThreadBitCastOrTerm d a =
-  introSupportedPrimConstraint d $ intern $ UBitCastOrTerm d a
-{-# INLINE curThreadBitCastOrTerm #-}
-
--- | Construct and internalizing a 'BVConcatTerm'.
-curThreadBVConcatTerm ::
-  forall bv l r.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    KnownNat (l + r),
-    1 <= l,
-    1 <= r,
-    1 <= l + r,
-    SupportedPrim (bv (l + r))
-  ) =>
-  Term (bv l) ->
-  Term (bv r) ->
-  IO (Term (bv (l + r)))
-curThreadBVConcatTerm l r =
-  withSupportedPrimTypeable @(bv (l + r)) $ intern $ UBVConcatTerm l r
-{-# INLINE curThreadBVConcatTerm #-}
-
--- | Construct and internalizing a 'BVSelectTerm'.
-curThreadBVSelectTerm ::
-  forall bv n ix w p q.
-  ( PEvalBVTerm bv,
-    KnownNat n,
-    KnownNat ix,
-    KnownNat w,
-    1 <= n,
-    1 <= w,
-    ix + w <= n,
-    SupportedPrim (bv w)
-  ) =>
-  p ix ->
-  q w ->
-  Term (bv n) ->
-  IO (Term (bv w))
-curThreadBVSelectTerm _ _ v =
-  withSupportedPrimTypeable @(bv w) $
-    intern $
-      UBVSelectTerm (Proxy @ix) (Proxy @w) v
-{-# INLINE curThreadBVSelectTerm #-}
-
--- | Construct and internalizing a 'BVExtendTerm'.
-curThreadBVExtendTerm ::
-  forall bv l r proxy.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    SupportedPrim (bv r)
-  ) =>
-  Bool ->
-  proxy r ->
-  Term (bv l) ->
-  IO (Term (bv r))
-curThreadBVExtendTerm signed _ v =
-  withSupportedPrimTypeable @(bv r) $
-    intern $
-      UBVExtendTerm signed (Proxy @r) v
-{-# INLINE curThreadBVExtendTerm #-}
-
--- | Construct and internalizing a 'BVExtendTerm' with sign extension.
-curThreadBvsignExtendTerm ::
-  forall bv l r proxy.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    SupportedPrim (bv r)
-  ) =>
-  proxy r ->
-  Term (bv l) ->
-  IO (Term (bv r))
-curThreadBvsignExtendTerm _ v =
-  withSupportedPrimTypeable @(bv r) $
-    intern $
-      UBVExtendTerm True (Proxy @r) v
-{-# INLINE curThreadBvsignExtendTerm #-}
-
--- | Construct and internalizing a 'BVExtendTerm' with zero extension.
-curThreadBvzeroExtendTerm ::
-  forall bv l r proxy.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    SupportedPrim (bv r)
-  ) =>
-  proxy r ->
-  Term (bv l) ->
-  IO (Term (bv r))
-curThreadBvzeroExtendTerm _ v =
-  withSupportedPrimTypeable @(bv r) $
-    intern $
-      UBVExtendTerm False (Proxy @r) v
-{-# INLINE curThreadBvzeroExtendTerm #-}
-
--- | Construct and internalizing a 'ApplyTerm'.
-curThreadApplyTerm ::
-  forall f a b.
-  (PEvalApplyTerm f a b, SupportedPrim b) =>
-  Term f ->
-  Term a ->
-  IO (Term b)
-curThreadApplyTerm f a =
-  withSupportedPrimTypeable @b $
-    intern $
-      UApplyTerm f a
-{-# INLINE curThreadApplyTerm #-}
-
--- | Construct and internalizing a 'DivIntegralTerm'.
-curThreadDivIntegralTerm ::
-  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
-curThreadDivIntegralTerm l r =
-  introSupportedPrimConstraint l $ intern $ UDivIntegralTerm l r
-{-# INLINE curThreadDivIntegralTerm #-}
-
--- | Construct and internalizing a 'ModIntegralTerm'.
-curThreadModIntegralTerm ::
-  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
-curThreadModIntegralTerm l r =
-  introSupportedPrimConstraint l $ intern $ UModIntegralTerm l r
-{-# INLINE curThreadModIntegralTerm #-}
-
--- | Construct and internalizing a 'QuotIntegralTerm'.
-curThreadQuotIntegralTerm ::
-  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
-curThreadQuotIntegralTerm l r =
-  introSupportedPrimConstraint l $ intern $ UQuotIntegralTerm l r
-{-# INLINE curThreadQuotIntegralTerm #-}
-
--- | Construct and internalizing a 'RemIntegralTerm'.
-curThreadRemIntegralTerm ::
-  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
-curThreadRemIntegralTerm l r =
-  introSupportedPrimConstraint l $ intern $ URemIntegralTerm l r
-{-# INLINE curThreadRemIntegralTerm #-}
-
--- | Construct and internalizing a 'FPTraitTerm'.
-curThreadFpTraitTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPTrait ->
-  Term (FP eb sb) ->
-  IO (Term Bool)
-curThreadFpTraitTerm trait v = intern $ UFPTraitTerm trait v
-{-# INLINE curThreadFpTraitTerm #-}
-
--- | Construct and internalizing a 'FdivTerm'.
-curThreadFdivTerm :: (PEvalFractionalTerm a) => Term a -> Term a -> IO (Term a)
-curThreadFdivTerm l r = introSupportedPrimConstraint l $ intern $ UFdivTerm l r
-{-# INLINE curThreadFdivTerm #-}
-
--- | Construct and internalizing a 'RecipTerm'.
-curThreadRecipTerm :: (PEvalFractionalTerm a) => Term a -> IO (Term a)
-curThreadRecipTerm l = introSupportedPrimConstraint l $ intern $ URecipTerm l
-{-# INLINE curThreadRecipTerm #-}
-
--- | Construct and internalizing a 'FloatingUnaryTerm'.
-curThreadFloatingUnaryTerm ::
-  (PEvalFloatingTerm a) => FloatingUnaryOp -> Term a -> IO (Term a)
-curThreadFloatingUnaryTerm op a =
-  introSupportedPrimConstraint a $ intern $ UFloatingUnaryTerm op a
-{-# INLINE curThreadFloatingUnaryTerm #-}
-
--- | Construct and internalizing a 'PowerTerm'.
-curThreadPowerTerm :: (PEvalFloatingTerm a) => Term a -> Term a -> IO (Term a)
-curThreadPowerTerm l r =
-  introSupportedPrimConstraint l $ intern $ UPowerTerm l r
-{-# INLINE curThreadPowerTerm #-}
-
--- | Construct and internalizing a 'FPUnaryTerm'.
-curThreadFpUnaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPUnaryOp ->
-  Term (FP eb sb) ->
-  IO (Term (FP eb sb))
-curThreadFpUnaryTerm op v = intern $ UFPUnaryTerm op v
-{-# INLINE curThreadFpUnaryTerm #-}
-
--- | Construct and internalizing a 'FPBinaryTerm'.
-curThreadFpBinaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPBinaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  IO (Term (FP eb sb))
-curThreadFpBinaryTerm op l r = intern $ UFPBinaryTerm op l r
-{-# INLINE curThreadFpBinaryTerm #-}
-
--- | Construct and internalizing a 'FPRoundingUnaryTerm'.
-curThreadFpRoundingUnaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPRoundingUnaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  IO (Term (FP eb sb))
-curThreadFpRoundingUnaryTerm op mode v = intern $ UFPRoundingUnaryTerm op mode v
-{-# INLINE curThreadFpRoundingUnaryTerm #-}
-
--- | Construct and internalizing a 'FPRoundingBinaryTerm'.
-curThreadFpRoundingBinaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPRoundingBinaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  IO (Term (FP eb sb))
-curThreadFpRoundingBinaryTerm op mode l r =
-  intern $ UFPRoundingBinaryTerm op mode l r
-{-# INLINE curThreadFpRoundingBinaryTerm #-}
-
--- | Construct and internalizing a 'FPFMATerm'.
-curThreadFpFMATerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  IO (Term (FP eb sb))
-curThreadFpFMATerm mode l r s = intern $ UFPFMATerm mode l r s
-{-# INLINE curThreadFpFMATerm #-}
-
--- | Construct and internalizing a 'FromIntegralTerm'.
-curThreadFromIntegralTerm ::
-  forall a b.
-  (PEvalFromIntegralTerm a b, SupportedPrim b) =>
-  Term a ->
-  IO (Term b)
-curThreadFromIntegralTerm =
-  withSupportedPrimTypeable @b $ intern . UFromIntegralTerm
-{-# INLINE curThreadFromIntegralTerm #-}
-
--- | Construct and internalizing a 'FromFPOrTerm'.
-curThreadFromFPOrTerm ::
-  forall a eb sb.
-  ( PEvalIEEEFPConvertibleTerm a,
-    ValidFP eb sb
-  ) =>
-  Term a ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  IO (Term a)
-curThreadFromFPOrTerm d r f =
-  introSupportedPrimConstraint d $
-    withSupportedPrimTypeable @a $
-      intern $
-        UFromFPOrTerm d r f
-{-# INLINE curThreadFromFPOrTerm #-}
-
--- | Construct and internalizing a 'ToFPTerm'.
-curThreadToFPTerm ::
-  forall a eb sb.
-  ( PEvalIEEEFPConvertibleTerm a,
-    ValidFP eb sb,
-    SupportedPrim (FP eb sb)
-  ) =>
-  Term FPRoundingMode ->
-  Term a ->
-  IO (Term (FP eb sb))
-curThreadToFPTerm r f = intern $ UToFPTerm r f (Proxy @eb) (Proxy @sb)
-{-# INLINE curThreadToFPTerm #-}
-
-inCurThread1 ::
-  forall a b.
-  (Term a -> IO (Term b)) ->
-  Term a ->
-  IO (Term b)
-inCurThread1 f t = do
-  tid <- myWeakThreadId
-  toCurThreadImpl tid t >>= f
-{-# INLINE inCurThread1 #-}
-
-inCurThread2 ::
-  forall a b c.
-  (Term a -> Term b -> IO (Term c)) ->
-  Term a ->
-  Term b ->
-  IO (Term c)
-inCurThread2 f a b = do
-  tid <- myWeakThreadId
-  ra <- toCurThreadImpl tid a
-  rb <- toCurThreadImpl tid b
-  f ra rb
-{-# INLINE inCurThread2 #-}
-
-inCurThread3 ::
-  forall a b c d.
-  (Term a -> Term b -> Term c -> IO (Term d)) ->
-  Term a ->
-  Term b ->
-  Term c ->
-  IO (Term d)
-inCurThread3 f a b c = do
-  tid <- myWeakThreadId
-  ra <- toCurThreadImpl tid a
-  rb <- toCurThreadImpl tid b
-  rc <- toCurThreadImpl tid c
-  f ra rb rc
-{-# INLINE inCurThread3 #-}
-
-unsafeInCurThread1 ::
-  forall a b.
-  (Term a -> IO (Term b)) ->
-  Term a ->
-  Term b
-unsafeInCurThread1 f = unsafePerformIO . inCurThread1 f
-{-# NOINLINE unsafeInCurThread1 #-}
-
-unsafeInCurThread2 ::
-  forall a b c.
-  (Term a -> Term b -> IO (Term c)) ->
-  Term a ->
-  Term b ->
-  Term c
-unsafeInCurThread2 f a b = unsafePerformIO $ inCurThread2 f a b
-{-# NOINLINE unsafeInCurThread2 #-}
-
-unsafeInCurThread3 ::
-  forall a b c d.
-  (Term a -> Term b -> Term c -> IO (Term d)) ->
-  Term a ->
-  Term b ->
-  Term c ->
-  Term d
-unsafeInCurThread3 f a b c = unsafePerformIO $ inCurThread3 f a b c
-{-# NOINLINE unsafeInCurThread3 #-}
-
--- | Construct and internalizing a 'ConTerm'.
-conTerm :: (SupportedPrim t) => t -> Term t
-conTerm = unsafePerformIO . curThreadConTerm
-{-# NOINLINE conTerm #-}
-
--- | Construct and internalizing a 'SymTerm'.
-symTerm :: TypedSymbol knd t -> Term t
-symTerm = unsafePerformIO . curThreadSymTerm
-{-# NOINLINE symTerm #-}
-
--- | Construct and internalizing a 'ForallTerm'.
-forallTerm ::
-  TypedSymbol 'ConstantKind t ->
-  Term Bool ->
-  Term Bool
-forallTerm sym@TypedSymbol {} = unsafeInCurThread1 (curThreadForallTerm sym)
-{-# NOINLINE forallTerm #-}
-
--- | Construct and internalizing a 'ExistsTerm'.
-existsTerm ::
-  TypedSymbol 'ConstantKind t ->
-  Term Bool ->
-  Term Bool
-existsTerm sym@TypedSymbol {} = unsafeInCurThread1 (curThreadExistsTerm sym)
-{-# NOINLINE existsTerm #-}
-
--- | Construct and internalizing a 'SymTerm' with an identifier, using simple
--- symbols.
-ssymTerm :: (SupportedPrim t) => Identifier -> Term t
-ssymTerm = unsafePerformIO . curThreadSsymTerm
-{-# NOINLINE ssymTerm #-}
-
--- | Construct and internalizing a 'SymTerm' with an identifier and an index,
--- using indexed symbols.
-isymTerm :: (SupportedPrim t) => Identifier -> Int -> Term t
-isymTerm ident index = unsafePerformIO $ curThreadIsymTerm ident index
-{-# NOINLINE isymTerm #-}
-
--- | Construct and internalizing a 'NotTerm'.
-notTerm :: Term Bool -> Term Bool
-notTerm = unsafeInCurThread1 curThreadNotTerm
-{-# NOINLINE notTerm #-}
-
--- | Construct and internalizing a 'OrTerm'.
-orTerm :: Term Bool -> Term Bool -> Term Bool
-orTerm = unsafeInCurThread2 curThreadOrTerm
-{-# NOINLINE orTerm #-}
-
--- | Construct and internalizing a 'AndTerm'.
-andTerm :: Term Bool -> Term Bool -> Term Bool
-andTerm = unsafeInCurThread2 curThreadAndTerm
-{-# NOINLINE andTerm #-}
-
--- | Construct and internalizing a 'EqTerm'.
-eqTerm :: Term a -> Term a -> Term Bool
-eqTerm = unsafeInCurThread2 curThreadEqTerm
-{-# NOINLINE eqTerm #-}
-
--- | Construct and internalizing a 'DistinctTerm'.
-distinctTerm :: NonEmpty (Term a) -> Term Bool
-distinctTerm args =
-  unsafePerformIO $ do
-    tid <- myWeakThreadId
-    traverse (toCurThreadImpl tid) args >>= curThreadDistinctTerm
-{-# NOINLINE distinctTerm #-}
-
--- | Construct and internalizing a 'ITETerm'.
-iteTerm :: Term Bool -> Term a -> Term a -> Term a
-iteTerm = unsafeInCurThread3 curThreadIteTerm
-{-# NOINLINE iteTerm #-}
-
--- | Construct and internalizing a 'AddNumTerm'.
-addNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> Term a
-addNumTerm = unsafeInCurThread2 curThreadAddNumTerm
-{-# NOINLINE addNumTerm #-}
-
--- | Construct and internalizing a 'NegNumTerm'.
-negNumTerm :: (PEvalNumTerm a) => Term a -> Term a
-negNumTerm = unsafeInCurThread1 curThreadNegNumTerm
-{-# NOINLINE negNumTerm #-}
-
--- | Construct and internalizing a 'MulNumTerm'.
-mulNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> Term a
-mulNumTerm = unsafeInCurThread2 curThreadMulNumTerm
-{-# NOINLINE mulNumTerm #-}
-
--- | Construct and internalizing a 'AbsNumTerm'.
-absNumTerm :: (PEvalNumTerm a) => Term a -> Term a
-absNumTerm = unsafeInCurThread1 curThreadAbsNumTerm
-{-# NOINLINE absNumTerm #-}
-
--- | Construct and internalizing a 'SignumNumTerm'.
-signumNumTerm :: (PEvalNumTerm a) => Term a -> Term a
-signumNumTerm = unsafeInCurThread1 curThreadSignumNumTerm
-{-# NOINLINE signumNumTerm #-}
-
--- | Construct and internalizing a 'LtOrdTerm'.
-ltOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
-ltOrdTerm = unsafeInCurThread2 curThreadLtOrdTerm
-{-# NOINLINE ltOrdTerm #-}
-
--- | Construct and internalizing a 'LeOrdTerm'.
-leOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
-leOrdTerm = unsafeInCurThread2 curThreadLeOrdTerm
-{-# NOINLINE leOrdTerm #-}
-
--- | Construct and internalizing a 'AndBitsTerm'.
-andBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> Term a
-andBitsTerm = unsafeInCurThread2 curThreadAndBitsTerm
-{-# NOINLINE andBitsTerm #-}
-
--- | Construct and internalizing a 'OrBitsTerm'.
-orBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> Term a
-orBitsTerm = unsafeInCurThread2 curThreadOrBitsTerm
-{-# NOINLINE orBitsTerm #-}
-
--- | Construct and internalizing a 'XorBitsTerm'.
-xorBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> Term a
-xorBitsTerm = unsafeInCurThread2 curThreadXorBitsTerm
-{-# NOINLINE xorBitsTerm #-}
-
--- | Construct and internalizing a 'ComplementBitsTerm'.
-complementBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a
-complementBitsTerm = unsafeInCurThread1 curThreadComplementBitsTerm
-{-# NOINLINE complementBitsTerm #-}
-
--- | Construct and internalizing a 'ShiftLeftTerm'.
-shiftLeftTerm :: (PEvalShiftTerm a) => Term a -> Term a -> Term a
-shiftLeftTerm = unsafeInCurThread2 curThreadShiftLeftTerm
-{-# NOINLINE shiftLeftTerm #-}
-
--- | Construct and internalizing a 'ShiftRightTerm'.
-shiftRightTerm :: (PEvalShiftTerm a) => Term a -> Term a -> Term a
-shiftRightTerm = unsafeInCurThread2 curThreadShiftRightTerm
-{-# NOINLINE shiftRightTerm #-}
-
--- | Construct and internalizing a 'RotateLeftTerm'.
-rotateLeftTerm :: (PEvalRotateTerm a) => Term a -> Term a -> Term a
-rotateLeftTerm = unsafeInCurThread2 curThreadRotateLeftTerm
-{-# NOINLINE rotateLeftTerm #-}
-
--- | Construct and internalizing a 'RotateRightTerm'.
-rotateRightTerm :: (PEvalRotateTerm a) => Term a -> Term a -> Term a
-rotateRightTerm = unsafeInCurThread2 curThreadRotateRightTerm
-{-# NOINLINE rotateRightTerm #-}
-
--- | Construct and internalizing a 'BitCastTerm'.
-bitCastTerm ::
-  (PEvalBitCastTerm a b, SupportedPrim b) =>
-  Term a ->
-  Term b
-bitCastTerm = unsafeInCurThread1 curThreadBitCastTerm
-{-# NOINLINE bitCastTerm #-}
-
--- | Construct and internalizing a 'BitCastOrTerm'.
-bitCastOrTerm ::
-  (PEvalBitCastOrTerm a b) =>
-  Term b ->
-  Term a ->
-  Term b
-bitCastOrTerm = unsafeInCurThread2 curThreadBitCastOrTerm
-{-# NOINLINE bitCastOrTerm #-}
-
--- | Construct and internalizing a 'BVConcatTerm'.
-bvConcatTerm ::
-  forall bv l r.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    KnownNat (l + r),
-    1 <= l,
-    1 <= r,
-    1 <= l + r,
-    SupportedPrim (bv (l + r))
-  ) =>
-  Term (bv l) ->
-  Term (bv r) ->
-  Term (bv (l + r))
-bvConcatTerm = unsafeInCurThread2 curThreadBVConcatTerm
-{-# NOINLINE bvConcatTerm #-}
-
--- | Construct and internalizing a 'BVSelectTerm'.
-bvSelectTerm ::
-  forall bv n ix w p q.
-  ( PEvalBVTerm bv,
-    KnownNat n,
-    KnownNat ix,
-    KnownNat w,
-    1 <= n,
-    1 <= w,
-    ix + w <= n,
-    SupportedPrim (bv w)
-  ) =>
-  p ix ->
-  q w ->
-  Term (bv n) ->
-  Term (bv w)
-bvSelectTerm ix w = unsafeInCurThread1 (curThreadBVSelectTerm ix w)
-{-# NOINLINE bvSelectTerm #-}
-
--- | Construct and internalizing a 'BVExtendTerm'.
-bvExtendTerm ::
-  forall bv l r proxy.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    SupportedPrim (bv r)
-  ) =>
-  Bool ->
-  proxy r ->
-  Term (bv l) ->
-  Term (bv r)
-bvExtendTerm signed r = unsafeInCurThread1 (curThreadBVExtendTerm signed r)
-{-# NOINLINE bvExtendTerm #-}
-
--- | Construct and internalizing a 'BVExtendTerm' with sign extension.
-bvsignExtendTerm ::
-  forall bv l r proxy.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    SupportedPrim (bv r)
-  ) =>
-  proxy r ->
-  Term (bv l) ->
-  Term (bv r)
-bvsignExtendTerm r = unsafeInCurThread1 (curThreadBvsignExtendTerm r)
-{-# NOINLINE bvsignExtendTerm #-}
-
--- | Construct and internalizing a 'BVExtendTerm' with zero extension.
-bvzeroExtendTerm ::
-  forall bv l r proxy.
-  ( PEvalBVTerm bv,
-    KnownNat l,
-    KnownNat r,
-    1 <= l,
-    1 <= r,
-    l <= r,
-    SupportedPrim (bv r)
-  ) =>
-  proxy r ->
-  Term (bv l) ->
-  Term (bv r)
-bvzeroExtendTerm r = unsafeInCurThread1 (curThreadBvzeroExtendTerm r)
-{-# NOINLINE bvzeroExtendTerm #-}
-
--- | Construct and internalizing a 'ApplyTerm'.
-applyTerm ::
-  (PEvalApplyTerm f a b, SupportedPrim b) => Term f -> Term a -> Term b
-applyTerm = unsafeInCurThread2 curThreadApplyTerm
-{-# NOINLINE applyTerm #-}
-
--- | Construct and internalizing a 'DivIntegralTerm'.
-divIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
-divIntegralTerm = unsafeInCurThread2 curThreadDivIntegralTerm
-{-# NOINLINE divIntegralTerm #-}
-
--- | Construct and internalizing a 'ModIntegralTerm'.
-modIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
-modIntegralTerm = unsafeInCurThread2 curThreadModIntegralTerm
-{-# NOINLINE modIntegralTerm #-}
-
--- | Construct and internalizing a 'QuotIntegralTerm'.
-quotIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
-quotIntegralTerm = unsafeInCurThread2 curThreadQuotIntegralTerm
-{-# NOINLINE quotIntegralTerm #-}
-
--- | Construct and internalizing a 'RemIntegralTerm'.
-remIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
-remIntegralTerm = unsafeInCurThread2 curThreadRemIntegralTerm
-{-# NOINLINE remIntegralTerm #-}
-
--- | Construct and internalizing a 'FPTraitTerm'.
-fpTraitTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPTrait ->
-  Term (FP eb sb) ->
-  Term Bool
-fpTraitTerm trait = unsafeInCurThread1 (curThreadFpTraitTerm trait)
-{-# NOINLINE fpTraitTerm #-}
-
--- | Construct and internalizing a 'FdivTerm'.
-fdivTerm :: (PEvalFractionalTerm a) => Term a -> Term a -> Term a
-fdivTerm = unsafeInCurThread2 curThreadFdivTerm
-{-# NOINLINE fdivTerm #-}
-
--- | Construct and internalizing a 'RecipTerm'.
-recipTerm :: (PEvalFractionalTerm a) => Term a -> Term a
-recipTerm = unsafeInCurThread1 curThreadRecipTerm
-{-# NOINLINE recipTerm #-}
-
--- | Construct and internalizing a 'FloatingUnaryTerm'.
-floatingUnaryTerm :: (PEvalFloatingTerm a) => FloatingUnaryOp -> Term a -> Term a
-floatingUnaryTerm op = unsafeInCurThread1 (curThreadFloatingUnaryTerm op)
-{-# NOINLINE floatingUnaryTerm #-}
-
--- | Construct and internalizing a 'PowerTerm'.
-powerTerm :: (PEvalFloatingTerm a) => Term a -> Term a -> Term a
-powerTerm = unsafeInCurThread2 curThreadPowerTerm
-{-# NOINLINE powerTerm #-}
-
--- | Construct and internalizing a 'FPUnaryTerm'.
-fpUnaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPUnaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-fpUnaryTerm op = unsafeInCurThread1 (curThreadFpUnaryTerm op)
-{-# NOINLINE fpUnaryTerm #-}
-
--- | Construct and internalizing a 'FPBinaryTerm'.
-fpBinaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPBinaryOp ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-fpBinaryTerm op = unsafeInCurThread2 (curThreadFpBinaryTerm op)
-{-# NOINLINE fpBinaryTerm #-}
-
--- | Construct and internalizing a 'FPRoundingUnaryTerm'.
-fpRoundingUnaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPRoundingUnaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-fpRoundingUnaryTerm op = unsafeInCurThread2 (curThreadFpRoundingUnaryTerm op)
-{-# NOINLINE fpRoundingUnaryTerm #-}
-
--- | Construct and internalizing a 'FPRoundingBinaryTerm'.
-fpRoundingBinaryTerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  FPRoundingBinaryOp ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-fpRoundingBinaryTerm op = unsafeInCurThread3 (curThreadFpRoundingBinaryTerm op)
-{-# NOINLINE fpRoundingBinaryTerm #-}
-
--- | Construct and internalizing a 'FPFMATerm'.
-fpFMATerm ::
-  (ValidFP eb sb, SupportedPrim (FP eb sb)) =>
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb) ->
-  Term (FP eb sb)
-fpFMATerm mode a b c = unsafePerformIO $ do
-  tid <- myWeakThreadId
-  mode' <- toCurThreadImpl tid mode
-  a' <- toCurThreadImpl tid a
-  b' <- toCurThreadImpl tid b
-  c' <- toCurThreadImpl tid c
-  curThreadFpFMATerm mode' a' b' c'
-{-# NOINLINE fpFMATerm #-}
-
--- | Construct and internalizing a 'FromIntegralTerm'.
-fromIntegralTerm ::
-  (PEvalFromIntegralTerm a b, SupportedPrim b) => Term a -> Term b
-fromIntegralTerm = unsafeInCurThread1 curThreadFromIntegralTerm
-{-# NOINLINE fromIntegralTerm #-}
-
--- | Construct and internalizing a 'FromFPOrTerm'.
-fromFPOrTerm ::
-  ( PEvalIEEEFPConvertibleTerm a,
-    ValidFP eb sb
-  ) =>
-  Term a ->
-  Term FPRoundingMode ->
-  Term (FP eb sb) ->
-  Term a
-fromFPOrTerm = unsafeInCurThread3 curThreadFromFPOrTerm
-{-# NOINLINE fromFPOrTerm #-}
-
--- | Construct and internalizing a 'ToFPTerm'.
-toFPTerm ::
-  forall a eb sb.
-  ( PEvalIEEEFPConvertibleTerm a,
-    ValidFP eb sb,
-    SupportedPrim (FP eb sb)
-  ) =>
-  Term FPRoundingMode ->
-  Term a ->
-  Term (FP eb sb)
-toFPTerm = unsafeInCurThread2 curThreadToFPTerm
-{-# NOINLINE toFPTerm #-}
-
--- Support for boolean type
-defaultValueForBool :: Bool
-defaultValueForBool = False
-
--- | Construct and internalizing 'True' term.
-trueTerm :: Term Bool
-trueTerm = conTerm True
-{-# NOINLINE trueTerm #-}
-
--- | Construct and internalizing 'False' term.
-falseTerm :: Term Bool
-falseTerm = conTerm False
-{-# NOINLINE falseTerm #-}
-
-boolConTermView :: forall a. Term a -> Maybe Bool
-boolConTermView (ConTerm _ _ _ _ b) = withSupportedPrimTypeable @a $ cast b
-boolConTermView _ = Nothing
-{-# INLINE boolConTermView #-}
-
--- | Pattern matcher for concrete 'Bool' terms.
-pattern BoolConTerm :: Bool -> Term a
-pattern BoolConTerm b <- (boolConTermView -> Just b)
-
--- | Pattern matcher for 'True' term.
-pattern TrueTerm :: Term a
-pattern TrueTerm <- BoolConTerm True
-
--- | Pattern matcher for 'False' term.
-pattern FalseTerm :: Term a
-pattern FalseTerm <- BoolConTerm False
-
-boolTermView :: forall a. Term a -> Maybe (Term Bool)
-boolTermView t = introSupportedPrimConstraint t $ cast t
-{-# INLINE boolTermView #-}
-
--- | Pattern matcher for 'Bool' terms.
-pattern BoolTerm :: Term Bool -> Term a
-pattern BoolTerm b <- (boolTermView -> Just b)
-
--- | Partial evaluation for not terms.
-pevalNotTerm :: Term Bool -> Term Bool
-pevalNotTerm (NotTerm _ _ _ _ tm) = tm
-pevalNotTerm (ConTerm _ _ _ _ a) = if a then falseTerm else trueTerm
-pevalNotTerm (OrTerm _ _ _ _ (NotTerm _ _ _ _ n1) n2) = pevalAndTerm n1 (pevalNotTerm n2)
-pevalNotTerm (OrTerm _ _ _ _ (DistinctTerm _ _ _ _ (n1 :| [n2])) n3) =
-  introSupportedPrimConstraint n1 $
-    pevalAndTerm (pevalEqTerm n1 n2) (pevalNotTerm n3)
-pevalNotTerm (OrTerm _ _ _ _ n1 (NotTerm _ _ _ _ n2)) = pevalAndTerm (pevalNotTerm n1) n2
-pevalNotTerm (OrTerm _ _ _ _ n1 (DistinctTerm _ _ _ _ (n2 :| [n3]))) =
-  introSupportedPrimConstraint n2 $
-    pevalAndTerm (pevalNotTerm n1) (pevalEqTerm n2 n3)
-pevalNotTerm (AndTerm _ _ _ _ (NotTerm _ _ _ _ n1) n2) = pevalOrTerm n1 (pevalNotTerm n2)
-pevalNotTerm (AndTerm _ _ _ _ (DistinctTerm _ _ _ _ (n1 :| [n2])) n3) =
-  introSupportedPrimConstraint n1 $
-    pevalOrTerm (pevalEqTerm n1 n2) (pevalNotTerm n3)
-pevalNotTerm (AndTerm _ _ _ _ n1 (NotTerm _ _ _ _ n2)) = pevalOrTerm (pevalNotTerm n1) n2
-pevalNotTerm (AndTerm _ _ _ _ n1 (DistinctTerm _ _ _ _ (n2 :| [n3]))) =
-  introSupportedPrimConstraint n2 $
-    pevalOrTerm (pevalNotTerm n1) $
-      pevalEqTerm n2 n3
-pevalNotTerm (EqTerm _ _ _ _ a b) = distinctTerm $ a :| [b]
-pevalNotTerm (DistinctTerm _ _ _ _ (a :| [b])) = eqTerm a b
-pevalNotTerm tm = notTerm tm
-{-# INLINEABLE pevalNotTerm #-}
-
-orEqFirst :: Term Bool -> Term Bool -> Bool
-orEqFirst _ (ConTerm _ _ _ _ False) = True
-orEqFirst
-  (DistinctTerm _ _ _ _ ((e1 :: Term a) :| [ec1@ConTerm {} :: Term b]))
-  (EqTerm _ _ _ _ (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
-    | e1 == e2 && ec1 /= ec2 = True
--- orEqFirst
---   (NotTerm _ (EqTerm _ (e1 :: Term a) (ec1@(ConTerm _ _ _) :: Term b)))
---   (EqTerm _ (Dyn (e2 :: Term a)) (Dyn (ec2@(ConTerm _ _ _) :: Term b)))
---     | e1 == e2 && ec1 /= ec2 = True
-orEqFirst x y
-  | x == y = True
-  | otherwise = False
-{-# INLINE orEqFirst #-}
-
-orEqTrue :: Term Bool -> Term Bool -> Bool
-orEqTrue (ConTerm _ _ _ _ True) ~_ = True
-orEqTrue _ (ConTerm _ _ _ _ True) = True
--- orEqTrue (NotTerm _ e1) (NotTerm _ e2) = andEqFalse e1 e2
-orEqTrue
-  (DistinctTerm _ _ _ _ ((e1 :: Term a) :| [ec1@ConTerm {} :: Term b]))
-  (DistinctTerm _ _ _ _ ((DynTerm (e2 :: Term a)) :| [DynTerm (ec2@ConTerm {} :: Term b)]))
-    | e1 == e2 && ec1 /= ec2 = True
--- orEqTrue
---   (NotTerm _ (EqTerm _ (e1 :: Term a) (ec1@(ConTerm _ _ _ _) :: Term b)))
---   (NotTerm _ (EqTerm _ (Dyn (e2 :: Term a)) (Dyn (ec2@(ConTerm _ _ _ _) :: Term b))))
---     | e1 == e2 && ec1 /= ec2 = True
-orEqTrue (NotTerm _ _ _ _ l) r | l == r = True
-orEqTrue l (NotTerm _ _ _ _ r) | l == r = True
-orEqTrue _ _ = False
-{-# INLINE orEqTrue #-}
-
-andEqFirst :: Term Bool -> Term Bool -> Bool
-andEqFirst _ (ConTerm _ _ _ _ True) = True
--- andEqFirst x (NotTerm _ y) = andEqFalse x y
-andEqFirst
-  (EqTerm _ _ _ _ (e1 :: Term a) (ec1@ConTerm {} :: Term b))
-  (DistinctTerm _ _ _ _ ((DynTerm (e2 :: Term a)) :| [DynTerm (ec2@ConTerm {} :: Term b)]))
-    | e1 == e2 && ec1 /= ec2 = True
--- andEqFirst
---   (EqTerm _ (e1 :: Term a) (ec1@(ConTerm _ _ _ _) :: Term b))
---   (NotTerm _ (EqTerm _ (Dyn (e2 :: Term a)) (Dyn (ec2@(ConTerm _ _ _ _) :: Term b))))
---     | e1 == e2 && ec1 /= ec2 = True
-andEqFirst x y
-  | x == y = True
-  | otherwise = False
-{-# INLINE andEqFirst #-}
-
-andEqFalse :: Term Bool -> Term Bool -> Bool
-andEqFalse (ConTerm _ _ _ _ False) ~_ = True
-andEqFalse _ (ConTerm _ _ _ _ False) = True
--- andEqFalse (NotTerm _ e1) (NotTerm _ e2) = orEqTrue e1 e2
-andEqFalse
-  (EqTerm _ _ _ _ (e1 :: Term a) (ec1@ConTerm {} :: Term b))
-  (EqTerm _ _ _ _ (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
-    | e1 == e2 && ec1 /= ec2 = True
-andEqFalse (NotTerm _ _ _ _ x) y | x == y = True
-andEqFalse x (NotTerm _ _ _ _ y) | x == y = True
-andEqFalse _ _ = False
-{-# INLINE andEqFalse #-}
-
--- | Partial evaluation for or terms.
-pevalOrTerm :: Term Bool -> Term Bool -> Term Bool
-pevalOrTerm l ~r
-  | orEqTrue l r = trueTerm
-  | orEqFirst l r = l
-  | orEqFirst r l = r
-pevalOrTerm l r@(OrTerm _ _ _ _ r1 r2)
-  | orEqTrue l r1 = trueTerm
-  | orEqTrue l r2 = trueTerm
-  | orEqFirst r1 l = r
-  | orEqFirst r2 l = r
-  | orEqFirst l r1 = pevalOrTerm l r2
-  | orEqFirst l r2 = pevalOrTerm l r1
-pevalOrTerm l@(OrTerm _ _ _ _ l1 l2) r
-  | orEqTrue l1 r = trueTerm
-  | orEqTrue l2 r = trueTerm
-  | orEqFirst l1 r = l
-  | orEqFirst l2 r = l
-  | orEqFirst r l1 = pevalOrTerm l2 r
-  | orEqFirst r l2 = pevalOrTerm l1 r
-pevalOrTerm l (AndTerm _ _ _ _ r1 r2)
-  | orEqFirst l r1 = l
-  | orEqFirst l r2 = l
-  | orEqTrue l r1 = pevalOrTerm l r2
-  | orEqTrue l r2 = pevalOrTerm l r1
-pevalOrTerm (AndTerm _ _ _ _ l1 l2) r
-  | orEqFirst r l1 = r
-  | orEqFirst r l2 = r
-  | orEqTrue l1 r = pevalOrTerm l2 r
-  | orEqTrue l2 r = pevalOrTerm l1 r
-pevalOrTerm
-  (AndTerm _ _ _ _ nl1@(NotTerm _ _ _ _ l1) l2)
-  (EqTerm _ _ _ _ (DynTerm (e1 :: Term Bool)) (DynTerm (e2 :: Term Bool)))
-    | l1 == e1 && l2 == e2 = pevalOrTerm nl1 l2
-pevalOrTerm (NotTerm _ _ _ _ nl) (NotTerm _ _ _ _ nr) =
-  pevalNotTerm $ pevalAndTerm nl nr
-pevalOrTerm l r = orTerm l r
-{-# INLINEABLE pevalOrTerm #-}
-
--- | Partial evaluation for and terms.
-pevalAndTerm :: Term Bool -> Term Bool -> Term Bool
-pevalAndTerm l ~r
-  | andEqFalse l r = falseTerm
-  | andEqFirst l r = l
-  | andEqFirst r l = r
-pevalAndTerm l r@(AndTerm _ _ _ _ r1 r2)
-  | andEqFalse l r1 = falseTerm
-  | andEqFalse l r2 = falseTerm
-  | andEqFirst r1 l = r
-  | andEqFirst r2 l = r
-  | andEqFirst l r1 = pevalAndTerm l r2
-  | andEqFirst l r2 = pevalAndTerm l r1
-pevalAndTerm l@(AndTerm _ _ _ _ l1 l2) r
-  | andEqFalse l1 r = falseTerm
-  | andEqFalse l2 r = falseTerm
-  | andEqFirst l1 r = l
-  | andEqFirst l2 r = l
-  | andEqFirst r l1 = pevalAndTerm l2 r
-  | andEqFirst r l2 = pevalAndTerm l1 r
-pevalAndTerm l (OrTerm _ _ _ _ r1 r2)
-  | andEqFirst l r1 = l
-  | andEqFirst l r2 = l
-  | andEqFalse l r1 = pevalAndTerm l r2
-  | andEqFalse l r2 = pevalAndTerm l r1
-pevalAndTerm (OrTerm _ _ _ _ l1 l2) r
-  | andEqFirst r l1 = r
-  | andEqFirst r l2 = r
-  | andEqFalse l1 r = pevalAndTerm l2 r
-  | andEqFalse l2 r = pevalAndTerm l1 r
-pevalAndTerm
-  (OrTerm _ _ _ _ l1 nl2@(NotTerm _ _ _ _ l2))
-  (NotTerm _ _ _ _ (EqTerm _ _ _ _ (DynTerm (e1 :: Term Bool)) (DynTerm (e2 :: Term Bool))))
-    | l1 == e1 && l2 == e2 = pevalAndTerm l1 nl2
-pevalAndTerm (NotTerm _ _ _ _ nl) (NotTerm _ _ _ _ nr) = pevalNotTerm $ pevalOrTerm nl nr
-pevalAndTerm l r = andTerm l r
-{-# INLINEABLE pevalAndTerm #-}
-
--- | Partial evaluation for imply terms.
-pevalImplyTerm :: Term Bool -> Term Bool -> Term Bool
-pevalImplyTerm l = pevalOrTerm (pevalNotTerm l)
-
--- | Partial evaluation for xor terms.
-pevalXorTerm :: Term Bool -> Term Bool -> Term Bool
-pevalXorTerm l r = pevalOrTerm (pevalAndTerm (pevalNotTerm l) r) (pevalAndTerm l (pevalNotTerm r))
-
-pevalImpliesTerm :: Term Bool -> Term Bool -> Bool
-pevalImpliesTerm (ConTerm _ _ _ _ False) _ = True
-pevalImpliesTerm _ (ConTerm _ _ _ _ True) = True
-pevalImpliesTerm
-  (EqTerm _ _ _ _ (e1 :: Term a) (ec1@ConTerm {} :: Term b))
-  (DistinctTerm _ _ _ _ ((DynTerm (e2 :: Term a)) :| [(DynTerm (ec2@ConTerm {} :: Term b))]))
-    | e1 == e2 && ec1 /= ec2 = True
--- pevalImpliesTerm
---   (EqTerm _ (e1 :: Term a) (ec1@(ConTerm _ _ _ _) :: Term b))
---   (NotTerm _ (EqTerm _ (Dyn (e2 :: Term a)) (Dyn (ec2@(ConTerm _ _ _ _) :: Term b))))
---     | e1 == e2 && ec1 /= ec2 = True
-pevalImpliesTerm a b
-  | a == b = True
-  | otherwise = False
-{-# INLINE pevalImpliesTerm #-}
-
-pevalITEBoolLeftNot :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolLeftNot cond nIfTrue ifFalse
-  -- need test
-  | cond == nIfTrue = Just $ pevalAndTerm (pevalNotTerm cond) ifFalse
-  | otherwise = case nIfTrue of
-      AndTerm _ _ _ _ nt1 nt2 -> ra
-        where
-          ra
-            | pevalImpliesTerm cond nt1 =
-                Just $ pevalITETerm cond (pevalNotTerm nt2) ifFalse
-            | pevalImpliesTerm cond nt2 =
-                Just $ pevalITETerm cond (pevalNotTerm nt1) ifFalse
-            | pevalImpliesTerm cond (pevalNotTerm nt1)
-                || pevalImpliesTerm cond (pevalNotTerm nt2) =
-                Just $ pevalOrTerm cond ifFalse
-            | otherwise = Nothing
-      OrTerm _ _ _ _ nt1 nt2 -> ra
-        where
-          ra
-            | pevalImpliesTerm cond nt1 || pevalImpliesTerm cond nt2 =
-                Just $ pevalAndTerm (pevalNotTerm cond) ifFalse
-            | pevalImpliesTerm cond (pevalNotTerm nt1) =
-                Just $ pevalITETerm cond (pevalNotTerm nt2) ifFalse
-            | pevalImpliesTerm cond (pevalNotTerm nt2) =
-                Just $ pevalITETerm cond (pevalNotTerm nt1) ifFalse
-            | otherwise = Nothing
-      _ -> Nothing
-
-pevalITEBoolBothNot :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolBothNot cond nIfTrue nIfFalse =
-  Just $ pevalNotTerm $ pevalITETerm cond nIfTrue nIfFalse
-
-pevalITEBoolRightNot :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolRightNot cond ifTrue nIfFalse
-  -- need test
-  | cond == nIfFalse = Just $ pevalOrTerm (pevalNotTerm cond) ifTrue
-  | otherwise = Nothing -- need work
-
-pevalInferImplies :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalInferImplies cond (NotTerm _ _ _ _ nt1) _ falseRes
-  | cond == nt1 = Just falseRes
-  | otherwise = Nothing
--- \| otherwise = case (cond, nt1) of
---     ( EqTerm _ (e1 :: Term a) (ec1@(ConTerm _ _ _ _) :: Term b),
---       EqTerm _ (Dyn (e2 :: Term a)) (Dyn (ec2@(ConTerm _ _ _ _) :: Term b))
---       )
---         | e1 == e2 && ec1 /= ec2 -> Just trueRes
---     _ -> Nothing
-pevalInferImplies
-  (EqTerm _ _ _ _ (e1 :: Term a) (ec1@ConTerm {} :: Term b))
-  (DistinctTerm _ _ _ _ ((DynTerm (e2 :: Term a)) :| [DynTerm (ec2@ConTerm {} :: Term b)]))
-  trueRes
-  _
-    | e1 == e2 && ec1 /= ec2 = Just trueRes
-pevalInferImplies
-  (EqTerm _ _ _ _ (e1 :: Term a) (ec1@ConTerm {} :: Term b))
-  (EqTerm _ _ _ _ (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
-  _
-  falseRes
-    | e1 == e2 && ec1 /= ec2 = Just falseRes
-pevalInferImplies _ _ _ _ = Nothing
-
-pevalITEBoolLeftAnd :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolLeftAnd cond t1 t2 ifFalse
-  | t1 == ifFalse = Just $ pevalAndTerm t1 $ pevalImplyTerm cond t2
-  | t2 == ifFalse = Just $ pevalAndTerm t2 $ pevalImplyTerm cond t1
-  | cond == t1 = Just $ pevalITETerm cond t2 ifFalse
-  | cond == t2 = Just $ pevalITETerm cond t1 ifFalse
-  | otherwise =
-      msum
-        [ pevalInferImplies cond t1 (pevalITETerm cond t2 ifFalse) (pevalAndTerm (pevalNotTerm cond) ifFalse),
-          pevalInferImplies cond t2 (pevalITETerm cond t1 ifFalse) (pevalAndTerm (pevalNotTerm cond) ifFalse)
-        ]
-
-pevalITEBoolBothAnd :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolBothAnd cond t1 t2 f1 f2
-  | t1 == f1 = Just $ pevalAndTerm t1 $ pevalITETerm cond t2 f2
-  | t1 == f2 = Just $ pevalAndTerm t1 $ pevalITETerm cond t2 f1
-  | t2 == f1 = Just $ pevalAndTerm t2 $ pevalITETerm cond t1 f2
-  | t2 == f2 = Just $ pevalAndTerm t2 $ pevalITETerm cond t1 f1
-  | otherwise = Nothing
-
-pevalITEBoolRightAnd :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolRightAnd cond ifTrue f1 f2
-  | f1 == ifTrue = Just $ pevalAndTerm f1 $ pevalOrTerm cond f2
-  | f2 == ifTrue = Just $ pevalAndTerm f2 $ pevalOrTerm cond f1
-  | otherwise = Nothing
-
-pevalITEBoolLeftOr :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolLeftOr cond t1 t2 ifFalse
-  | t1 == ifFalse = Just $ pevalOrTerm t1 $ pevalAndTerm cond t2
-  | t2 == ifFalse = Just $ pevalOrTerm t2 $ pevalAndTerm cond t1
-  | cond == t1 = Just $ pevalOrTerm cond ifFalse
-  | cond == t2 = Just $ pevalOrTerm cond ifFalse
-  | otherwise =
-      msum
-        [ pevalInferImplies cond t1 (pevalOrTerm cond ifFalse) (pevalITETerm cond t2 ifFalse),
-          pevalInferImplies cond t2 (pevalOrTerm cond ifFalse) (pevalITETerm cond t1 ifFalse)
-        ]
-
-pevalITEBoolBothOr :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolBothOr cond t1 t2 f1 f2
-  | t1 == f1 = Just $ pevalOrTerm t1 $ pevalITETerm cond t2 f2
-  | t1 == f2 = Just $ pevalOrTerm t1 $ pevalITETerm cond t2 f1
-  | t2 == f1 = Just $ pevalOrTerm t2 $ pevalITETerm cond t1 f2
-  | t2 == f2 = Just $ pevalOrTerm t2 $ pevalITETerm cond t1 f1
-  | otherwise = Nothing
-
-pevalITEBoolRightOr :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolRightOr cond ifTrue f1 f2
-  | f1 == ifTrue = Just $ pevalOrTerm f1 $ pevalAndTerm (pevalNotTerm cond) f2
-  | f2 == ifTrue = Just $ pevalOrTerm f2 $ pevalAndTerm (pevalNotTerm cond) f1
-  | otherwise = Nothing
-
-pevalITEBoolLeft :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolLeft cond (AndTerm _ _ _ _ t1 t2) ifFalse =
-  msum
-    [ pevalITEBoolLeftAnd cond t1 t2 ifFalse,
-      case ifFalse of
-        AndTerm _ _ _ _ f1 f2 -> pevalITEBoolBothAnd cond t1 t2 f1 f2
-        _ -> Nothing
-    ]
-pevalITEBoolLeft cond (OrTerm _ _ _ _ t1 t2) ifFalse =
-  msum
-    [ pevalITEBoolLeftOr cond t1 t2 ifFalse,
-      case ifFalse of
-        OrTerm _ _ _ _ f1 f2 -> pevalITEBoolBothOr cond t1 t2 f1 f2
-        _ -> Nothing
-    ]
-pevalITEBoolLeft cond (NotTerm _ _ _ _ nIfTrue) ifFalse =
-  msum
-    [ pevalITEBoolLeftNot cond nIfTrue ifFalse,
-      case ifFalse of
-        NotTerm _ _ _ _ nIfFalse ->
-          pevalITEBoolBothNot cond nIfTrue nIfFalse
-        _ -> Nothing
-    ]
-pevalITEBoolLeft _ _ _ = Nothing
-
-pevalITEBoolNoLeft :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolNoLeft cond ifTrue (AndTerm _ _ _ _ f1 f2) = pevalITEBoolRightAnd cond ifTrue f1 f2
-pevalITEBoolNoLeft cond ifTrue (OrTerm _ _ _ _ f1 f2) = pevalITEBoolRightOr cond ifTrue f1 f2
-pevalITEBoolNoLeft cond ifTrue (NotTerm _ _ _ _ nIfFalse) = pevalITEBoolRightNot cond ifTrue nIfFalse
-pevalITEBoolNoLeft _ _ _ = Nothing
-
--- | Basic partial evaluation for ITE terms.
-pevalITEBasic :: (SupportedPrim a) => Term Bool -> Term a -> Term a -> Maybe (Term a)
-pevalITEBasic (ConTerm _ _ _ _ True) ~ifTrue ~_ = Just ifTrue
-pevalITEBasic (ConTerm _ _ _ _ False) ~_ ~ifFalse = Just ifFalse
-pevalITEBasic (NotTerm _ _ _ _ ncond) ifTrue ifFalse = Just $ pevalITETerm ncond ifFalse ifTrue
-pevalITEBasic _ ifTrue ifFalse | ifTrue == ifFalse = Just ifTrue
-pevalITEBasic (ITETerm _ _ _ _ cc ct cf) (ITETerm _ _ _ _ tc tt tf) (ITETerm _ _ _ _ fc ft ff) -- later
-  | cc == tc && cc == fc = Just $ pevalITETerm cc (pevalITETerm ct tt ft) (pevalITETerm cf tf ff)
-pevalITEBasic cond (ITETerm _ _ _ _ tc tt tf) ifFalse -- later
-  | cond == tc = Just $ pevalITETerm cond tt ifFalse
-  | tt == ifFalse = Just $ pevalITETerm (pevalOrTerm (pevalNotTerm cond) tc) tt tf
-  | tf == ifFalse = Just $ pevalITETerm (pevalAndTerm cond tc) tt tf
-pevalITEBasic cond ifTrue (ITETerm _ _ _ _ fc ft ff) -- later
-  | ifTrue == ft = Just $ pevalITETerm (pevalOrTerm cond fc) ifTrue ff
-  | ifTrue == ff = Just $ pevalITETerm (pevalOrTerm cond (pevalNotTerm fc)) ifTrue ft
-  | pevalImpliesTerm fc cond = Just $ pevalITETerm cond ifTrue ff
-pevalITEBasic _ _ _ = Nothing
-
-pevalITEBoolBasic :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBoolBasic cond ifTrue ifFalse
-  | cond == ifTrue = Just $ pevalOrTerm cond ifFalse
-  | cond == ifFalse = Just $ pevalAndTerm cond ifTrue
-pevalITEBoolBasic cond (ConTerm _ _ _ _ v) ifFalse
-  | v = Just $ pevalOrTerm cond ifFalse
-  | otherwise = Just $ pevalAndTerm (pevalNotTerm cond) ifFalse
-pevalITEBoolBasic cond ifTrue (ConTerm _ _ _ _ v)
-  | v = Just $ pevalOrTerm (pevalNotTerm cond) ifTrue
-  | otherwise = Just $ pevalAndTerm cond ifTrue
-pevalITEBoolBasic _ _ _ = Nothing
-
-pevalITEBool :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
-pevalITEBool cond ~ifTrue ~ifFalse =
-  msum
-    [ pevalITEBasic cond ifTrue ifFalse,
-      pevalITEBoolBasic cond ifTrue ifFalse,
-      pevalITEBoolLeft cond ifTrue ifFalse,
-      pevalITEBoolNoLeft cond ifTrue ifFalse
-    ]
-
--- | Basic partial evaluation for ITE terms.
-pevalITEBasicTerm :: (SupportedPrim a) => Term Bool -> Term a -> Term a -> Term a
-pevalITEBasicTerm cond ~ifTrue ~ifFalse =
-  fromMaybe (iteTerm cond ifTrue ifFalse) $
-    pevalITEBasic cond ifTrue ifFalse
-
--- | Default partial evaluation for equality terms.
-pevalDefaultEqTerm :: (SupportedNonFuncPrim a) => Term a -> Term a -> Term Bool
-pevalDefaultEqTerm l@ConTerm {} r@ConTerm {} = conTerm $ l == r
-pevalDefaultEqTerm l@ConTerm {} r = pevalDefaultEqTerm r l
-pevalDefaultEqTerm l (BoolConTerm rv) =
-  if rv
-    then unsafeCoerce l
-    else pevalNotTerm (unsafeCoerce l)
-pevalDefaultEqTerm (NotTerm _ _ _ _ lv) r
-  | lv == r = falseTerm
-pevalDefaultEqTerm l (NotTerm _ _ _ _ rv)
-  | l == rv = falseTerm
-pevalDefaultEqTerm (AddNumTerm _ _ _ _ (ConTerm _ _ _ _ c) v) (ConTerm _ _ _ _ c2) =
-  pevalDefaultEqTerm v (conTerm $ c2 - c)
-pevalDefaultEqTerm l (ITETerm _ _ _ _ c t f)
-  | l == t = pevalOrTerm c (pevalDefaultEqTerm l f)
-  | l == f = pevalOrTerm (pevalNotTerm c) (pevalDefaultEqTerm l t)
-pevalDefaultEqTerm (ITETerm _ _ _ _ c t f) r
-  | t == r = pevalOrTerm c (pevalDefaultEqTerm f r)
-  | f == r = pevalOrTerm (pevalNotTerm c) (pevalDefaultEqTerm t r)
-pevalDefaultEqTerm l r
-  | l == r = trueTerm
-  | otherwise = eqTerm l r
-{-# INLINEABLE pevalDefaultEqTerm #-}
-
-instance SBVRep Bool where
-  type SBVType Bool = SBV.SBV Bool
-
-instance SupportedPrimConstraint Bool
-
-instance SupportedPrim Bool where
-  pformatCon True = "true"
-  pformatCon False = "false"
-  defaultValue = defaultValueForBool
-  pevalITETerm cond ~ifTrue ~ifFalse =
-    fromMaybe (iteTerm cond ifTrue ifFalse) $
-      pevalITEBool cond ifTrue ifFalse
-  pevalEqTerm = pevalDefaultEqTerm
-  pevalDistinctTerm (_ :| []) = conTerm True
-  pevalDistinctTerm (a :| [b]) = pevalNotTerm $ pevalEqTerm a b
-  pevalDistinctTerm _ = conTerm False
-  conSBVTerm n = if n then SBV.sTrue else SBV.sFalse
-  symSBVName symbol _ = show symbol
-  symSBVTerm = sbvFresh
-  withPrim r = r
-  parseSMTModelResult _ = parseScalarSMTModelResult id
-  castTypedSymbol ::
-    forall knd knd'.
-    (IsSymbolKind knd') =>
-    TypedSymbol knd Bool ->
-    Maybe (TypedSymbol knd' Bool)
-  castTypedSymbol (TypedSymbol s) =
-    case decideSymbolKind @knd' of
-      Left HRefl -> Just $ TypedSymbol s
-      Right HRefl -> Just $ TypedSymbol s
-  funcDummyConstraint _ = SBV.sTrue
-
-instance NonFuncSBVRep Bool where
-  type NonFuncSBVBaseType Bool = Bool
-
-instance SupportedNonFuncPrim Bool where
-  conNonFuncSBVTerm = conSBVTerm
-  symNonFuncSBVTerm = symSBVTerm @Bool
-  withNonFuncPrim r = r
-
-data PhantomDict a where
-  PhantomDict :: (SupportedPrim a) => PhantomDict a
-
-data PhantomNonFuncDict a where
-  PhantomNonFuncDict ::
-    (SupportedNonFuncPrim a) => PhantomNonFuncDict a
-
-{-# NOINLINE phantomDictCache #-}
-phantomDictCache :: IORef (HM.HashMap SomeTypeRep (PhantomDict Any))
-phantomDictCache = unsafePerformIO $ newIORef HM.empty
-
--- TODO
-{-# NOINLINE getPhantomDict #-}
-getPhantomDict :: forall a. (SupportedPrim a) => PhantomDict a
-getPhantomDict = unsafePerformIO $ do
-  cache <- readIORef phantomDictCache
-  let !tr = SomeTypeRep $ primTypeRep @a
-  case HM.lookup tr cache of
-    Just p -> return $ unsafeCoerce p
-    Nothing -> do
-      let r = PhantomDict :: PhantomDict a
-      atomicModifyIORefCAS_ phantomDictCache $ HM.insert tr $ unsafeCoerce r
-      return r
-
-{-# NOINLINE phantomNonFuncDictCache #-}
-phantomNonFuncDictCache ::
-  IORef (HM.HashMap SomeTypeRep (PhantomNonFuncDict Any))
-phantomNonFuncDictCache = unsafePerformIO $ newIORef HM.empty
-
--- TODO
-{-# NOINLINE getPhantomNonFuncDict #-}
-getPhantomNonFuncDict ::
-  forall a. (SupportedNonFuncPrim a) => PhantomNonFuncDict a
-getPhantomNonFuncDict = unsafePerformIO $ do
-  cache <- readIORef phantomNonFuncDictCache
-  let !tr = SomeTypeRep $ primTypeRep @a
-  case HM.lookup tr cache of
-    Just p -> return $ unsafeCoerce p
-    Nothing -> do
-      let r = PhantomNonFuncDict :: PhantomNonFuncDict a
-      atomicModifyIORefCAS_ phantomNonFuncDictCache $
-        HM.insert tr $
-          unsafeCoerce r
-      return r
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-- |
+-- Module      :   Grisette.Internal.SymPrim.Prim.Internal.Term
+-- Copyright   :   (c) Sirui Lu 2021-2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.SymPrim.Prim.Internal.Term
+  ( -- * Supported primitive types
+    SupportedPrimConstraint (..),
+    SupportedPrim (..),
+    SymRep (..),
+    ConRep (..),
+    LinkedRep (..),
+
+    -- * Partial evaluation for the terms
+    PEvalApplyTerm (..),
+    PEvalBitwiseTerm (..),
+    PEvalShiftTerm (..),
+    PEvalRotateTerm (..),
+    PEvalNumTerm (..),
+    pevalSubNumTerm,
+    PEvalOrdTerm (..),
+    pevalGtOrdTerm,
+    pevalGeOrdTerm,
+    pevalNEqTerm,
+    PEvalDivModIntegralTerm (..),
+    PEvalBitCastTerm (..),
+    PEvalBitCastOrTerm (..),
+    PEvalBVTerm (..),
+    PEvalFractionalTerm (..),
+    PEvalFPTerm (..),
+    PEvalFloatingTerm (..),
+    PEvalFromIntegralTerm (..),
+    PEvalIEEEFPConvertibleTerm (..),
+
+    -- * Typed symbols
+    SymbolKind (..),
+    TypedSymbol (TypedSymbol, unTypedSymbol),
+    typedConstantSymbol,
+    typedAnySymbol,
+    TypedConstantSymbol,
+    TypedAnySymbol,
+    SomeTypedSymbol (..),
+    SomeTypedConstantSymbol,
+    SomeTypedAnySymbol,
+    IsSymbolKind (..),
+    showUntyped,
+    someTypedSymbol,
+    eqHeteroSymbol,
+    castSomeTypedSymbol,
+
+    -- * Terms
+    FPTrait (..),
+    FPUnaryOp (..),
+    FPBinaryOp (..),
+    FPRoundingUnaryOp (..),
+    FPRoundingBinaryOp (..),
+    FloatingUnaryOp (..),
+    Term (..),
+    defaultValueDynamic,
+    pattern DynTerm,
+    toCurThread,
+    CachedInfo (..),
+    termInfo,
+    termThreadId,
+    termDigest,
+    termId,
+    termStableIdent,
+    pformatTerm,
+    ModelValue (..),
+    toModelValue,
+    unsafeFromModelValue,
+
+    -- * Interning
+    UTerm (..),
+    prettyPrintTerm,
+
+    -- * Interned constructors
+    conTerm,
+    symTerm,
+    ssymTerm,
+    isymTerm,
+    forallTerm,
+    existsTerm,
+    notTerm,
+    orTerm,
+    andTerm,
+    eqTerm,
+    distinctTerm,
+    iteTerm,
+    addNumTerm,
+    negNumTerm,
+    mulNumTerm,
+    absNumTerm,
+    signumNumTerm,
+    ltOrdTerm,
+    leOrdTerm,
+    andBitsTerm,
+    orBitsTerm,
+    xorBitsTerm,
+    complementBitsTerm,
+    shiftLeftTerm,
+    rotateLeftTerm,
+    shiftRightTerm,
+    rotateRightTerm,
+    bitCastTerm,
+    bitCastOrTerm,
+    bvConcatTerm,
+    bvSelectTerm,
+    bvExtendTerm,
+    bvsignExtendTerm,
+    bvzeroExtendTerm,
+    applyTerm,
+    divIntegralTerm,
+    modIntegralTerm,
+    quotIntegralTerm,
+    remIntegralTerm,
+    fpTraitTerm,
+    fdivTerm,
+    recipTerm,
+    floatingUnaryTerm,
+    powerTerm,
+    fpUnaryTerm,
+    fpBinaryTerm,
+    fpRoundingUnaryTerm,
+    fpRoundingBinaryTerm,
+    fpFMATerm,
+    fromIntegralTerm,
+    fromFPOrTerm,
+    toFPTerm,
+
+    -- * Patterns
+    pattern SupportedTerm,
+    pattern SupportedTypedSymbol,
+    pattern SupportedConstantTypedSymbol,
+    pattern ConTerm,
+    pattern SymTerm,
+    pattern ForallTerm,
+    pattern ExistsTerm,
+    pattern NotTerm,
+    pattern OrTerm,
+    pattern AndTerm,
+    pattern OrTermAll,
+    pattern AndTermAll,
+    pattern EqTerm,
+    pattern DistinctTerm,
+    pattern ITETerm,
+    pattern AddNumTerm,
+    pattern NegNumTerm,
+    pattern MulNumTerm,
+    pattern AbsNumTerm,
+    pattern SignumNumTerm,
+    pattern LtOrdTerm,
+    pattern LeOrdTerm,
+    pattern AndBitsTerm,
+    pattern OrBitsTerm,
+    pattern XorBitsTerm,
+    pattern ComplementBitsTerm,
+    pattern ShiftLeftTerm,
+    pattern RotateLeftTerm,
+    pattern ShiftRightTerm,
+    pattern RotateRightTerm,
+    pattern BitCastTerm,
+    pattern BitCastOrTerm,
+    pattern BVConcatTerm,
+    pattern BVSelectTerm,
+    pattern BVExtendTerm,
+    pattern ApplyTerm,
+    pattern DivIntegralTerm,
+    pattern ModIntegralTerm,
+    pattern QuotIntegralTerm,
+    pattern RemIntegralTerm,
+    pattern FPTraitTerm,
+    pattern FdivTerm,
+    pattern RecipTerm,
+    pattern FloatingUnaryTerm,
+    pattern PowerTerm,
+    pattern FPUnaryTerm,
+    pattern FPBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPFMATerm,
+    pattern FromIntegralTerm,
+    pattern FromFPOrTerm,
+    pattern ToFPTerm,
+
+    -- * Support for boolean type
+    trueTerm,
+    falseTerm,
+    pattern BoolConTerm,
+    pattern TrueTerm,
+    pattern FalseTerm,
+    pattern BoolTerm,
+    pevalNotTerm,
+    pevalOrTerm,
+    pevalAndTerm,
+    pevalImplyTerm,
+    pevalXorTerm,
+    pevalITEBasic,
+    pevalITEBasicTerm,
+    pevalDefaultEqTerm,
+    NonFuncPrimConstraint,
+    NonFuncSBVRep (..),
+    SupportedNonFuncPrim (..),
+    SBVRep (..),
+    SBVFreshMonad (..),
+    translateTypeError,
+    parseSMTModelResultError,
+    partitionCVArg,
+    parseScalarSMTModelResult,
+    bvIsNonZeroFromGEq1,
+
+    -- * Partial evaluation
+    PartialFun,
+    PartialRuleUnary,
+    TotalRuleUnary,
+    PartialRuleBinary,
+    TotalRuleBinary,
+    totalize,
+    totalize2,
+    UnaryPartialStrategy (..),
+    unaryPartial,
+    BinaryCommPartialStrategy (..),
+    BinaryPartialStrategy (..),
+    binaryPartial,
+
+    -- * Unfold
+    unaryUnfoldOnce,
+    binaryUnfoldOnce,
+    generalUnaryUnfolded,
+    generalBinaryUnfolded,
+
+    -- * bv
+    unsafePevalBVConcatTerm,
+    unsafePevalBVExtendTerm,
+    unsafePevalBVSelectTerm,
+    boolToBVTerm,
+
+    -- * num
+    pevalDefaultAddNumTerm,
+    pevalDefaultNegNumTerm,
+    pevalDefaultMulNumTerm,
+    pevalBitsAbsNumTerm,
+    doPevalNoOverflowAbsNumTerm,
+    pevalGeneralSignumNumTerm,
+    doPevalNoOverflowSignumNumTerm,
+  )
+where
+
+#if MIN_VERSION_prettyprinter(1,7,0)
+import Prettyprinter
+  ( column,
+    pageWidth,
+    Doc,
+    PageWidth(Unbounded, AvailablePerLine),
+    Pretty(pretty),
+  )
+#else
+import Data.Text.Prettyprint.Doc
+  ( column,
+    pageWidth,
+    Doc,
+    PageWidth(Unbounded, AvailablePerLine),
+    Pretty(pretty),
+  )
+#endif
+
+#if !MIN_VERSION_sbv(10,0,0)
+#define SMTDefinable Uninterpreted
+#endif
+
+#if MIN_VERSION_sbv(11,0,0)
+import qualified Data.SBV as SBVTC
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+import Language.Haskell.TH (Code, Quote)
+#else
+import Language.Haskell.TH (TExpQ)
+#endif
+
+import Control.DeepSeq (NFData (rnf))
+import Control.Monad (msum)
+import Control.Monad.Except (MonadError (catchError))
+import Control.Monad.IO.Class (MonadIO)
+import qualified Control.Monad.RWS.Lazy as Lazy
+import qualified Control.Monad.RWS.Strict as Strict
+import Control.Monad.Reader (MonadTrans (lift), ReaderT)
+import qualified Control.Monad.State.Lazy as Lazy
+import qualified Control.Monad.State.Strict as Strict
+import qualified Control.Monad.Writer.Lazy as Lazy
+import qualified Control.Monad.Writer.Strict as Strict
+import Data.Atomics (atomicModifyIORefCAS_)
+import qualified Data.Binary as Binary
+import Data.Bits
+  ( Bits (complement, isSigned, xor, zeroBits, (.&.), (.|.)),
+    FiniteBits (countLeadingZeros),
+  )
+import Data.Bytes.Serial (Serial (deserialize, serialize))
+import Data.Coerce (coerce)
+import qualified Data.HashMap.Strict as HM
+import qualified Data.HashSet as HS
+import Data.Hashable (Hashable (hashWithSalt))
+import Data.IORef (IORef, newIORef, readIORef)
+import Data.Kind (Constraint, Type)
+import Data.List.NonEmpty (NonEmpty ((:|)), toList)
+import Data.Maybe (fromMaybe, isJust)
+import Data.Proxy (Proxy (Proxy))
+import Data.SBV (BVIsNonZero)
+import qualified Data.SBV as SBV
+import qualified Data.SBV.Dynamic as SBVD
+import qualified Data.SBV.Trans as SBVT
+import qualified Data.SBV.Trans.Control as SBVTC
+import qualified Data.Serialize as Cereal
+import Data.String (IsString (fromString))
+import Data.Type.Equality ((:~:) (Refl), type (:~~:) (HRefl))
+import Data.Typeable (Typeable, cast, typeRepFingerprint)
+import GHC.Exts (Any, sortWith)
+import GHC.Fingerprint (Fingerprint)
+import GHC.Generics (Generic)
+import GHC.IO (unsafePerformIO)
+import GHC.Stack (HasCallStack)
+import GHC.TypeNats (KnownNat, Nat, natVal, sameNat, type (+), type (-), type (<=))
+import Grisette.Internal.Core.Data.Class.BitCast (BitCast (bitCast), BitCastOr)
+import Grisette.Internal.Core.Data.Class.BitVector
+  ( SizedBV
+      ( sizedBVConcat,
+        sizedBVFromIntegral,
+        sizedBVSelect,
+        sizedBVSext,
+        sizedBVZext
+      ),
+  )
+import Grisette.Internal.Core.Data.Class.IEEEFP
+  ( fpIsNegativeZero,
+    fpIsPositiveZero,
+  )
+import Grisette.Internal.Core.Data.Symbol
+  ( Identifier,
+    Symbol (IndexedSymbol, SimpleSymbol),
+  )
+import Grisette.Internal.SymPrim.AlgReal (AlgReal, fromSBVAlgReal, toSBVAlgReal)
+import Grisette.Internal.SymPrim.BV (IntN, WordN)
+import Grisette.Internal.SymPrim.FP
+  ( FP (FP),
+    FPRoundingMode (RNA, RNE, RTN, RTP, RTZ),
+    ValidFP,
+  )
+import Grisette.Internal.SymPrim.Prim.Internal.Caches
+  ( CachedInfo
+      ( CachedInfo,
+        cachedDigest,
+        cachedId,
+        cachedStableIdent,
+        cachedThreadId
+      ),
+    Digest,
+    Id,
+    Interned
+      ( Description,
+        Uninterned,
+        describe,
+        descriptionDigest,
+        identify,
+        threadId
+      ),
+    StableIdent,
+    intern,
+  )
+import Grisette.Internal.SymPrim.Prim.Internal.Utils
+  ( WeakThreadId,
+    myWeakThreadId,
+  )
+import Grisette.Internal.Utils.Parameterized
+  ( LeqProof (LeqProof),
+    NatRepr,
+    SomeNatRepr (SomeNatRepr),
+    SomePositiveNatRepr (SomePositiveNatRepr),
+    addNat,
+    mkNatRepr,
+    mkPositiveNatRepr,
+    natRepr,
+    unsafeAxiom,
+    unsafeKnownProof,
+    unsafeLeqProof,
+    withKnownNat,
+    withKnownProof,
+  )
+import Language.Haskell.TH.Syntax (Lift (liftTyped))
+import Type.Reflection
+  ( SomeTypeRep (SomeTypeRep),
+    TypeRep,
+    eqTypeRep,
+    someTypeRep,
+    typeRep,
+  )
+import qualified Type.Reflection as R
+import Unsafe.Coerce (unsafeCoerce)
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.SymPrim
+
+-- | Monads that supports generating sbv fresh variables.
+class (MonadIO m) => SBVFreshMonad m where
+  sbvFresh :: (SBV.SymVal a) => String -> m (SBV.SBV a)
+
+instance (MonadIO m) => SBVFreshMonad (SBVT.SymbolicT m) where
+  sbvFresh = SBVT.free
+  {-# INLINE sbvFresh #-}
+
+instance (MonadIO m) => SBVFreshMonad (SBVTC.QueryT m) where
+  sbvFresh = SBVTC.freshVar
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m) => SBVFreshMonad (ReaderT r m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Lazy.WriterT w m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Lazy.RWST r w s m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m) => SBVFreshMonad (Lazy.StateT s m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Strict.WriterT w m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m, Monoid w) => SBVFreshMonad (Strict.RWST r w s m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+instance (SBVFreshMonad m) => SBVFreshMonad (Strict.StateT s m) where
+  sbvFresh = lift . sbvFresh
+  {-# INLINE sbvFresh #-}
+
+-- | Error message for unsupported types.
+translateTypeError :: (HasCallStack) => Maybe String -> TypeRep a -> b
+translateTypeError Nothing ta =
+  error $
+    "Don't know how to translate the type " ++ show ta ++ " to SMT"
+translateTypeError (Just reason) ta =
+  error $
+    "Don't know how to translate the type " ++ show ta ++ " to SMT: " <> reason
+
+-- | Type class for resolving the base type for the SBV type for the primitive
+-- type.
+class
+  ( SupportedPrim a,
+    Ord a,
+    Eq a,
+    Show a,
+    Hashable a,
+    Typeable a
+  ) =>
+  NonFuncSBVRep a
+  where
+  type NonFuncSBVBaseType a
+
+-- | Type class for resolving the constraint for a supported non-function
+-- primitive type.
+type NonFuncPrimConstraint a =
+  ( SBV.SymVal (NonFuncSBVBaseType a),
+    SBV.EqSymbolic (SBVType a),
+    SBV.Mergeable (SBVType a),
+    SBV.SMTDefinable (SBVType a),
+    SBV.Mergeable (SBVType a),
+    SBVType a ~ SBV.SBV (NonFuncSBVBaseType a),
+    PrimConstraint a
+  )
+
+-- | Indicates that a type is supported, can be represented as a symbolic term,
+-- is not a function type, and can be lowered to an SBV term.
+class (NonFuncSBVRep a) => SupportedNonFuncPrim a where
+  conNonFuncSBVTerm :: a -> SBV.SBV (NonFuncSBVBaseType a)
+  symNonFuncSBVTerm ::
+    (SBVFreshMonad m) => String -> m (SBV.SBV (NonFuncSBVBaseType a))
+  withNonFuncPrim :: ((NonFuncPrimConstraint a) => r) -> r
+
+-- | Partition the list of CVs for models for functions.
+partitionCVArg ::
+  forall a.
+  (SupportedNonFuncPrim a) =>
+  [([SBVD.CV], SBVD.CV)] ->
+  [(a, [([SBVD.CV], SBVD.CV)])]
+partitionCVArg cv =
+  partitionOrdCVArg $
+    parseFirstCVArg cv
+  where
+    parseFirstCVArg ::
+      forall a.
+      (SupportedNonFuncPrim a) =>
+      [([SBVD.CV], SBVD.CV)] ->
+      [(a, [([SBVD.CV], SBVD.CV)])]
+    parseFirstCVArg =
+      fmap
+        ( \case
+            (x : xs, v) ->
+              (parseSMTModelResult 0 ([], x), [(xs, v)])
+            _ -> error "impossible"
+        )
+    partitionOrdCVArg ::
+      forall a.
+      (SupportedNonFuncPrim a) =>
+      [(a, [([SBVD.CV], SBVD.CV)])] ->
+      [(a, [([SBVD.CV], SBVD.CV)])]
+    partitionOrdCVArg v = go sorted
+      where
+        sorted = sortWith fst v :: [(a, [([SBVD.CV], SBVD.CV)])]
+        go (x : x1 : xs) =
+          if fst x == fst x1
+            then go $ (fst x, snd x ++ snd x1) : xs
+            else x : go (x1 : xs)
+        go x = x
+
+-- | Parse the scalar model result.
+parseScalarSMTModelResult ::
+  forall v r.
+  (SBVT.SatModel r, Typeable v) =>
+  (r -> v) ->
+  ([([SBVD.CV], SBVD.CV)], SBVD.CV) ->
+  v
+parseScalarSMTModelResult convert cvs@([], v) = case SBVT.parseCVs [v] of
+  Just (x, _) -> convert x
+  Nothing -> parseSMTModelResultError (typeRep @v) cvs
+parseScalarSMTModelResult _ cv = parseSMTModelResultError (typeRep @v) cv
+
+-- | Type class for resolving the SBV type for the primitive type.
+class SBVRep t where
+  type SBVType t
+
+-- | Type class for resolving the constraint for a supported primitive type.
+class SupportedPrimConstraint t where
+  type PrimConstraint t :: Constraint
+  type PrimConstraint _ = ()
+
+-- | Indicates that a type is supported, can be represented as a symbolic term,
+-- and can be lowered to an SBV term.
+class
+  ( Lift t,
+    NFData t,
+    Typeable t,
+    SupportedPrimConstraint t,
+    SBVRep t
+  ) =>
+  SupportedPrim t
+  where
+  primTypeRep :: TypeRep t
+  default primTypeRep :: (Typeable t) => TypeRep t
+  primTypeRep = typeRep
+  sameCon :: t -> t -> Bool
+  default sameCon :: (Eq t) => t -> t -> Bool
+  sameCon = (==)
+  hashConWithSalt :: Int -> t -> Int
+  default hashConWithSalt :: (Hashable t) => Int -> t -> Int
+  hashConWithSalt = hashWithSalt
+  pformatCon :: t -> String
+  default pformatCon :: (Show t) => t -> String
+  pformatCon = show
+  defaultValue :: t
+  pevalITETerm :: Term Bool -> Term t -> Term t -> Term t
+  pevalEqTerm :: Term t -> Term t -> Term Bool
+  pevalDistinctTerm :: NonEmpty (Term t) -> Term Bool
+  conSBVTerm :: t -> SBVType t
+  symSBVName :: TypedSymbol 'AnyKind t -> Int -> String
+  symSBVTerm :: (SBVFreshMonad m) => String -> m (SBVType t)
+  default withPrim ::
+    ( PrimConstraint t,
+      SBV.SMTDefinable (SBVType t),
+      SBV.Mergeable (SBVType t),
+      Typeable (SBVType t)
+    ) =>
+    ( ( PrimConstraint t,
+        SBV.SMTDefinable (SBVType t),
+        SBV.Mergeable (SBVType t),
+        Typeable (SBVType t)
+      ) =>
+      a
+    ) ->
+    a
+  withPrim ::
+    ( ( PrimConstraint t,
+        SBV.SMTDefinable (SBVType t),
+        SBV.Mergeable (SBVType t),
+        Typeable (SBVType t)
+      ) =>
+      a
+    ) ->
+    a
+  withPrim i = i
+  {-# INLINE withPrim #-}
+  sbvIte :: SBV.SBV Bool -> SBVType t -> SBVType t -> SBVType t
+  sbvIte = withPrim @t SBV.ite
+  sbvEq :: SBVType t -> SBVType t -> SBV.SBV Bool
+  default sbvEq ::
+    (SBVT.EqSymbolic (SBVType t)) => SBVType t -> SBVType t -> SBV.SBV Bool
+  sbvEq = (SBV..==)
+  sbvDistinct :: NonEmpty (SBVType t) -> SBV.SBV Bool
+  default sbvDistinct ::
+    (SBVT.EqSymbolic (SBVType t)) => NonEmpty (SBVType t) -> SBV.SBV Bool
+  sbvDistinct = SBV.distinct . toList
+  parseSMTModelResult :: Int -> ([([SBVD.CV], SBVD.CV)], SBVD.CV) -> t
+  castTypedSymbol ::
+    (IsSymbolKind knd') => TypedSymbol knd t -> Maybe (TypedSymbol knd' t)
+  funcDummyConstraint :: SBVType t -> SBV.SBV Bool
+
+-- | The default value in a dynamic t'ModelValue'.
+defaultValueDynamic ::
+  forall t proxy. (SupportedPrim t) => proxy t -> ModelValue
+defaultValueDynamic _ = toModelValue (defaultValue @t)
+
+-- | A value with its type information.
+data ModelValue where
+  ModelValue :: forall v. (SupportedPrim v) => v -> ModelValue
+
+instance NFData ModelValue where
+  rnf (ModelValue v) = rnf v
+
+instance Lift ModelValue where
+  liftTyped (ModelValue v) = [||ModelValue v||]
+
+instance Show ModelValue where
+  show (ModelValue (v :: v)) = pformatCon v ++ " :: " ++ show (primTypeRep @v)
+
+instance Eq ModelValue where
+  (ModelValue (v1 :: v1)) == (ModelValue (v2 :: v2)) =
+    case eqTypeRep (primTypeRep @v1) (primTypeRep @v2) of
+      Just HRefl -> sameCon v1 v2
+      _ -> False
+
+instance Hashable ModelValue where
+  s `hashWithSalt` (ModelValue (v :: v)) =
+    (s `hashWithSalt` (primTypeRep @v)) `hashConWithSalt` v
+
+-- | Convert from a model value. Crashes if the types does not match.
+unsafeFromModelValue :: forall a. (Typeable a) => ModelValue -> a
+unsafeFromModelValue (ModelValue (v :: v)) =
+  case eqTypeRep (primTypeRep @v) (typeRep @a) of
+    Just HRefl -> v
+    _ ->
+      error $
+        "Bad model value type, expected type: "
+          ++ show (typeRep @a)
+          ++ ", but got: "
+          ++ show (primTypeRep @v)
+
+-- | Convert to a model value.
+toModelValue :: forall a. (SupportedPrim a) => a -> ModelValue
+toModelValue = ModelValue
+
+-- | Cast a typed symbol to a different kind. Check if the kind is compatible.
+castSomeTypedSymbol ::
+  (IsSymbolKind knd') => SomeTypedSymbol knd -> Maybe (SomeTypedSymbol knd')
+castSomeTypedSymbol (SomeTypedSymbol s@TypedSymbol {}) =
+  SomeTypedSymbol <$> castTypedSymbol s
+{-# INLINE castSomeTypedSymbol #-}
+
+-- | Error message for failure to parse the SBV model result.
+parseSMTModelResultError ::
+  (HasCallStack) => TypeRep a -> ([([SBVD.CV], SBVD.CV)], SBVD.CV) -> a
+parseSMTModelResultError ty cv =
+  error $
+    "BUG: cannot parse SBV model value \""
+      <> show cv
+      <> "\" to Grisette model value with the type "
+      <> show ty
+
+-- | Partial evaluation for inequality terms.
+pevalNEqTerm :: (SupportedPrim a) => Term a -> Term a -> Term Bool
+pevalNEqTerm l r = pevalNotTerm $ pevalEqTerm l r
+{-# INLINE pevalNEqTerm #-}
+
+-- | Type family to resolve the concrete type associated with a symbolic type.
+class ConRep sym where
+  type ConType sym
+
+-- | Type family to resolve the symbolic type associated with a concrete type.
+class (SupportedPrim con) => SymRep con where
+  type SymType con
+
+-- | One-to-one mapping between symbolic types and concrete types.
+class
+  (ConRep sym, SymRep con, sym ~ SymType con, con ~ ConType sym) =>
+  LinkedRep con sym
+    | con -> sym,
+      sym -> con
+  where
+  underlyingTerm :: sym -> Term con
+  wrapTerm :: Term con -> sym
+
+-- | Partial evaluation and lowering for function application terms.
+class PEvalApplyTerm f a b | f -> a b where
+  pevalApplyTerm :: Term f -> Term a -> Term b
+  sbvApplyTerm :: SBVType f -> SBVType a -> SBVType b
+
+-- | Partial evaluation and lowering for bitwise operation terms.
+class PEvalBitwiseTerm t where
+  pevalAndBitsTerm :: Term t -> Term t -> Term t
+  pevalOrBitsTerm :: Term t -> Term t -> Term t
+  pevalXorBitsTerm :: Term t -> Term t -> Term t
+  pevalComplementBitsTerm :: Term t -> Term t
+  withSbvBitwiseTermConstraint :: (((Bits (SBVType t)) => r)) -> r
+  sbvAndBitsTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvAndBitsTerm = withSbvBitwiseTermConstraint @t (SBV..&.)
+  sbvOrBitsTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvOrBitsTerm = withSbvBitwiseTermConstraint @t (SBV..|.)
+  sbvXorBitsTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvXorBitsTerm = withSbvBitwiseTermConstraint @t SBV.xor
+  sbvComplementBitsTerm :: SBVType t -> SBVType t
+  sbvComplementBitsTerm = withSbvBitwiseTermConstraint @t SBV.complement
+
+-- | Partial evaluation and lowering for symbolic shifting terms.
+class PEvalShiftTerm t where
+  pevalShiftLeftTerm :: Term t -> Term t -> Term t
+  pevalShiftRightTerm :: Term t -> Term t -> Term t
+  withSbvShiftTermConstraint ::
+    (((SBV.SIntegral (NonFuncSBVBaseType t)) => r)) -> r
+  sbvShiftLeftTerm :: SBVType t -> SBVType t -> SBVType t
+  default sbvShiftLeftTerm ::
+    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
+  sbvShiftLeftTerm l r =
+    withNonFuncPrim @t $ withSbvShiftTermConstraint @t $ SBV.sShiftLeft l r
+  default sbvShiftRightTerm ::
+    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
+  sbvShiftRightTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvShiftRightTerm l r =
+    withNonFuncPrim @t $ withSbvShiftTermConstraint @t $ SBV.sShiftRight l r
+
+-- | Partial evaluation and lowering for symbolic rotate terms.
+class PEvalRotateTerm t where
+  pevalRotateLeftTerm :: Term t -> Term t -> Term t
+  pevalRotateRightTerm :: Term t -> Term t -> Term t
+  withSbvRotateTermConstraint ::
+    (((SBV.SIntegral (NonFuncSBVBaseType t)) => r)) -> r
+  sbvRotateLeftTerm :: SBVType t -> SBVType t -> SBVType t
+  default sbvRotateLeftTerm ::
+    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
+  sbvRotateLeftTerm l r =
+    withNonFuncPrim @t $ withSbvRotateTermConstraint @t $ SBV.sRotateLeft l r
+  sbvRotateRightTerm :: SBVType t -> SBVType t -> SBVType t
+  default sbvRotateRightTerm ::
+    (SupportedNonFuncPrim t) => SBVType t -> SBVType t -> SBVType t
+  sbvRotateRightTerm l r =
+    withNonFuncPrim @t $ withSbvRotateTermConstraint @t $ SBV.sRotateRight l r
+
+-- | Partial evaluation and lowering for number terms.
+class (Num t) => PEvalNumTerm t where
+  pevalAddNumTerm :: Term t -> Term t -> Term t
+  pevalNegNumTerm :: Term t -> Term t
+  pevalMulNumTerm :: Term t -> Term t -> Term t
+  pevalAbsNumTerm :: Term t -> Term t
+  pevalSignumNumTerm :: Term t -> Term t
+  withSbvNumTermConstraint :: (((Num (SBVType t)) => r)) -> r
+  sbvAddNumTerm ::
+    SBVType t ->
+    SBVType t ->
+    SBVType t
+  sbvAddNumTerm l r = withSbvNumTermConstraint @t $ l + r
+  sbvNegNumTerm ::
+    SBVType t ->
+    SBVType t
+  sbvNegNumTerm l = withSbvNumTermConstraint @t $ -l
+  sbvMulNumTerm ::
+    SBVType t ->
+    SBVType t ->
+    SBVType t
+  sbvMulNumTerm l r = withSbvNumTermConstraint @t $ l * r
+  sbvAbsNumTerm ::
+    SBVType t ->
+    SBVType t
+  sbvAbsNumTerm l = withSbvNumTermConstraint @t $ abs l
+  sbvSignumNumTerm ::
+    SBVType t ->
+    SBVType t
+  sbvSignumNumTerm l = withSbvNumTermConstraint @t $ signum l
+
+-- | Partial evaluation for subtraction terms.
+pevalSubNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> Term a
+pevalSubNumTerm l r = pevalAddNumTerm l (pevalNegNumTerm r)
+
+-- | Partial evaluation and lowering for comparison terms.
+class PEvalOrdTerm t where
+  pevalLtOrdTerm :: Term t -> Term t -> Term Bool
+  pevalLeOrdTerm :: Term t -> Term t -> Term Bool
+  withSbvOrdTermConstraint :: (((SBV.OrdSymbolic (SBVType t)) => r)) -> r
+  sbvLtOrdTerm ::
+    SBVType t ->
+    SBVType t ->
+    SBV.SBV Bool
+  sbvLtOrdTerm l r = withSbvOrdTermConstraint @t $ l SBV..< r
+  sbvLeOrdTerm :: SBVType t -> SBVType t -> SBV.SBV Bool
+  sbvLeOrdTerm l r = withSbvOrdTermConstraint @t $ l SBV..<= r
+
+-- | Partial evaluation for greater than terms.
+pevalGtOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
+pevalGtOrdTerm = flip pevalLtOrdTerm
+{-# INLINE pevalGtOrdTerm #-}
+
+-- | Partial evaluation for greater than or equal to terms.
+pevalGeOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
+pevalGeOrdTerm = flip pevalLeOrdTerm
+{-# INLINE pevalGeOrdTerm #-}
+
+-- | Partial evaluation and lowering for integer division and modulo terms.
+class PEvalDivModIntegralTerm t where
+  pevalDivIntegralTerm :: Term t -> Term t -> Term t
+  pevalModIntegralTerm :: Term t -> Term t -> Term t
+  pevalQuotIntegralTerm :: Term t -> Term t -> Term t
+  pevalRemIntegralTerm :: Term t -> Term t -> Term t
+  withSbvDivModIntegralTermConstraint ::
+    (((SBV.SDivisible (SBVType t)) => r)) -> r
+  sbvDivIntegralTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvDivIntegralTerm l r =
+    withSbvDivModIntegralTermConstraint @t $ l `SBV.sDiv` r
+  sbvModIntegralTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvModIntegralTerm l r =
+    withSbvDivModIntegralTermConstraint @t $ l `SBV.sMod` r
+  sbvQuotIntegralTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvQuotIntegralTerm l r =
+    withSbvDivModIntegralTermConstraint @t $ l `SBV.sQuot` r
+  sbvRemIntegralTerm :: SBVType t -> SBVType t -> SBVType t
+  sbvRemIntegralTerm l r =
+    withSbvDivModIntegralTermConstraint @t $ l `SBV.sRem` r
+
+-- | Partial evaluation and lowering for bitcast terms.
+class (BitCast a b) => PEvalBitCastTerm a b where
+  pevalBitCastTerm :: Term a -> Term b
+  sbvBitCast :: SBVType a -> SBVType b
+
+-- | Partial evaluation and lowering for bitcast or default value terms.
+class
+  (BitCastOr a b) =>
+  PEvalBitCastOrTerm a b
+  where
+  pevalBitCastOrTerm :: Term b -> Term a -> Term b
+  sbvBitCastOr :: SBVType b -> SBVType a -> SBVType b
+
+-- | Partial evaluation and lowering for bit-vector terms.
+class
+  ( SizedBV bv,
+    forall n. (KnownNat n, 1 <= n) => PEvalNumTerm (bv n),
+    forall n. (KnownNat n, 1 <= n) => PEvalBitwiseTerm (bv n),
+    forall n. (KnownNat n, 1 <= n) => FiniteBits (bv n),
+    forall n. (KnownNat n, 1 <= n) => Num (bv n)
+  ) =>
+  PEvalBVTerm bv
+  where
+  pevalBVConcatTerm ::
+    (KnownNat l, KnownNat r, 1 <= l, 1 <= r) =>
+    Term (bv l) ->
+    Term (bv r) ->
+    Term (bv (l + r))
+  pevalBVExtendTerm ::
+    (KnownNat l, KnownNat r, 1 <= l, 1 <= r, l <= r) =>
+    Bool ->
+    proxy r ->
+    Term (bv l) ->
+    Term (bv r)
+  pevalBVSelectTerm ::
+    (KnownNat n, KnownNat ix, KnownNat w, 1 <= n, 1 <= w, ix + w <= n) =>
+    p ix ->
+    q w ->
+    Term (bv n) ->
+    Term (bv w)
+  sbvBVConcatTerm ::
+    (KnownNat l, KnownNat r, 1 <= l, 1 <= r) =>
+    p1 l ->
+    p2 r ->
+    SBVType (bv l) ->
+    SBVType (bv r) ->
+    SBVType (bv (l + r))
+  sbvBVExtendTerm ::
+    (KnownNat l, KnownNat r, 1 <= l, 1 <= r, l <= r) =>
+    p1 l ->
+    p2 r ->
+    Bool ->
+    SBVType (bv l) ->
+    SBVType (bv r)
+  sbvBVSelectTerm ::
+    ( KnownNat ix,
+      KnownNat w,
+      KnownNat n,
+      1 <= n,
+      1 <= w,
+      ix + w <= n
+    ) =>
+    p1 ix ->
+    p2 w ->
+    p3 n ->
+    SBVType (bv n) ->
+    SBVType (bv w)
+
+-- | Partial evaluation and lowering for fractional terms.
+class (Fractional t) => PEvalFractionalTerm t where
+  pevalFdivTerm :: Term t -> Term t -> Term t
+  pevalRecipTerm :: Term t -> Term t
+  withSbvFractionalTermConstraint ::
+    (((Fractional (SBVType t)) => r)) ->
+    r
+  sbvFdivTerm ::
+    SBVType t ->
+    SBVType t ->
+    SBVType t
+  sbvFdivTerm l r = withSbvFractionalTermConstraint @t $ l / r
+  sbvRecipTerm ::
+    SBVType t ->
+    SBVType t
+  sbvRecipTerm l = withSbvFractionalTermConstraint @t $ recip l
+
+-- | Unary floating point operations.
+data FloatingUnaryOp
+  = FloatingExp
+  | FloatingLog
+  | FloatingSqrt
+  | FloatingSin
+  | FloatingCos
+  | FloatingTan
+  | FloatingAsin
+  | FloatingAcos
+  | FloatingAtan
+  | FloatingSinh
+  | FloatingCosh
+  | FloatingTanh
+  | FloatingAsinh
+  | FloatingAcosh
+  | FloatingAtanh
+  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
+
+instance Cereal.Serialize FloatingUnaryOp where
+  put = serialize
+  get = deserialize
+
+instance Binary.Binary FloatingUnaryOp where
+  put = serialize
+  get = deserialize
+
+instance Show FloatingUnaryOp where
+  show FloatingExp = "exp"
+  show FloatingLog = "log"
+  show FloatingSqrt = "sqrt"
+  show FloatingSin = "sin"
+  show FloatingCos = "cos"
+  show FloatingTan = "tan"
+  show FloatingAsin = "asin"
+  show FloatingAcos = "acos"
+  show FloatingAtan = "atan"
+  show FloatingSinh = "sinh"
+  show FloatingCosh = "cosh"
+  show FloatingTanh = "tanh"
+  show FloatingAsinh = "asinh"
+  show FloatingAcosh = "acosh"
+  show FloatingAtanh = "atanh"
+
+-- | Partial evaluation and lowering for floating point terms.
+class PEvalFPTerm fp where
+  pevalFPTraitTerm :: (ValidFP eb sb) => FPTrait -> Term (fp eb sb) -> Term Bool
+  pevalFPUnaryTerm ::
+    (ValidFP eb sb) =>
+    FPUnaryOp ->
+    Term (fp eb sb) ->
+    Term (fp eb sb)
+  pevalFPBinaryTerm ::
+    (ValidFP eb sb) =>
+    FPBinaryOp ->
+    Term (fp eb sb) ->
+    Term (fp eb sb) ->
+    Term (fp eb sb)
+  pevalFPRoundingUnaryTerm ::
+    (ValidFP eb sb) =>
+    FPRoundingUnaryOp ->
+    Term FPRoundingMode ->
+    Term (fp eb sb) ->
+    Term (fp eb sb)
+  pevalFPRoundingBinaryTerm ::
+    (ValidFP eb sb) =>
+    FPRoundingBinaryOp ->
+    Term FPRoundingMode ->
+    Term (fp eb sb) ->
+    Term (fp eb sb) ->
+    Term (fp eb sb)
+  pevalFPFMATerm ::
+    (ValidFP eb sb) =>
+    Term FPRoundingMode ->
+    Term (fp eb sb) ->
+    Term (fp eb sb) ->
+    Term (fp eb sb) ->
+    Term (fp eb sb)
+  sbvFPTraitTerm ::
+    (ValidFP eb sb) => FPTrait -> SBVType (fp eb sb) -> SBVType Bool
+  sbvFPUnaryTerm ::
+    (ValidFP eb sb) =>
+    FPUnaryOp ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb)
+  sbvFPBinaryTerm ::
+    (ValidFP eb sb) =>
+    FPBinaryOp ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb)
+  sbvFPRoundingUnaryTerm ::
+    (ValidFP eb sb) =>
+    FPRoundingUnaryOp ->
+    SBVType FPRoundingMode ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb)
+  sbvFPRoundingBinaryTerm ::
+    (ValidFP eb sb) =>
+    FPRoundingBinaryOp ->
+    SBVType FPRoundingMode ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb)
+  sbvFPFMATerm ::
+    (ValidFP eb sb) =>
+    SBVType FPRoundingMode ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb) ->
+    SBVType (fp eb sb)
+
+-- | Partial evaluation and lowering for floating point terms.
+class PEvalFloatingTerm t where
+  pevalFloatingUnaryTerm :: FloatingUnaryOp -> Term t -> Term t
+  pevalPowerTerm :: Term t -> Term t -> Term t
+  withSbvFloatingTermConstraint ::
+    (((Floating (SBVType t)) => r)) ->
+    r
+  sbvPowerTerm ::
+    SBVType t ->
+    SBVType t ->
+    SBVType t
+  sbvPowerTerm = withSbvFloatingTermConstraint @t (**)
+  sbvFloatingUnaryTerm ::
+    FloatingUnaryOp ->
+    SBVType t ->
+    SBVType t
+  sbvFloatingUnaryTerm op l =
+    withSbvFloatingTermConstraint @t $
+      case op of
+        FloatingExp -> exp l
+        FloatingLog -> log l
+        FloatingSqrt -> sqrt l
+        FloatingSin -> sin l
+        FloatingCos -> cos l
+        FloatingTan -> tan l
+        FloatingAsin -> asin l
+        FloatingAcos -> acos l
+        FloatingAtan -> atan l
+        FloatingSinh -> sinh l
+        FloatingCosh -> cosh l
+        FloatingTanh -> tanh l
+        FloatingAsinh -> asinh l
+        FloatingAcosh -> acosh l
+        FloatingAtanh -> atanh l
+
+-- | Partial evaluation and lowering for integral terms.
+class (Integral a, Num b) => PEvalFromIntegralTerm a b where
+  pevalFromIntegralTerm :: Term a -> Term b
+  sbvFromIntegralTerm :: SBVType a -> SBVType b
+
+-- | Partial evaluation and lowering for converting from and to IEEE floating
+-- point terms.
+class PEvalIEEEFPConvertibleTerm a where
+  pevalFromFPOrTerm ::
+    (ValidFP eb sb) =>
+    Term a ->
+    Term FPRoundingMode ->
+    Term (FP eb sb) ->
+    Term a
+  pevalToFPTerm ::
+    (ValidFP eb sb) => Term FPRoundingMode -> Term a -> Term (FP eb sb)
+  sbvFromFPOrTerm ::
+    (ValidFP eb sb) =>
+    SBVType a ->
+    SBVType FPRoundingMode ->
+    SBVType (FP eb sb) ->
+    SBVType a
+  sbvToFPTerm ::
+    (ValidFP eb sb) =>
+    SBVType FPRoundingMode ->
+    SBVType a ->
+    SBVType (FP eb sb)
+
+-- Typed Symbols
+
+-- | The kind of a symbol.
+--
+-- All symbols are 'AnyKind', and all symbols other than general/tabular
+-- functions are 'ConstantKind'.
+data SymbolKind = ConstantKind | AnyKind
+
+-- | Decision procedure for symbol kinds.
+class IsSymbolKind (knd :: SymbolKind) where
+  type SymbolKindConstraint knd :: Type -> Constraint
+  decideSymbolKind :: Either (knd :~~: 'ConstantKind) (knd :~~: 'AnyKind)
+  withSymbolKindConstraint ::
+    TypedSymbol knd t ->
+    ((SymbolKindConstraint knd t) => a) ->
+    a
+
+instance IsSymbolKind 'ConstantKind where
+  type SymbolKindConstraint 'ConstantKind = SupportedNonFuncPrim
+  decideSymbolKind = Left HRefl
+  withSymbolKindConstraint r = withConstantSymbolSupported r
+
+instance IsSymbolKind 'AnyKind where
+  type SymbolKindConstraint 'AnyKind = SupportedPrim
+  decideSymbolKind = Right HRefl
+  withSymbolKindConstraint r = withSymbolSupported r
+
+-- | A typed symbol is a symbol that is associated with a type. Note that the
+-- same symbol bodies with different types are considered different symbols
+-- and can coexist in a term.
+--
+-- Simple symbols can be created with the @OverloadedStrings@ extension:
+--
+-- >>> "a" :: TypedSymbol 'AnyKind Bool
+-- a :: Bool
+data TypedSymbol (knd :: SymbolKind) t where
+  TypedSymbol ::
+    ( SupportedPrim t,
+      SymbolKindConstraint knd t,
+      IsSymbolKind knd
+    ) =>
+    {unTypedSymbol :: Symbol} ->
+    TypedSymbol knd t
+
+-- | Create a typed symbol with constant kinds.
+typedConstantSymbol ::
+  forall t. (SupportedNonFuncPrim t) => Symbol -> TypedSymbol 'ConstantKind t
+typedConstantSymbol = typedConstantSymbol' getPhantomNonFuncDict
+{-# INLINE typedConstantSymbol #-}
+
+{-# NOINLINE typedConstantSymbol' #-}
+typedConstantSymbol' ::
+  forall t. PhantomNonFuncDict t -> Symbol -> TypedSymbol 'ConstantKind t
+typedConstantSymbol' PhantomNonFuncDict symbol = TypedSymbol symbol
+
+-- | Create a typed symbol with any kinds.
+typedAnySymbol ::
+  forall t. (SupportedPrim t) => Symbol -> TypedSymbol 'AnyKind t
+typedAnySymbol = typedAnySymbol' getPhantomDict
+{-# INLINE typedAnySymbol #-}
+
+{-# NOINLINE typedAnySymbol' #-}
+typedAnySymbol' ::
+  forall t. PhantomDict t -> Symbol -> TypedSymbol 'AnyKind t
+typedAnySymbol' PhantomDict symbol = TypedSymbol symbol
+
+-- | Constant symbol
+type TypedConstantSymbol = TypedSymbol 'ConstantKind
+
+-- | Any symbol
+type TypedAnySymbol = TypedSymbol 'AnyKind
+
+instance Eq (TypedSymbol knd t) where
+  TypedSymbol x == TypedSymbol y = x == y
+
+instance Ord (TypedSymbol knd t) where
+  TypedSymbol x <= TypedSymbol y = x <= y
+
+instance Lift (TypedSymbol knd t) where
+  liftTyped (TypedSymbol x) = [||TypedSymbol x||]
+
+instance Show (TypedSymbol knd t) where
+  show (TypedSymbol symbol) = show symbol ++ " :: " ++ show (primTypeRep @t)
+
+-- | Show a typed symbol without the type information.
+showUntyped :: TypedSymbol knd t -> String
+showUntyped (TypedSymbol symbol) = show symbol
+
+instance Hashable (TypedSymbol knd t) where
+  s `hashWithSalt` TypedSymbol x = s `hashWithSalt` x
+
+instance NFData (TypedSymbol knd t) where
+  rnf (TypedSymbol str) = rnf str
+
+instance
+  ( SupportedPrim t,
+    SymbolKindConstraint knd t,
+    IsSymbolKind knd
+  ) =>
+  IsString (TypedSymbol knd t)
+  where
+  fromString = TypedSymbol . fromString
+
+-- | Introduce the 'SupportedPrim' constraint from the t'TypedSymbol'.
+withSymbolSupported ::
+  forall knd t a.
+  TypedSymbol knd t ->
+  ((SupportedPrim t) => a) ->
+  a
+withSymbolSupported (TypedSymbol _) a = a
+{-# INLINE withSymbolSupported #-}
+
+-- | Introduce the 'SupportedPrim' constraint from the t'TypedSymbol'.
+withConstantSymbolSupported ::
+  forall t a.
+  TypedSymbol 'ConstantKind t ->
+  ((SupportedNonFuncPrim t) => a) ->
+  a
+withConstantSymbolSupported (TypedSymbol _) a = a
+{-# INLINE withConstantSymbolSupported #-}
+
+-- | A non-indexed symbol. Type information are checked at runtime.
+data SomeTypedSymbol knd where
+  SomeTypedSymbol ::
+    forall knd t.
+    TypedSymbol knd t ->
+    SomeTypedSymbol knd
+
+-- | Non-indexed constant symbol
+type SomeTypedConstantSymbol = SomeTypedSymbol 'ConstantKind
+
+-- | Non-indexed any symbol
+type SomeTypedAnySymbol = SomeTypedSymbol 'AnyKind
+
+instance NFData (SomeTypedSymbol knd) where
+  rnf (SomeTypedSymbol s) = rnf s
+  {-# INLINE rnf #-}
+
+instance Lift (SomeTypedSymbol knd) where
+  liftTyped (SomeTypedSymbol s) = [||SomeTypedSymbol s||]
+
+instance Eq (SomeTypedSymbol knd) where
+  (SomeTypedSymbol (s1 :: TypedSymbol knd a))
+    == (SomeTypedSymbol (s2 :: TypedSymbol knd b)) =
+      withSymbolSupported s1 $
+        withSymbolSupported s2 $
+          case eqTypeRep (primTypeRep @a) (primTypeRep @b) of
+            Just HRefl -> s1 == s2
+            _ -> False
+  {-# INLINE (==) #-}
+
+instance Ord (SomeTypedSymbol knd) where
+  (SomeTypedSymbol (s1 :: TypedSymbol knd a))
+    <= (SomeTypedSymbol (s2 :: TypedSymbol knd b)) =
+      withSymbolSupported s1 $
+        withSymbolSupported s2 $
+          let t1 = primTypeRep @a
+              t2 = primTypeRep @b
+           in SomeTypeRep t1 < SomeTypeRep t2
+                || ( case eqTypeRep t1 t2 of
+                       Just HRefl -> s1 <= s2
+                       _ -> False
+                   )
+
+instance Hashable (SomeTypedSymbol knd) where
+  hashWithSalt s (SomeTypedSymbol s1) = s `hashWithSalt` s1
+  {-# INLINE hashWithSalt #-}
+
+instance Show (SomeTypedSymbol knd) where
+  show (SomeTypedSymbol s) = show s
+
+-- | Construct a t'SomeTypedSymbol' from a t'TypedSymbol'.
+someTypedSymbol :: forall knd t. TypedSymbol knd t -> SomeTypedSymbol knd
+someTypedSymbol s@(TypedSymbol _) = SomeTypedSymbol s
+{-# INLINE someTypedSymbol #-}
+
+-- Terms
+
+-- | Traits for IEEE floating point numbers.
+data FPTrait
+  = FPIsNaN
+  | FPIsPositive
+  | FPIsNegative
+  | FPIsPositiveInfinite
+  | FPIsNegativeInfinite
+  | FPIsInfinite
+  | FPIsPositiveZero
+  | FPIsNegativeZero
+  | FPIsZero
+  | FPIsNormal
+  | FPIsSubnormal
+  | FPIsPoint
+  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
+
+instance Cereal.Serialize FPTrait where
+  put = serialize
+  get = deserialize
+
+instance Binary.Binary FPTrait where
+  put = serialize
+  get = deserialize
+
+instance Show FPTrait where
+  show FPIsNaN = "is_nan"
+  show FPIsPositive = "is_pos"
+  show FPIsNegative = "is_neg"
+  show FPIsPositiveInfinite = "is_pos_inf"
+  show FPIsNegativeInfinite = "is_neg_inf"
+  show FPIsInfinite = "is_inf"
+  show FPIsPositiveZero = "is_pos_zero"
+  show FPIsNegativeZero = "is_neg_zero"
+  show FPIsZero = "is_zero"
+  show FPIsNormal = "is_normal"
+  show FPIsSubnormal = "is_subnormal"
+  show FPIsPoint = "is_point"
+
+-- | Unary floating point operations.
+data FPUnaryOp = FPAbs | FPNeg
+  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
+
+instance Cereal.Serialize FPUnaryOp where
+  put = serialize
+  get = deserialize
+
+instance Binary.Binary FPUnaryOp where
+  put = serialize
+  get = deserialize
+
+instance Show FPUnaryOp where
+  show FPAbs = "fp.abs"
+  show FPNeg = "fp.neg"
+
+-- | Binary floating point operations.
+data FPBinaryOp
+  = FPRem
+  | FPMinimum
+  | FPMinimumNumber
+  | FPMaximum
+  | FPMaximumNumber
+  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
+
+instance Cereal.Serialize FPBinaryOp where
+  put = serialize
+  get = deserialize
+
+instance Binary.Binary FPBinaryOp where
+  put = serialize
+  get = deserialize
+
+instance Show FPBinaryOp where
+  show FPRem = "fp.rem"
+  show FPMinimum = "fp.minimum"
+  show FPMinimumNumber = "fp.minimumNumber"
+  show FPMaximum = "fp.maximum"
+  show FPMaximumNumber = "fp.maximumNumber"
+
+-- | Unary floating point operations with rounding modes.
+data FPRoundingUnaryOp = FPSqrt | FPRoundToIntegral
+  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
+
+instance Cereal.Serialize FPRoundingUnaryOp where
+  put = serialize
+  get = deserialize
+
+instance Binary.Binary FPRoundingUnaryOp where
+  put = serialize
+  get = deserialize
+
+instance Show FPRoundingUnaryOp where
+  show FPSqrt = "fp.sqrt"
+  show FPRoundToIntegral = "fp.roundToIntegral"
+
+-- | Binary floating point operations with rounding modes.
+data FPRoundingBinaryOp = FPAdd | FPSub | FPMul | FPDiv
+  deriving (Eq, Ord, Generic, Hashable, Lift, NFData, Serial)
+
+instance Cereal.Serialize FPRoundingBinaryOp where
+  put = serialize
+  get = deserialize
+
+instance Binary.Binary FPRoundingBinaryOp where
+  put = serialize
+  get = deserialize
+
+instance Show FPRoundingBinaryOp where
+  show FPAdd = "fp.add"
+  show FPSub = "fp.sub"
+  show FPMul = "fp.mul"
+  show FPDiv = "fp.div"
+
+instance NFData CachedInfo where
+  rnf (CachedInfo tid digest id stableIdent) =
+    rnf tid `seq` rnf digest `seq` rnf id `seq` rnf stableIdent
+
+-- | Internal representation for Grisette symbolic terms.
+data Term t where
+  ConTerm' ::
+    (SupportedPrim t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !t ->
+    Term t
+  SymTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(TypedSymbol 'AnyKind t) ->
+    Term t
+  ForallTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(TypedSymbol 'ConstantKind t) ->
+    !(Term Bool) ->
+    Term Bool
+  ExistsTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(TypedSymbol 'ConstantKind t) ->
+    !(Term Bool) ->
+    Term Bool
+  NotTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term Bool) ->
+    Term Bool
+  OrTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term Bool) ->
+    !(Term Bool) ->
+    !(HS.HashSet (Term Bool)) -> -- All or'ed terms
+    Term Bool
+  AndTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term Bool) ->
+    !(Term Bool) ->
+    !(HS.HashSet (Term Bool)) -> -- All and'ed terms
+    Term Bool
+  EqTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term Bool
+  DistinctTerm' ::
+    {-# UNPACK #-} !CachedInfo ->
+    !(NonEmpty (Term t)) ->
+    Term Bool
+  ITETerm' ::
+    (SupportedPrim t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term Bool) ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  AddNumTerm' ::
+    (SupportedPrim t, PEvalNumTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  NegNumTerm' ::
+    (SupportedPrim t, PEvalNumTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    Term t
+  MulNumTerm' ::
+    (SupportedPrim t, PEvalNumTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  AbsNumTerm' ::
+    (SupportedPrim t, PEvalNumTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    Term t
+  SignumNumTerm' ::
+    (SupportedPrim t, PEvalNumTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    Term t
+  LtOrdTerm' ::
+    (SupportedPrim t, PEvalOrdTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term Bool
+  LeOrdTerm' ::
+    (SupportedPrim t, PEvalOrdTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term Bool
+  AndBitsTerm' ::
+    (SupportedPrim t, PEvalBitwiseTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  OrBitsTerm' ::
+    (SupportedPrim t, PEvalBitwiseTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  XorBitsTerm' ::
+    (SupportedPrim t, PEvalBitwiseTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  ComplementBitsTerm' ::
+    (SupportedPrim t, PEvalBitwiseTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    Term t
+  ShiftLeftTerm' ::
+    (SupportedPrim t, PEvalShiftTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  ShiftRightTerm' ::
+    (SupportedPrim t, PEvalShiftTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  RotateLeftTerm' ::
+    (SupportedPrim t, PEvalRotateTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  RotateRightTerm' ::
+    (SupportedPrim t, PEvalRotateTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  BitCastTerm' ::
+    (SupportedPrim b, PEvalBitCastTerm a b) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term a) ->
+    Term b
+  BitCastOrTerm' ::
+    (SupportedPrim b, PEvalBitCastOrTerm a b) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term b) ->
+    !(Term a) ->
+    Term b
+  BVConcatTerm' ::
+    ( PEvalBVTerm bv,
+      KnownNat l,
+      KnownNat r,
+      KnownNat (l + r),
+      1 <= l,
+      1 <= r,
+      1 <= l + r,
+      SupportedPrim (bv (l + r))
+    ) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term (bv l)) ->
+    !(Term (bv r)) ->
+    Term (bv (l + r))
+  BVSelectTerm' ::
+    ( PEvalBVTerm bv,
+      KnownNat n,
+      KnownNat ix,
+      KnownNat w,
+      1 <= n,
+      1 <= w,
+      ix + w <= n,
+      SupportedPrim (bv w)
+    ) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Proxy ix) ->
+    !(Proxy w) ->
+    !(Term (bv n)) ->
+    Term (bv w)
+  BVExtendTerm' ::
+    ( PEvalBVTerm bv,
+      KnownNat l,
+      KnownNat r,
+      1 <= l,
+      1 <= r,
+      l <= r,
+      SupportedPrim (bv r)
+    ) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !Bool ->
+    !(Proxy r) ->
+    !(Term (bv l)) ->
+    Term (bv r)
+  ApplyTerm' ::
+    (PEvalApplyTerm f a b, SupportedPrim b) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term f) ->
+    !(Term a) ->
+    Term b
+  DivIntegralTerm' ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  ModIntegralTerm' ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  QuotIntegralTerm' ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  RemIntegralTerm' ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  FPTraitTerm' ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !FPTrait ->
+    !(Term (fp eb sb)) ->
+    Term Bool
+  FdivTerm' ::
+    (SupportedPrim t, PEvalFractionalTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  RecipTerm' ::
+    (SupportedPrim t, PEvalFractionalTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    Term t
+  FloatingUnaryTerm' ::
+    (SupportedPrim t, PEvalFloatingTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !FloatingUnaryOp ->
+    !(Term t) ->
+    Term t
+  PowerTerm' ::
+    (SupportedPrim t, PEvalFloatingTerm t) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term t) ->
+    !(Term t) ->
+    Term t
+  FPUnaryTerm' ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !FPUnaryOp ->
+    !(Term (fp eb sb)) ->
+    Term (fp eb sb)
+  FPBinaryTerm' ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !FPBinaryOp ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    Term (fp eb sb)
+  FPRoundingUnaryTerm' ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !FPRoundingUnaryOp ->
+    !(Term FPRoundingMode) ->
+    !(Term (fp eb sb)) ->
+    Term (fp eb sb)
+  FPRoundingBinaryTerm' ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !FPRoundingBinaryOp ->
+    !(Term FPRoundingMode) ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    Term (fp eb sb)
+  FPFMATerm' ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term FPRoundingMode) ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    Term (fp eb sb)
+  FromIntegralTerm' ::
+    (PEvalFromIntegralTerm a b, SupportedPrim b) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term a) ->
+    Term b
+  FromFPOrTerm' ::
+    ( PEvalIEEEFPConvertibleTerm a,
+      ValidFP eb sb,
+      SupportedPrim a
+    ) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term a) ->
+    !(Term FPRoundingMode) ->
+    !(Term (FP eb sb)) ->
+    Term a
+  ToFPTerm' ::
+    ( PEvalIEEEFPConvertibleTerm a,
+      ValidFP eb sb,
+      SupportedPrim (FP eb sb)
+    ) =>
+    {-# UNPACK #-} !CachedInfo ->
+    !(Term FPRoundingMode) ->
+    !(Term a) ->
+    Proxy eb ->
+    Proxy sb ->
+    Term (FP eb sb)
+
+data SupportedPrimEvidence t where
+  SupportedPrimEvidence :: (SupportedPrim t) => SupportedPrimEvidence t
+
+-- | Pattern synonym to introduce the SupportedPrim constraint.
+pattern SupportedTerm :: forall t. () => (SupportedPrim t) => Term t
+pattern SupportedTerm <-
+  ( ( \v ->
+        introSupportedPrimConstraint v $
+          Just (SupportedPrimEvidence @t)
+    ) ->
+      Just SupportedPrimEvidence
+    )
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# COMPLETE SupportedTerm #-}
+{-# INLINE SupportedTerm #-}
+#endif
+
+-- | Cast a term to another type.
+castTerm :: forall a b. (Typeable b) => Term a -> Maybe (Term b)
+castTerm t@SupportedTerm = cast t
+{-# INLINE castTerm #-}
+
+data SupportedTypedSymbolEvidence (k :: SymbolKind) t where
+  SupportedTypedSymbolEvidence ::
+    forall k t.
+    (SupportedPrim t, SymbolKindConstraint k t, IsSymbolKind k) =>
+    SupportedTypedSymbolEvidence k t
+
+supportedTypedSymbolViewPat ::
+  TypedSymbol k t -> Maybe (SupportedTypedSymbolEvidence k t)
+supportedTypedSymbolViewPat (TypedSymbol _) = Just SupportedTypedSymbolEvidence
+
+-- | Pattern synonym to introduce constraints from a t'TypedSymbol'.
+pattern SupportedTypedSymbol ::
+  forall (k :: SymbolKind) t.
+  () =>
+  (SupportedPrim t, SymbolKindConstraint k t, IsSymbolKind k) =>
+  TypedSymbol k t
+pattern SupportedTypedSymbol <-
+  (supportedTypedSymbolViewPat -> Just SupportedTypedSymbolEvidence)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# COMPLETE SupportedTypedSymbol #-}
+{-# INLINE SupportedTypedSymbol #-}
+#endif
+
+data SupportedConstantTypedSymbolEvidence k t where
+  SupportedConstantTypedSymbolEvidence ::
+    forall k t.
+    ( SupportedPrim t,
+      SymbolKindConstraint k t,
+      IsSymbolKind k,
+      k ~ 'ConstantKind
+    ) =>
+    SupportedConstantTypedSymbolEvidence k t
+
+supportedConstantTypedSymbolViewPat ::
+  forall k t.
+  TypedSymbol k t ->
+  Maybe (SupportedConstantTypedSymbolEvidence k t)
+supportedConstantTypedSymbolViewPat (TypedSymbol _) =
+  case decideSymbolKind @k of
+    Left HRefl -> Just SupportedConstantTypedSymbolEvidence
+    Right _ -> Nothing
+
+-- | Pattern synonym to introduce constraints from a t'TypedSymbol'. Also checks
+-- that the symbol kind is 'ConstantKind'.
+pattern SupportedConstantTypedSymbol ::
+  forall k t.
+  () =>
+  ( SupportedPrim t,
+    SymbolKindConstraint k t,
+    IsSymbolKind k,
+    k ~ 'ConstantKind
+  ) =>
+  TypedSymbol k t
+pattern SupportedConstantTypedSymbol <-
+  ( supportedConstantTypedSymbolViewPat ->
+      Just SupportedConstantTypedSymbolEvidence
+    )
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE SupportedConstantTypedSymbol #-}
+#endif
+
+-- | Pattern synonym for 'ConTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern ConTerm :: forall t. () => (SupportedPrim t) => t -> Term t
+pattern ConTerm t <- (ConTerm' _ t)
+  where
+    ConTerm = conTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ConTerm #-}
+#endif
+
+-- | Pattern synonym for 'SymTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern SymTerm ::
+  forall t. () => (SupportedPrim t) => TypedSymbol 'AnyKind t -> Term t
+pattern SymTerm t <- (SymTerm' _ t@SupportedTypedSymbol)
+  where
+    SymTerm = symTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE SymTerm #-}
+#endif
+
+-- | Pattern synonym for 'ForallTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern ForallTerm ::
+  forall r.
+  () =>
+  forall t.
+  (r ~ Bool, SupportedNonFuncPrim t) =>
+  TypedSymbol 'ConstantKind t ->
+  Term Bool ->
+  Term r
+pattern ForallTerm sym body <-
+  (ForallTerm' _ sym@SupportedConstantTypedSymbol body)
+  where
+    ForallTerm = forallTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ForallTerm #-}
+#endif
+
+-- | Pattern synonym for 'ExistsTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern ExistsTerm ::
+  forall r.
+  () =>
+  forall t.
+  (r ~ Bool, SupportedNonFuncPrim t) =>
+  TypedSymbol 'ConstantKind t ->
+  Term Bool ->
+  Term r
+pattern ExistsTerm sym body <-
+  (ExistsTerm' _ sym@SupportedConstantTypedSymbol body)
+  where
+    ExistsTerm = existsTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ExistsTerm #-}
+#endif
+
+-- | Pattern synonym for 'NotTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern NotTerm :: forall r. () => (r ~ Bool) => Term Bool -> Term r
+pattern NotTerm body <- (NotTerm' _ body)
+  where
+    NotTerm = pevalNotTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE NotTerm #-}
+#endif
+
+-- | Pattern synonym for 'OrTerm''. Note that using this pattern to construct a
+-- 'Term' will do term simplification.
+pattern OrTerm :: forall r. () => (r ~ Bool) => Term Bool -> Term Bool -> Term r
+pattern OrTerm l r <- (OrTerm' _ l r _)
+  where
+    OrTerm = pevalOrTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE OrTerm #-}
+#endif
+
+-- | Pattern synonym for 'OrTerm''. Note that using this pattern to construct a
+-- 'Term' will do term simplification.
+pattern OrTermAll ::
+  forall r.
+  () =>
+  (r ~ Bool) =>
+  Term Bool -> Term Bool -> HS.HashSet (Term Bool) -> Term r
+pattern OrTermAll l r s <- (OrTerm' _ l r s)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE OrTermAll #-}
+#endif
+
+-- | Pattern synonym for 'AndTerm''. Note that using this pattern to construct a
+-- 'Term' will do term simplification.
+pattern AndTerm :: forall r. () => (r ~ Bool) => Term Bool -> Term Bool -> Term r
+pattern AndTerm l r <- (AndTerm' _ l r _)
+  where
+    AndTerm = pevalAndTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE AndTerm #-}
+#endif
+
+-- | Pattern synonym for 'AndTerm''. Note that using this pattern to construct a
+-- 'Term' will do term simplification.
+pattern AndTermAll ::
+  forall r.
+  () =>
+  (r ~ Bool) =>
+  Term Bool -> Term Bool -> HS.HashSet (Term Bool) -> Term r
+pattern AndTermAll l r s <- (AndTerm' _ l r s)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE AndTermAll #-}
+#endif
+
+-- | Pattern synonym for 'EqTerm''. Note that using this pattern to construct a
+-- 'Term' will do term simplification.
+pattern EqTerm ::
+  forall r.
+  () =>
+  forall t.
+  (r ~ Bool, SupportedPrim t) =>
+  Term t ->
+  Term t ->
+  Term r
+pattern EqTerm l r <- (EqTerm' _ l r@SupportedTerm)
+  where
+    EqTerm = pevalEqTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE EqTerm #-}
+#endif
+
+-- | Pattern synonym for 'DistinctTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern DistinctTerm ::
+  forall r.
+  () =>
+  forall t.
+  (r ~ Bool, SupportedPrim t) =>
+  NonEmpty (Term t) ->
+  Term r
+pattern DistinctTerm ts <- (DistinctTerm' _ ts@(SupportedTerm :| _))
+  where
+    DistinctTerm = pevalDistinctTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE DistinctTerm #-}
+#endif
+
+-- | Pattern synonym for 'ITETerm''. Note that using this pattern to construct a
+-- 'Term' will do term simplification.
+pattern ITETerm ::
+  forall t.
+  () =>
+  (SupportedPrim t) =>
+  Term Bool ->
+  Term t ->
+  Term t ->
+  Term t
+pattern ITETerm cond t1 t2 <- (ITETerm' _ cond t1 t2)
+  where
+    ITETerm = pevalITETerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ITETerm #-}
+#endif
+
+-- | Pattern synonym for 'AddNumTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern AddNumTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalNumTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern AddNumTerm l r <- (AddNumTerm' _ l r)
+  where
+    AddNumTerm = pevalAddNumTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE AddNumTerm #-}
+#endif
+
+-- | Pattern synonym for 'NegNumTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern NegNumTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalNumTerm t) =>
+  Term t ->
+  Term t
+pattern NegNumTerm t <- (NegNumTerm' _ t)
+  where
+    NegNumTerm = pevalNegNumTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE NegNumTerm #-}
+#endif
+
+-- | Pattern synonym for 'MulNumTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern MulNumTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalNumTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern MulNumTerm l r <- (MulNumTerm' _ l r)
+  where
+    MulNumTerm = pevalMulNumTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE MulNumTerm #-}
+#endif
+
+-- | Pattern synonym for 'AbsNumTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern AbsNumTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalNumTerm t) =>
+  Term t ->
+  Term t
+pattern AbsNumTerm t <- (AbsNumTerm' _ t)
+  where
+    AbsNumTerm = pevalAbsNumTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE AbsNumTerm #-}
+#endif
+
+-- | Pattern synonym for 'SignumNumTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern SignumNumTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalNumTerm t) =>
+  Term t ->
+  Term t
+pattern SignumNumTerm t <- (SignumNumTerm' _ t)
+  where
+    SignumNumTerm = pevalSignumNumTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE SignumNumTerm #-}
+#endif
+
+-- | Pattern synonym for 'LtOrdTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern LtOrdTerm ::
+  forall r.
+  () =>
+  forall t.
+  (r ~ Bool, SupportedPrim t, PEvalOrdTerm t) =>
+  Term t ->
+  Term t ->
+  Term r
+pattern LtOrdTerm l r <- (LtOrdTerm' _ l r@SupportedTerm)
+  where
+    LtOrdTerm = pevalLtOrdTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE LtOrdTerm #-}
+#endif
+
+-- | Pattern synonym for 'LeOrdTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern LeOrdTerm ::
+  forall r.
+  () =>
+  forall t.
+  (r ~ Bool, SupportedPrim t, PEvalOrdTerm t) =>
+  Term t ->
+  Term t ->
+  Term r
+pattern LeOrdTerm l r <- (LeOrdTerm' _ l r@SupportedTerm)
+  where
+    LeOrdTerm = pevalLeOrdTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE LeOrdTerm #-}
+#endif
+
+-- | Pattern synonym for 'AndBitsTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern AndBitsTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalBitwiseTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern AndBitsTerm l r <- (AndBitsTerm' _ l r)
+  where
+    AndBitsTerm = pevalAndBitsTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE AndBitsTerm #-}
+#endif
+
+-- | Pattern synonym for 'OrBitsTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern OrBitsTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalBitwiseTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern OrBitsTerm l r <- (OrBitsTerm' _ l r)
+  where
+    OrBitsTerm = pevalOrBitsTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE OrBitsTerm #-}
+#endif
+
+-- | Pattern synonym for 'XorBitsTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern XorBitsTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalBitwiseTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern XorBitsTerm l r <- (XorBitsTerm' _ l r)
+  where
+    XorBitsTerm = pevalXorBitsTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE XorBitsTerm #-}
+#endif
+
+-- | Pattern synonym for 'ComplementBitsTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern ComplementBitsTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalBitwiseTerm t) =>
+  Term t ->
+  Term t
+pattern ComplementBitsTerm t <- (ComplementBitsTerm' _ t)
+  where
+    ComplementBitsTerm = pevalComplementBitsTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ComplementBitsTerm #-}
+#endif
+
+-- | Pattern synonym for 'ShiftLeftTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern ShiftLeftTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalShiftTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern ShiftLeftTerm l r <- (ShiftLeftTerm' _ l r)
+  where
+    ShiftLeftTerm = pevalShiftLeftTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ShiftLeftTerm #-}
+#endif
+
+-- | Pattern synonym for 'ShiftRightTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern ShiftRightTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalShiftTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern ShiftRightTerm l r <- (ShiftRightTerm' _ l r)
+  where
+    ShiftRightTerm = pevalShiftRightTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ShiftRightTerm #-}
+#endif
+
+-- | Pattern synonym for 'RotateLeftTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern RotateLeftTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalRotateTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern RotateLeftTerm l r <- (RotateLeftTerm' _ l r)
+  where
+    RotateLeftTerm = pevalRotateLeftTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE RotateLeftTerm #-}
+#endif
+
+-- | Pattern synonym for 'RotateRightTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern RotateRightTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalRotateTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern RotateRightTerm l r <- (RotateRightTerm' _ l r)
+  where
+    RotateRightTerm = pevalRotateRightTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE RotateRightTerm #-}
+#endif
+
+-- | Pattern synonym for 'BitCastTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern BitCastTerm ::
+  forall b.
+  () =>
+  forall a.
+  (SupportedPrim a, SupportedPrim b, PEvalBitCastTerm a b) =>
+  Term a ->
+  Term b
+pattern BitCastTerm t <- (BitCastTerm' _ t@SupportedTerm)
+  where
+    BitCastTerm = pevalBitCastTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BitCastTerm #-}
+#endif
+
+-- | Pattern synonym for 'BitCastOrTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern BitCastOrTerm ::
+  forall b.
+  () =>
+  forall a.
+  (SupportedPrim a, SupportedPrim b, PEvalBitCastOrTerm a b) =>
+  Term b ->
+  Term a ->
+  Term b
+pattern BitCastOrTerm t1 t2 <- (BitCastOrTerm' _ t1 t2@SupportedTerm)
+  where
+    BitCastOrTerm = pevalBitCastOrTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BitCastOrTerm #-}
+#endif
+
+-- | Pattern synonym for 'BVConcatTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern BVConcatTerm ::
+  forall ret.
+  () =>
+  forall bv l r.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    KnownNat (l + r),
+    1 <= l,
+    1 <= r,
+    1 <= l + r,
+    SupportedPrim (bv l),
+    SupportedPrim (bv r),
+    SupportedPrim (bv (l + r)),
+    ret ~ bv (l + r)
+  ) =>
+  Term (bv l) ->
+  Term (bv r) ->
+  Term ret
+pattern BVConcatTerm l r <- (BVConcatTerm' _ l@SupportedTerm r@SupportedTerm)
+  where
+    BVConcatTerm = pevalBVConcatTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BVConcatTerm #-}
+#endif
+
+-- | Pattern synonym for 'BVSelectTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern BVSelectTerm ::
+  forall ret.
+  () =>
+  forall bv w n ix.
+  ( PEvalBVTerm bv,
+    KnownNat n,
+    KnownNat ix,
+    KnownNat w,
+    1 <= n,
+    1 <= w,
+    ix + w <= n,
+    SupportedPrim (bv n),
+    SupportedPrim (bv w),
+    ret ~ bv w
+  ) =>
+  Proxy ix ->
+  Proxy w ->
+  Term (bv n) ->
+  Term ret
+pattern BVSelectTerm ix w t <- (BVSelectTerm' _ ix w t@SupportedTerm)
+  where
+    BVSelectTerm = pevalBVSelectTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BVSelectTerm #-}
+#endif
+
+-- | Pattern synonym for 'BVExtendTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern BVExtendTerm ::
+  forall ret.
+  () =>
+  forall bv l r.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv l),
+    SupportedPrim (bv r),
+    ret ~ bv r
+  ) =>
+  Bool ->
+  Proxy r ->
+  Term (bv l) ->
+  Term ret
+pattern BVExtendTerm signed p t <- (BVExtendTerm' _ signed p t@SupportedTerm)
+  where
+    BVExtendTerm = pevalBVExtendTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BVExtendTerm #-}
+#endif
+
+-- | Pattern synonym for 'ApplyTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern ApplyTerm ::
+  forall b.
+  () =>
+  forall f a.
+  (PEvalApplyTerm f a b, SupportedPrim f, SupportedPrim a, SupportedPrim b) =>
+  Term f ->
+  Term a ->
+  Term b
+pattern ApplyTerm f x <- (ApplyTerm' _ f@SupportedTerm x@SupportedTerm)
+  where
+    ApplyTerm = pevalApplyTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ApplyTerm #-}
+#endif
+
+-- | Pattern synonym for 'DivIntegralTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern DivIntegralTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern DivIntegralTerm l r <- (DivIntegralTerm' _ l r)
+  where
+    DivIntegralTerm = pevalDivIntegralTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE DivIntegralTerm #-}
+#endif
+
+-- | Pattern synonym for 'ModIntegralTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern ModIntegralTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern ModIntegralTerm l r <- (ModIntegralTerm' _ l r)
+  where
+    ModIntegralTerm = pevalModIntegralTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ModIntegralTerm #-}
+#endif
+
+-- | Pattern synonym for 'QuotIntegralTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern QuotIntegralTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern QuotIntegralTerm l r <- (QuotIntegralTerm' _ l r)
+  where
+    QuotIntegralTerm = pevalQuotIntegralTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE QuotIntegralTerm #-}
+#endif
+
+-- | Pattern synonym for 'RemIntegralTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern RemIntegralTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern RemIntegralTerm l r <- (RemIntegralTerm' _ l r)
+  where
+    RemIntegralTerm = pevalRemIntegralTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE RemIntegralTerm #-}
+#endif
+
+-- | Pattern synonym for 'FPTraitTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern FPTraitTerm ::
+  forall r.
+  () =>
+  forall eb sb fp.
+  (r ~ Bool, ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPTrait ->
+  Term (fp eb sb) ->
+  Term r
+pattern FPTraitTerm trait t <- (FPTraitTerm' _ trait t)
+  where
+    FPTraitTerm = pevalFPTraitTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FPTraitTerm #-}
+#endif
+
+-- | Pattern synonym for 'FdivTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern FdivTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalFractionalTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern FdivTerm l r <- (FdivTerm' _ l r)
+  where
+    FdivTerm = pevalFdivTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FdivTerm #-}
+#endif
+
+-- | Pattern synonym for 'RecipTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern RecipTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalFractionalTerm t) =>
+  Term t ->
+  Term t
+pattern RecipTerm t <- (RecipTerm' _ t)
+  where
+    RecipTerm = pevalRecipTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE RecipTerm #-}
+#endif
+
+-- | Pattern synonym for 'FloatingUnaryTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern FloatingUnaryTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalFloatingTerm t) =>
+  FloatingUnaryOp ->
+  Term t ->
+  Term t
+pattern FloatingUnaryTerm op t <- (FloatingUnaryTerm' _ op t)
+  where
+    FloatingUnaryTerm = pevalFloatingUnaryTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FloatingUnaryTerm #-}
+#endif
+
+-- | Pattern synonym for 'PowerTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern PowerTerm ::
+  forall t.
+  () =>
+  (SupportedPrim t, PEvalFloatingTerm t) =>
+  Term t ->
+  Term t ->
+  Term t
+pattern PowerTerm l r <- (PowerTerm' _ l r)
+  where
+    PowerTerm = pevalPowerTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE PowerTerm #-}
+#endif
+
+-- | Pattern synonym for 'FPUnaryTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern FPUnaryTerm ::
+  forall ret.
+  () =>
+  forall fp eb sb.
+  (ret ~ fp eb sb, ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPUnaryOp ->
+  Term (fp eb sb) ->
+  Term ret
+pattern FPUnaryTerm op t <- (FPUnaryTerm' _ op t)
+  where
+    FPUnaryTerm = pevalFPUnaryTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FPUnaryTerm #-}
+#endif
+
+-- | Pattern synonym for 'FPBinaryTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern FPBinaryTerm ::
+  forall ret.
+  () =>
+  forall fp eb sb.
+  (ret ~ fp eb sb, ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPBinaryOp ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term ret
+pattern FPBinaryTerm op l r <- (FPBinaryTerm' _ op l r)
+  where
+    FPBinaryTerm = pevalFPBinaryTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FPBinaryTerm #-}
+#endif
+
+-- | Pattern synonym for 'FPRoundingUnaryTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern FPRoundingUnaryTerm ::
+  forall ret.
+  () =>
+  forall fp eb sb.
+  (ret ~ fp eb sb, ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPRoundingUnaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term ret
+pattern FPRoundingUnaryTerm op rm t <- (FPRoundingUnaryTerm' _ op rm t)
+  where
+    FPRoundingUnaryTerm = pevalFPRoundingUnaryTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FPRoundingUnaryTerm #-}
+#endif
+
+-- | Pattern synonym for 'FPRoundingBinaryTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern FPRoundingBinaryTerm ::
+  forall ret.
+  () =>
+  forall fp eb sb.
+  (ret ~ fp eb sb, ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPRoundingBinaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term ret
+pattern FPRoundingBinaryTerm op rm l r <- (FPRoundingBinaryTerm' _ op rm l r)
+  where
+    FPRoundingBinaryTerm = pevalFPRoundingBinaryTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FPRoundingBinaryTerm #-}
+#endif
+
+-- | Pattern synonym for 'FPFMATerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern FPFMATerm ::
+  forall ret.
+  () =>
+  forall fp eb sb.
+  (ret ~ fp eb sb, ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term ret
+pattern FPFMATerm rm t1 t2 t3 <- (FPFMATerm' _ rm t1 t2 t3)
+  where
+    FPFMATerm = pevalFPFMATerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FPFMATerm #-}
+#endif
+
+-- | Pattern synonym for 'FromIntegralTerm''. Note that using this pattern to
+-- construct a 'Term' will do term simplification.
+pattern FromIntegralTerm ::
+  forall b.
+  () =>
+  forall a.
+  (PEvalFromIntegralTerm a b, SupportedPrim a, SupportedPrim b) =>
+  Term a ->
+  Term b
+pattern FromIntegralTerm t <- (FromIntegralTerm' _ t@SupportedTerm)
+  where
+    FromIntegralTerm = pevalFromIntegralTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FromIntegralTerm #-}
+#endif
+
+-- | Pattern synonym for 'FromFPOrTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern FromFPOrTerm ::
+  forall a.
+  () =>
+  forall eb sb.
+  ( PEvalIEEEFPConvertibleTerm a,
+    ValidFP eb sb,
+    SupportedPrim a
+  ) =>
+  Term a ->
+  Term FPRoundingMode ->
+  Term (FP eb sb) ->
+  Term a
+pattern FromFPOrTerm t1 rm t2 <- (FromFPOrTerm' _ t1 rm t2)
+  where
+    FromFPOrTerm = pevalFromFPOrTerm
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FromFPOrTerm #-}
+#endif
+
+-- | Pattern synonym for 'ToFPTerm''. Note that using this pattern to construct
+-- a 'Term' will do term simplification.
+pattern ToFPTerm ::
+  forall ret.
+  () =>
+  forall eb sb a.
+  ( PEvalIEEEFPConvertibleTerm a,
+    ValidFP eb sb,
+    SupportedPrim (FP eb sb),
+    SupportedPrim a,
+    ret ~ FP eb sb
+  ) =>
+  Term FPRoundingMode ->
+  Term a ->
+  Proxy eb ->
+  Proxy sb ->
+  Term ret
+pattern ToFPTerm rm t eb sb <- (ToFPTerm' _ rm t@SupportedTerm eb sb)
+  where
+    ToFPTerm rm t _ _ = pevalToFPTerm rm t
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE ToFPTerm #-}
+#endif
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# COMPLETE
+  ConTerm,
+  SymTerm,
+  ForallTerm,
+  ExistsTerm,
+  NotTerm,
+  OrTerm,
+  AndTerm,
+  EqTerm,
+  DistinctTerm,
+  ITETerm,
+  AddNumTerm,
+  NegNumTerm,
+  MulNumTerm,
+  AbsNumTerm,
+  SignumNumTerm,
+  LtOrdTerm,
+  LeOrdTerm,
+  AndBitsTerm,
+  OrBitsTerm,
+  XorBitsTerm,
+  ComplementBitsTerm,
+  ShiftLeftTerm,
+  ShiftRightTerm,
+  RotateLeftTerm,
+  RotateRightTerm,
+  BitCastTerm,
+  BitCastOrTerm,
+  BVConcatTerm,
+  BVSelectTerm,
+  BVExtendTerm,
+  ApplyTerm,
+  DivIntegralTerm,
+  ModIntegralTerm,
+  QuotIntegralTerm,
+  RemIntegralTerm,
+  FPTraitTerm,
+  FdivTerm,
+  RecipTerm,
+  FloatingUnaryTerm,
+  PowerTerm,
+  FPUnaryTerm,
+  FPBinaryTerm,
+  FPRoundingUnaryTerm,
+  FPRoundingBinaryTerm,
+  FPFMATerm,
+  FromIntegralTerm,
+  FromFPOrTerm,
+  ToFPTerm
+  #-}
+#endif
+
+-- | Get the cached information for a term.
+termInfo :: Term t -> CachedInfo
+termInfo (ConTerm' i _) = i
+termInfo (SymTerm' i _) = i
+termInfo (ForallTerm' i _ _) = i
+termInfo (ExistsTerm' i _ _) = i
+termInfo (NotTerm' i _) = i
+termInfo (OrTerm' i _ _ _) = i
+termInfo (AndTerm' i _ _ _) = i
+termInfo (EqTerm' i _ _) = i
+termInfo (DistinctTerm' i _) = i
+termInfo (ITETerm' i _ _ _) = i
+termInfo (AddNumTerm' i _ _) = i
+termInfo (NegNumTerm' i _) = i
+termInfo (MulNumTerm' i _ _) = i
+termInfo (AbsNumTerm' i _) = i
+termInfo (SignumNumTerm' i _) = i
+termInfo (LtOrdTerm' i _ _) = i
+termInfo (LeOrdTerm' i _ _) = i
+termInfo (AndBitsTerm' i _ _) = i
+termInfo (OrBitsTerm' i _ _) = i
+termInfo (XorBitsTerm' i _ _) = i
+termInfo (ComplementBitsTerm' i _) = i
+termInfo (ShiftLeftTerm' i _ _) = i
+termInfo (ShiftRightTerm' i _ _) = i
+termInfo (RotateLeftTerm' i _ _) = i
+termInfo (RotateRightTerm' i _ _) = i
+termInfo (BitCastTerm' i _) = i
+termInfo (BitCastOrTerm' i _ _) = i
+termInfo (BVConcatTerm' i _ _) = i
+termInfo (BVSelectTerm' i _ _ _) = i
+termInfo (BVExtendTerm' i _ _ _) = i
+termInfo (ApplyTerm' i _ _) = i
+termInfo (DivIntegralTerm' i _ _) = i
+termInfo (ModIntegralTerm' i _ _) = i
+termInfo (QuotIntegralTerm' i _ _) = i
+termInfo (RemIntegralTerm' i _ _) = i
+termInfo (FPTraitTerm' i _ _) = i
+termInfo (FdivTerm' i _ _) = i
+termInfo (RecipTerm' i _) = i
+termInfo (FloatingUnaryTerm' i _ _) = i
+termInfo (PowerTerm' i _ _) = i
+termInfo (FPUnaryTerm' i _ _) = i
+termInfo (FPBinaryTerm' i _ _ _) = i
+termInfo (FPRoundingUnaryTerm' i _ _ _) = i
+termInfo (FPRoundingBinaryTerm' i _ _ _ _) = i
+termInfo (FPFMATerm' i _ _ _ _) = i
+termInfo (FromIntegralTerm' i _) = i
+termInfo (FromFPOrTerm' i _ _ _) = i
+termInfo (ToFPTerm' i _ _ _ _) = i
+
+-- | Get the thread ID for a term.
+{-# INLINE termThreadId #-}
+termThreadId :: Term t -> WeakThreadId
+termThreadId = cachedThreadId . termInfo
+
+-- | Get the digest for a term.
+{-# INLINE termDigest #-}
+termDigest :: Term t -> Digest
+termDigest = cachedDigest . termInfo
+
+-- | Get the ID for a term.
+{-# INLINE termId #-}
+termId :: Term t -> Id
+termId = cachedId . termInfo
+
+-- | Get the stable identifier for a term.
+{-# INLINE termStableIdent #-}
+termStableIdent :: Term t -> StableIdent
+termStableIdent = cachedStableIdent . termInfo
+
+-- | Pattern for term with dynamic typing.
+pattern DynTerm :: forall a b. (SupportedPrim a) => Term a -> Term b
+pattern DynTerm x <- ((\v@SupportedTerm -> cast v) -> Just x)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE DynTerm #-}
+#endif
+
+-- baseHash :: Term t -> Digest
+-- baseHash t = case hashId t of
+--   HashId h _ -> h
+-- {-# INLINE baseHash #-}
+
+data HashId = HashId {-# UNPACK #-} !Digest Id deriving (Show)
+
+instance Eq HashId where
+  HashId _ l == HashId _ r = l == r
+  {-# INLINE (==) #-}
+
+instance Hashable HashId where
+  hashWithSalt s (HashId i _) = hashWithSalt s i
+  {-# INLINE hashWithSalt #-}
+
+eqHashId :: HashId -> HashId -> Bool
+eqHashId = (==)
+{-# INLINE eqHashId #-}
+
+data TypeHashId = TypeHashId {-# UNPACK #-} !Fingerprint {-# UNPACK #-} !HashId
+  deriving (Show)
+
+instance Eq TypeHashId where
+  TypeHashId l li == TypeHashId r ri = l == r && li == ri
+  {-# INLINE (==) #-}
+
+instance Hashable TypeHashId where
+  hashWithSalt s (TypeHashId tp i) = s `hashWithSalt` tp `hashWithSalt` i
+  {-# INLINE hashWithSalt #-}
+
+{-# INLINE termHashId #-}
+termHashId :: Term t -> HashId
+termHashId t = HashId (termDigest t) (termId t)
+
+typeFingerprint :: forall t. (SupportedPrim t) => Fingerprint
+typeFingerprint = typeRepFingerprint $ SomeTypeRep $ primTypeRep @t
+{-# INLINE typeFingerprint #-}
+
+{-# INLINE termTypeHashId #-}
+termTypeHashId :: forall t. Term t -> TypeHashId
+termTypeHashId t@SupportedTerm = TypeHashId (typeFingerprint @t) (termHashId t)
+
+-- {-# NOINLINE typeHashId #-}
+introSupportedPrimConstraint0 :: forall t a. Term t -> ((SupportedPrim t) => a) -> a
+introSupportedPrimConstraint0 ConTerm' {} x = x
+introSupportedPrimConstraint0 (SymTerm' _ t) x = withSymbolSupported t x
+introSupportedPrimConstraint0 ForallTerm' {} x = x
+introSupportedPrimConstraint0 ExistsTerm' {} x = x
+introSupportedPrimConstraint0 NotTerm' {} x = x
+introSupportedPrimConstraint0 OrTerm' {} x = x
+introSupportedPrimConstraint0 AndTerm' {} x = x
+introSupportedPrimConstraint0 EqTerm' {} x = x
+introSupportedPrimConstraint0 DistinctTerm' {} x = x
+introSupportedPrimConstraint0 ITETerm' {} x = x
+introSupportedPrimConstraint0 AddNumTerm' {} x = x
+introSupportedPrimConstraint0 NegNumTerm' {} x = x
+introSupportedPrimConstraint0 MulNumTerm' {} x = x
+introSupportedPrimConstraint0 AbsNumTerm' {} x = x
+introSupportedPrimConstraint0 SignumNumTerm' {} x = x
+introSupportedPrimConstraint0 LtOrdTerm' {} x = x
+introSupportedPrimConstraint0 LeOrdTerm' {} x = x
+introSupportedPrimConstraint0 AndBitsTerm' {} x = x
+introSupportedPrimConstraint0 OrBitsTerm' {} x = x
+introSupportedPrimConstraint0 XorBitsTerm' {} x = x
+introSupportedPrimConstraint0 ComplementBitsTerm' {} x = x
+introSupportedPrimConstraint0 ShiftLeftTerm' {} x = x
+introSupportedPrimConstraint0 RotateLeftTerm' {} x = x
+introSupportedPrimConstraint0 ShiftRightTerm' {} x = x
+introSupportedPrimConstraint0 RotateRightTerm' {} x = x
+introSupportedPrimConstraint0 BitCastTerm' {} x = x
+introSupportedPrimConstraint0 BitCastOrTerm' {} x = x
+introSupportedPrimConstraint0 BVConcatTerm' {} x = x
+introSupportedPrimConstraint0 BVSelectTerm' {} x = x
+introSupportedPrimConstraint0 BVExtendTerm' {} x = x
+introSupportedPrimConstraint0 ApplyTerm' {} x = x
+introSupportedPrimConstraint0 DivIntegralTerm' {} x = x
+introSupportedPrimConstraint0 ModIntegralTerm' {} x = x
+introSupportedPrimConstraint0 QuotIntegralTerm' {} x = x
+introSupportedPrimConstraint0 RemIntegralTerm' {} x = x
+introSupportedPrimConstraint0 FPTraitTerm' {} x = x
+introSupportedPrimConstraint0 FdivTerm' {} x = x
+introSupportedPrimConstraint0 RecipTerm' {} x = x
+introSupportedPrimConstraint0 FloatingUnaryTerm' {} x = x
+introSupportedPrimConstraint0 PowerTerm' {} x = x
+introSupportedPrimConstraint0 FPUnaryTerm' {} x = x
+introSupportedPrimConstraint0 FPBinaryTerm' {} x = x
+introSupportedPrimConstraint0 FPRoundingUnaryTerm' {} x = x
+introSupportedPrimConstraint0 FPRoundingBinaryTerm' {} x = x
+introSupportedPrimConstraint0 FPFMATerm' {} x = x
+introSupportedPrimConstraint0 FromIntegralTerm' {} x = x
+introSupportedPrimConstraint0 FromFPOrTerm' {} x = x
+introSupportedPrimConstraint0 ToFPTerm' {} x = x
+
+-- | Introduce the 'SupportedPrim' constraint from a term.
+introSupportedPrimConstraint ::
+  forall t a. Term t -> ((SupportedPrim t, Typeable t) => a) -> a
+introSupportedPrimConstraint t a = introSupportedPrimConstraint0 t a
+{-# INLINE introSupportedPrimConstraint #-}
+
+-- | Pretty-print a term.
+pformatTerm :: forall t. Term t -> String
+pformatTerm (ConTerm t) = pformatCon t
+pformatTerm (SymTerm sym) = showUntyped sym
+pformatTerm (ForallTerm sym arg) = "(forall " ++ show sym ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (ExistsTerm sym arg) = "(exists " ++ show sym ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (NotTerm arg) = "(! " ++ pformatTerm arg ++ ")"
+pformatTerm (OrTerm arg1 arg2) = "(|| " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (AndTerm arg1 arg2) = "(&& " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (EqTerm arg1 arg2) = "(= " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (DistinctTerm args) = "(distinct " ++ unwords (map pformatTerm $ toList args) ++ ")"
+pformatTerm (ITETerm cond arg1 arg2) = "(ite " ++ pformatTerm cond ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (AddNumTerm arg1 arg2) = "(+ " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (NegNumTerm arg) = "(- " ++ pformatTerm arg ++ ")"
+pformatTerm (MulNumTerm arg1 arg2) = "(* " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (AbsNumTerm arg) = "(abs " ++ pformatTerm arg ++ ")"
+pformatTerm (SignumNumTerm arg) = "(signum " ++ pformatTerm arg ++ ")"
+pformatTerm (LtOrdTerm arg1 arg2) = "(< " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (LeOrdTerm arg1 arg2) = "(<= " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (AndBitsTerm arg1 arg2) = "(& " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (OrBitsTerm arg1 arg2) = "(| " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (XorBitsTerm arg1 arg2) = "(^ " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (ComplementBitsTerm arg) = "(~ " ++ pformatTerm arg ++ ")"
+pformatTerm (ShiftLeftTerm arg n) = "(shl " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
+pformatTerm (ShiftRightTerm arg n) = "(shr " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
+pformatTerm (RotateLeftTerm arg n) = "(rotl " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
+pformatTerm (RotateRightTerm arg n) = "(rotr " ++ pformatTerm arg ++ " " ++ pformatTerm n ++ ")"
+pformatTerm (BitCastTerm arg) = "(bitcast " ++ pformatTerm arg ++ ")"
+pformatTerm (BitCastOrTerm d arg) = "(bitcast_or " ++ pformatTerm d ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (BVConcatTerm arg1 arg2) = "(bvconcat " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (BVSelectTerm (_ :: Proxy ix) (_ :: Proxy w) arg) =
+  "(bvselect " ++ show (typeRep @ix) ++ " " ++ show (typeRep @w) ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (BVExtendTerm signed (_ :: Proxy n) arg) =
+  (if signed then "(bvsext " else "(bvzext ") ++ show (typeRep @n) ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (ApplyTerm func arg) = "(apply " ++ pformatTerm func ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (DivIntegralTerm arg1 arg2) = "(div " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (ModIntegralTerm arg1 arg2) = "(mod " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (QuotIntegralTerm arg1 arg2) = "(quot " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (RemIntegralTerm arg1 arg2) = "(rem " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (FPTraitTerm trait arg) = "(" ++ show trait ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (FdivTerm arg1 arg2) = "(fdiv " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (RecipTerm arg) = "(recip " ++ pformatTerm arg ++ ")"
+pformatTerm (FloatingUnaryTerm op arg) = "(" ++ show op ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (PowerTerm arg1 arg2) = "(** " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (FPUnaryTerm op arg) = "(" ++ show op ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (FPBinaryTerm op arg1 arg2) = "(" ++ show op ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (FPRoundingUnaryTerm op mode arg) = "(" ++ show op ++ " " ++ pformatTerm mode ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (FPRoundingBinaryTerm op mode arg1 arg2) =
+  "(" ++ show op ++ " " ++ pformatTerm mode ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ ")"
+pformatTerm (FPFMATerm mode arg1 arg2 arg3) =
+  "(fp.fma " ++ pformatTerm mode ++ " " ++ pformatTerm arg1 ++ " " ++ pformatTerm arg2 ++ " " ++ pformatTerm arg3 ++ ")"
+pformatTerm (FromIntegralTerm arg) = "(from_integral " ++ pformatTerm arg ++ ")"
+pformatTerm (FromFPOrTerm d r arg) = "(from_fp_or " ++ pformatTerm d ++ " " ++ pformatTerm r ++ " " ++ pformatTerm arg ++ ")"
+pformatTerm (ToFPTerm r arg _ _) = "(to_fp " ++ pformatTerm r ++ " " ++ pformatTerm arg ++ ")"
+
+-- {-# INLINE pformatTerm #-}
+
+instance NFData (Term a) where
+  rnf i = rnf (termInfo i)
+  {-# INLINE rnf #-}
+
+#if MIN_VERSION_base(4,15,0)
+type CODE x = forall qq. Quote qq => Code qq (x)
+#else
+type CODE x = TExpQ x
+#endif
+
+instance Lift (Term t) where
+  liftTyped (ConTerm v) = [||conTerm v||]
+  liftTyped (SymTerm t) = [||symTerm t||]
+  liftTyped (ForallTerm t1 t2) = [||forallTerm t1 t2||]
+  liftTyped (ExistsTerm t1 t2) = [||existsTerm t1 t2||]
+  liftTyped (NotTerm t) = [||notTerm t||]
+  liftTyped (OrTerm t1 t2) = [||orTerm t1 t2||]
+  liftTyped (AndTerm t1 t2) = [||andTerm t1 t2||]
+  liftTyped (EqTerm t1 t2) = [||eqTerm t1 t2||]
+  liftTyped (DistinctTerm t) = [||distinctTerm t||]
+  liftTyped (ITETerm t1 t2 t3) = [||iteTerm t1 t2 t3||]
+  liftTyped (AddNumTerm t1 t2) = [||addNumTerm t1 t2||]
+  liftTyped (NegNumTerm t) = [||negNumTerm t||]
+  liftTyped (MulNumTerm t1 t2) = [||mulNumTerm t1 t2||]
+  liftTyped (AbsNumTerm t) = [||absNumTerm t||]
+  liftTyped (SignumNumTerm t) = [||signumNumTerm t||]
+  liftTyped (LtOrdTerm t1 t2) = [||ltOrdTerm t1 t2||]
+  liftTyped (LeOrdTerm t1 t2) = [||leOrdTerm t1 t2||]
+  liftTyped (AndBitsTerm t1 t2) = [||andBitsTerm t1 t2||]
+  liftTyped (OrBitsTerm t1 t2) = [||orBitsTerm t1 t2||]
+  liftTyped (XorBitsTerm t1 t2) = [||xorBitsTerm t1 t2||]
+  liftTyped (ComplementBitsTerm t) = [||complementBitsTerm t||]
+  liftTyped (ShiftLeftTerm t1 t2) = [||shiftLeftTerm t1 t2||]
+  liftTyped (ShiftRightTerm t1 t2) = [||shiftRightTerm t1 t2||]
+  liftTyped (RotateLeftTerm t1 t2) = [||rotateLeftTerm t1 t2||]
+  liftTyped (RotateRightTerm t1 t2) = [||rotateRightTerm t1 t2||]
+  liftTyped (BitCastTerm t) = [||bitCastTerm t||]
+  liftTyped (BitCastOrTerm t1 t2) = [||bitCastOrTerm t1 t2||]
+  liftTyped (BVConcatTerm t1 t2) = [||bvConcatTerm t1 t2||]
+  liftTyped (BVSelectTerm (_ :: p ix) (_ :: q w) t3) =
+    let pix = [||Proxy||] :: CODE (Proxy ix)
+        pw = [||Proxy||] :: CODE (Proxy w)
+     in [||bvSelectTerm $$pix $$pw t3||]
+  liftTyped (BVExtendTerm b (_ :: p r) t2) =
+    let pr = [||Proxy||] :: CODE (Proxy r)
+     in [||bvExtendTerm b $$pr t2||]
+  liftTyped (ApplyTerm t1 t2) = [||applyTerm t1 t2||]
+  liftTyped (DivIntegralTerm t1 t2) = [||divIntegralTerm t1 t2||]
+  liftTyped (ModIntegralTerm t1 t2) = [||modIntegralTerm t1 t2||]
+  liftTyped (QuotIntegralTerm t1 t2) = [||quotIntegralTerm t1 t2||]
+  liftTyped (RemIntegralTerm t1 t2) = [||remIntegralTerm t1 t2||]
+  liftTyped (FPTraitTerm t1 t2) = [||fpTraitTerm t1 t2||]
+  liftTyped (FdivTerm t1 t2) = [||fdivTerm t1 t2||]
+  liftTyped (RecipTerm t) = [||recipTerm t||]
+  liftTyped (FloatingUnaryTerm t1 t2) = [||floatingUnaryTerm t1 t2||]
+  liftTyped (PowerTerm t1 t2) = [||powerTerm t1 t2||]
+  liftTyped (FPUnaryTerm t1 t2) = [||fpUnaryTerm t1 t2||]
+  liftTyped (FPBinaryTerm t1 t2 t3) = [||fpBinaryTerm t1 t2 t3||]
+  liftTyped (FPRoundingUnaryTerm t1 t2 t3) =
+    [||fpRoundingUnaryTerm t1 t2 t3||]
+  liftTyped (FPRoundingBinaryTerm t1 t2 t3 t4) =
+    [||fpRoundingBinaryTerm t1 t2 t3 t4||]
+  liftTyped (FPFMATerm t1 t2 t3 t4) = [||fpFMATerm t1 t2 t3 t4||]
+  liftTyped (FromIntegralTerm t) = [||fromIntegralTerm t||]
+  liftTyped (FromFPOrTerm t1 t2 t3) = [||fromFPOrTerm t1 t2 t3||]
+  liftTyped (ToFPTerm t1 t2 _ _) =
+    [||toFPTerm t1 t2||]
+
+instance Show (Term ty) where
+  show t@(ConTerm v) =
+    "ConTerm{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", v="
+      ++ pformatCon v
+      ++ "}"
+  show t@(SymTerm name@TypedSymbol {}) =
+    "SymTerm{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", name="
+      ++ show name
+      ++ ", type="
+      ++ show (primTypeRep @ty)
+      ++ "}"
+  show t@(ForallTerm sym arg) =
+    "Forall{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", sym="
+      ++ show sym
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(ExistsTerm sym arg) =
+    "Exists{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", sym="
+      ++ show sym
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(NotTerm arg) =
+    "Not{tid=" ++ show (termThreadId t) ++ ", id=" ++ show (termId t) ++ ", arg=" ++ show arg ++ "}"
+  show t@(OrTerm arg1 arg2) =
+    "Or{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(AndTerm arg1 arg2) =
+    "And{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(EqTerm arg1 arg2) =
+    "Eqv{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(DistinctTerm args) =
+    "Distinct{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", args="
+      ++ show args
+      ++ "}"
+  show t@(ITETerm cond l r) =
+    "ITE{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", cond="
+      ++ show cond
+      ++ ", then="
+      ++ show l
+      ++ ", else="
+      ++ show r
+      ++ "}"
+  show t@(AddNumTerm arg1 arg2) =
+    "AddNum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(NegNumTerm arg) =
+    "NegNum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(MulNumTerm arg1 arg2) =
+    "MulNum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(AbsNumTerm arg) =
+    "AbsNum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(SignumNumTerm arg) =
+    "SignumNum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(LtOrdTerm arg1 arg2) =
+    "LTNum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(LeOrdTerm arg1 arg2) =
+    "LENum{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(AndBitsTerm arg1 arg2) =
+    "AndBits{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(OrBitsTerm arg1 arg2) =
+    "OrBits{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(XorBitsTerm arg1 arg2) =
+    "XorBits{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(ComplementBitsTerm arg) =
+    "ComplementBits{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(ShiftLeftTerm arg n) =
+    "ShiftLeft{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ ", n="
+      ++ show n
+      ++ "}"
+  show t@(ShiftRightTerm arg n) =
+    "ShiftRight{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ ", n="
+      ++ show n
+      ++ "}"
+  show t@(RotateLeftTerm arg n) =
+    "RotateLeft{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ ", n="
+      ++ show n
+      ++ "}"
+  show t@(RotateRightTerm arg n) =
+    "RotateRight{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ ", n="
+      ++ show n
+      ++ "}"
+  show t@(BitCastTerm arg) =
+    "BitCast{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(BitCastOrTerm arg d) =
+    "BitCastOr{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", default="
+      ++ show d
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(BVConcatTerm arg1 arg2) =
+    "BVConcat{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(BVSelectTerm ix w arg) =
+    "BVSelect{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", ix="
+      ++ show (natVal ix)
+      ++ ", w="
+      ++ show (natVal w)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(BVExtendTerm signed n arg) =
+    "BVExtend{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", signed="
+      ++ show signed
+      ++ ", n="
+      ++ show (natVal n)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(ApplyTerm func arg) =
+    "Apply{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", f="
+      ++ show func
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(DivIntegralTerm arg1 arg2) =
+    "DivIntegral{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(ModIntegralTerm arg1 arg2) =
+    "ModIntegral{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(QuotIntegralTerm arg1 arg2) =
+    "QuotIntegral{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(RemIntegralTerm arg1 arg2) =
+    "RemIntegral{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(FPTraitTerm trait arg) =
+    "FPTrait{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", trait="
+      ++ show trait
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(FdivTerm arg1 arg2) =
+    "Fdiv{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(RecipTerm arg) =
+    "Recip{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(FloatingUnaryTerm op arg) =
+    "FloatingUnary{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", op="
+      ++ show op
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(PowerTerm arg1 arg2) =
+    "Power{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(FPUnaryTerm op arg) =
+    "FPUnary{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", op="
+      ++ show op
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(FPBinaryTerm op arg1 arg2) =
+    "FPBinary{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", op="
+      ++ show op
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(FPRoundingUnaryTerm op mode arg) =
+    "FPRoundingUnary{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", op="
+      ++ show op
+      ++ ", mode="
+      ++ show mode
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(FPRoundingBinaryTerm op mode arg1 arg2) =
+    "FPRoundingBinary{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", op="
+      ++ show op
+      ++ ", mode="
+      ++ show mode
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ "}"
+  show t@(FPFMATerm mode arg1 arg2 arg3) =
+    "FPFMA{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", mode="
+      ++ show mode
+      ++ ", arg1="
+      ++ show arg1
+      ++ ", arg2="
+      ++ show arg2
+      ++ ", arg3="
+      ++ show arg3
+      ++ "}"
+  show t@(FromIntegralTerm arg) =
+    "FromIntegral{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(FromFPOrTerm arg d mode) =
+    "FromFPTerm{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", default="
+      ++ show d
+      ++ ", mode="
+      ++ show mode
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+  show t@(ToFPTerm arg mode _ _) =
+    "ToFPTerm{tid="
+      ++ show (termThreadId t)
+      ++ ", id="
+      ++ show (termId t)
+      ++ ", mode="
+      ++ show mode
+      ++ ", arg="
+      ++ show arg
+      ++ "}"
+
+-- {-# INLINE show #-}
+
+-- | Pretty-print a term, possibly eliding parts of it.
+prettyPrintTerm :: Term t -> Doc ann
+prettyPrintTerm v@SupportedTerm =
+  column
+    ( \c ->
+        pageWidth $ \case
+          AvailablePerLine i r ->
+            if fromIntegral (c + len) > fromIntegral i * r
+              then "..."
+              else pretty formatted
+          Unbounded -> pretty formatted
+    )
+  where
+    formatted = pformatTerm v
+    len = length formatted
+
+instance (SupportedPrim t) => Eq (Term t) where
+  a == b =
+    if threadId a == threadId b
+      then termId a == termId b
+      else unsafePerformIO $ do
+        tid <- myWeakThreadId
+        a' <- toCurThreadImpl tid a
+        b' <- toCurThreadImpl tid b
+        return $ a' == b'
+
+instance (SupportedPrim t) => Hashable (Term t) where
+  hashWithSalt s t = hashWithSalt s $ termHashId t
+  {-# INLINE hashWithSalt #-}
+
+-- | Term without identity (before internalizing).
+data UTerm t where
+  UConTerm :: (SupportedPrim t) => !t -> UTerm t
+  USymTerm :: !(TypedSymbol 'AnyKind t) -> UTerm t
+  UForallTerm ::
+    !(TypedSymbol 'ConstantKind t) ->
+    !(Term Bool) ->
+    UTerm Bool
+  UExistsTerm ::
+    !(TypedSymbol 'ConstantKind t) ->
+    !(Term Bool) ->
+    UTerm Bool
+  UNotTerm :: !(Term Bool) -> UTerm Bool
+  UOrTerm :: !(Term Bool) -> !(Term Bool) -> !(HS.HashSet (Term Bool)) -> UTerm Bool
+  UAndTerm :: !(Term Bool) -> !(Term Bool) -> !(HS.HashSet (Term Bool)) -> UTerm Bool
+  UEqTerm :: !(Term t) -> !(Term t) -> UTerm Bool
+  UDistinctTerm :: !(NonEmpty (Term t)) -> UTerm Bool
+  UITETerm ::
+    (SupportedPrim t) =>
+    !(Term Bool) ->
+    !(Term t) ->
+    !(Term t) ->
+    UTerm t
+  UAddNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UNegNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> UTerm t
+  UMulNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UAbsNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> UTerm t
+  USignumNumTerm :: (SupportedPrim t, PEvalNumTerm t) => !(Term t) -> UTerm t
+  ULtOrdTerm :: (SupportedPrim t, PEvalOrdTerm t) => !(Term t) -> !(Term t) -> UTerm Bool
+  ULeOrdTerm :: (SupportedPrim t, PEvalOrdTerm t) => !(Term t) -> !(Term t) -> UTerm Bool
+  UAndBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UOrBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UXorBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UComplementBitsTerm :: (SupportedPrim t, PEvalBitwiseTerm t) => !(Term t) -> UTerm t
+  UShiftLeftTerm ::
+    (SupportedPrim t, PEvalShiftTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UShiftRightTerm ::
+    (SupportedPrim t, PEvalShiftTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  URotateLeftTerm ::
+    (SupportedPrim t, PEvalRotateTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  URotateRightTerm ::
+    (SupportedPrim t, PEvalRotateTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UBitCastTerm ::
+    (SupportedPrim b, PEvalBitCastTerm a b) =>
+    !(Term a) ->
+    UTerm b
+  UBitCastOrTerm ::
+    (SupportedPrim b, PEvalBitCastOrTerm a b) =>
+    !(Term b) ->
+    !(Term a) ->
+    UTerm b
+  UBVConcatTerm ::
+    ( PEvalBVTerm bv,
+      KnownNat l,
+      KnownNat r,
+      KnownNat (l + r),
+      1 <= l,
+      1 <= r,
+      1 <= l + r,
+      SupportedPrim (bv (l + r))
+    ) =>
+    !(Term (bv l)) ->
+    !(Term (bv r)) ->
+    UTerm (bv (l + r))
+  UBVSelectTerm ::
+    ( PEvalBVTerm bv,
+      KnownNat n,
+      KnownNat ix,
+      KnownNat w,
+      1 <= n,
+      1 <= w,
+      ix + w <= n,
+      SupportedPrim (bv w)
+    ) =>
+    !(Proxy ix) ->
+    !(Proxy w) ->
+    !(Term (bv n)) ->
+    UTerm (bv w)
+  UBVExtendTerm ::
+    ( PEvalBVTerm bv,
+      KnownNat l,
+      KnownNat r,
+      1 <= l,
+      1 <= r,
+      l <= r,
+      SupportedPrim (bv r)
+    ) =>
+    !Bool ->
+    !(Proxy r) ->
+    !(Term (bv l)) ->
+    UTerm (bv r)
+  UApplyTerm ::
+    (PEvalApplyTerm f a b, SupportedPrim b) =>
+    Term f ->
+    Term a ->
+    UTerm b
+  UDivIntegralTerm ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    !(Term t) ->
+    !(Term t) ->
+    UTerm t
+  UModIntegralTerm ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    !(Term t) ->
+    !(Term t) ->
+    UTerm t
+  UQuotIntegralTerm ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    !(Term t) ->
+    !(Term t) ->
+    UTerm t
+  URemIntegralTerm ::
+    (SupportedPrim t, PEvalDivModIntegralTerm t) =>
+    !(Term t) ->
+    !(Term t) ->
+    UTerm t
+  UFPTraitTerm ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    !FPTrait ->
+    !(Term (fp eb sb)) ->
+    UTerm Bool
+  UFdivTerm ::
+    (SupportedPrim t, PEvalFractionalTerm t) =>
+    !(Term t) ->
+    !(Term t) ->
+    UTerm t
+  URecipTerm :: (SupportedPrim t, PEvalFractionalTerm t) => !(Term t) -> UTerm t
+  UFloatingUnaryTerm ::
+    (SupportedPrim t, PEvalFloatingTerm t) =>
+    !FloatingUnaryOp ->
+    !(Term t) ->
+    UTerm t
+  UPowerTerm ::
+    (SupportedPrim t, PEvalFloatingTerm t) => !(Term t) -> !(Term t) -> UTerm t
+  UFPUnaryTerm ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    !FPUnaryOp ->
+    !(Term (fp eb sb)) ->
+    UTerm (fp eb sb)
+  UFPBinaryTerm ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    !FPBinaryOp ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    UTerm (fp eb sb)
+  UFPRoundingUnaryTerm ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    !FPRoundingUnaryOp ->
+    !(Term FPRoundingMode) ->
+    !(Term (fp eb sb)) ->
+    UTerm (fp eb sb)
+  UFPRoundingBinaryTerm ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    !FPRoundingBinaryOp ->
+    !(Term FPRoundingMode) ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    UTerm (fp eb sb)
+  UFPFMATerm ::
+    (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+    !(Term FPRoundingMode) ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    !(Term (fp eb sb)) ->
+    UTerm (fp eb sb)
+  UFromIntegralTerm ::
+    (PEvalFromIntegralTerm a b, SupportedPrim b) =>
+    !(Term a) ->
+    UTerm b
+  UFromFPOrTerm ::
+    ( PEvalIEEEFPConvertibleTerm a,
+      SupportedPrim a,
+      ValidFP eb sb
+    ) =>
+    Term a ->
+    !(Term FPRoundingMode) ->
+    !(Term (FP eb sb)) ->
+    UTerm a
+  UToFPTerm ::
+    ( PEvalIEEEFPConvertibleTerm a,
+      ValidFP eb sb,
+      SupportedPrim (FP eb sb)
+    ) =>
+    !(Term FPRoundingMode) ->
+    !(Term a) ->
+    Proxy eb ->
+    Proxy sb ->
+    UTerm (FP eb sb)
+
+-- | Compare two t'TypedSymbol's for equality.
+eqHeteroSymbol :: forall ta a tb b. TypedSymbol ta a -> TypedSymbol tb b -> Bool
+eqHeteroSymbol (TypedSymbol taga) (TypedSymbol tagb) =
+  case eqTypeRep (primTypeRep @a) (primTypeRep @b) of
+    Just HRefl -> taga == tagb
+    Nothing -> False
+{-# INLINE eqHeteroSymbol #-}
+
+preHashConDescription :: (SupportedPrim t) => t -> Digest
+preHashConDescription = fromIntegral . hashConWithSalt 0
+{-# INLINE preHashConDescription #-}
+
+preHashSymDescription :: TypedSymbol 'AnyKind t -> Digest
+preHashSymDescription = fromIntegral . hashWithSalt 1
+{-# INLINE preHashSymDescription #-}
+
+preHashForallDescription ::
+  TypedSymbol 'ConstantKind t -> HashId -> Digest
+preHashForallDescription sym h =
+  fromIntegral
+    ( 2
+        `hashWithSalt` sym
+        `hashWithSalt` h
+    )
+{-# INLINE preHashForallDescription #-}
+
+preHashExistsDescription ::
+  TypedSymbol 'ConstantKind t -> HashId -> Digest
+preHashExistsDescription sym h =
+  fromIntegral
+    ( 3
+        `hashWithSalt` sym
+        `hashWithSalt` h
+    )
+{-# INLINE preHashExistsDescription #-}
+
+preHashNotDescription :: HashId -> Digest
+preHashNotDescription = fromIntegral . hashWithSalt 7
+{-# INLINE preHashNotDescription #-}
+
+preHashOrDescription :: HashId -> HashId -> Digest
+preHashOrDescription h1 h2 =
+  fromIntegral (8 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashOrDescription #-}
+
+preHashAndDescription :: HashId -> HashId -> Digest
+preHashAndDescription h1 h2 =
+  fromIntegral (9 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashAndDescription #-}
+
+preHashEqDescription :: Fingerprint -> HashId -> HashId -> Digest
+preHashEqDescription tp h1 h2 =
+  fromIntegral (10 `hashWithSalt` tp `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashEqDescription #-}
+
+preHashDistinctDescription :: Fingerprint -> NonEmpty HashId -> Digest
+preHashDistinctDescription tp hs =
+  fromIntegral (11 `hashWithSalt` tp `hashWithSalt` hs)
+{-# INLINE preHashDistinctDescription #-}
+
+preHashITEDescription :: HashId -> HashId -> HashId -> Digest
+preHashITEDescription h1 h2 h3 =
+  fromIntegral (12 `hashWithSalt` h1 `hashWithSalt` h2 `hashWithSalt` h3)
+{-# INLINE preHashITEDescription #-}
+
+preHashAddNumDescription :: HashId -> HashId -> Digest
+preHashAddNumDescription h1 h2 =
+  fromIntegral (13 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashAddNumDescription #-}
+
+preHashNegNumDescription :: HashId -> Digest
+preHashNegNumDescription =
+  fromIntegral . hashWithSalt 14
+{-# INLINE preHashNegNumDescription #-}
+
+preHashMulNumDescription :: HashId -> HashId -> Digest
+preHashMulNumDescription h1 h2 =
+  fromIntegral (15 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashMulNumDescription #-}
+
+preHashAbsNumDescription :: HashId -> Digest
+preHashAbsNumDescription = fromIntegral . hashWithSalt 16
+{-# INLINE preHashAbsNumDescription #-}
+
+preHashSignumNumDescription :: HashId -> Digest
+preHashSignumNumDescription = fromIntegral . hashWithSalt 17
+{-# INLINE preHashSignumNumDescription #-}
+
+preHashLtOrdDescription :: Fingerprint -> HashId -> HashId -> Digest
+preHashLtOrdDescription tp h1 h2 =
+  fromIntegral (18 `hashWithSalt` tp `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashLtOrdDescription #-}
+
+preHashLeOrdDescription :: Fingerprint -> HashId -> HashId -> Digest
+preHashLeOrdDescription tp h1 h2 =
+  fromIntegral (19 `hashWithSalt` tp `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashLeOrdDescription #-}
+
+preHashAndBitsDescription :: HashId -> HashId -> Digest
+preHashAndBitsDescription h1 h2 =
+  fromIntegral (20 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashAndBitsDescription #-}
+
+preHashOrBitsDescription :: HashId -> HashId -> Digest
+preHashOrBitsDescription h1 h2 =
+  fromIntegral (21 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashOrBitsDescription #-}
+
+preHashXorBitsDescription :: HashId -> HashId -> Digest
+preHashXorBitsDescription h1 h2 =
+  fromIntegral (22 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashXorBitsDescription #-}
+
+preHashComplementBitsDescription :: HashId -> Digest
+preHashComplementBitsDescription = fromIntegral . hashWithSalt 23
+{-# INLINE preHashComplementBitsDescription #-}
+
+preHashShiftLeftDescription :: HashId -> HashId -> Digest
+preHashShiftLeftDescription h1 h2 =
+  fromIntegral (24 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashShiftLeftDescription #-}
+
+preHashShiftRightDescription :: HashId -> HashId -> Digest
+preHashShiftRightDescription h1 h2 =
+  fromIntegral (25 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashShiftRightDescription #-}
+
+preHashRotateLeftDescription :: HashId -> HashId -> Digest
+preHashRotateLeftDescription h1 h2 =
+  fromIntegral (26 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashRotateLeftDescription #-}
+
+preHashRotateRightDescription :: HashId -> HashId -> Digest
+preHashRotateRightDescription h1 h2 =
+  fromIntegral (27 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashRotateRightDescription #-}
+
+preHashBVConcatDescription :: TypeHashId -> TypeHashId -> Digest
+preHashBVConcatDescription h1 h2 =
+  fromIntegral
+    ( 28
+        `hashWithSalt` h1
+        `hashWithSalt` h2
+    )
+
+preHashBVSelectDescription :: Fingerprint -> TypeHashId -> Digest
+preHashBVSelectDescription tp h =
+  fromIntegral (29 `hashWithSalt` tp `hashWithSalt` h)
+
+preHashBVExtendDescription :: Bool -> TypeHashId -> Digest
+preHashBVExtendDescription signed h =
+  fromIntegral (30 `hashWithSalt` signed `hashWithSalt` h)
+
+preHashBitCastDescription :: TypeHashId -> Digest
+preHashBitCastDescription = fromIntegral . hashWithSalt 31
+{-# INLINE preHashBitCastDescription #-}
+
+preHashBitCastOrDescription :: HashId -> TypeHashId -> Digest
+preHashBitCastOrDescription h1 h2 =
+  fromIntegral (32 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashBitCastOrDescription #-}
+
+preHashApplyDescription :: TypeHashId -> TypeHashId -> Digest
+preHashApplyDescription h1 h2 =
+  fromIntegral (33 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashApplyDescription #-}
+
+preHashDivIntegralDescription :: HashId -> HashId -> Digest
+preHashDivIntegralDescription h1 h2 =
+  fromIntegral (34 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashDivIntegralDescription #-}
+
+preHashModIntegralDescription :: HashId -> HashId -> Digest
+preHashModIntegralDescription h1 h2 =
+  fromIntegral (35 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashModIntegralDescription #-}
+
+preHashQuotIntegralDescription :: HashId -> HashId -> Digest
+preHashQuotIntegralDescription h1 h2 =
+  fromIntegral (36 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashQuotIntegralDescription #-}
+
+preHashRemIntegralDescription :: HashId -> HashId -> Digest
+preHashRemIntegralDescription h1 h2 =
+  fromIntegral (37 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashRemIntegralDescription #-}
+
+preHashFPTraitDescription :: FPTrait -> TypeHashId -> Digest
+preHashFPTraitDescription trait h =
+  fromIntegral (38 `hashWithSalt` trait `hashWithSalt` h)
+{-# INLINE preHashFPTraitDescription #-}
+
+preHashFdivDescription :: HashId -> HashId -> Digest
+preHashFdivDescription h1 h2 =
+  fromIntegral (39 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashFdivDescription #-}
+
+preHashRecipDescription :: HashId -> Digest
+preHashRecipDescription = fromIntegral . hashWithSalt 40
+{-# INLINE preHashRecipDescription #-}
+
+preHashFloatingUnaryDescription :: FloatingUnaryOp -> HashId -> Digest
+preHashFloatingUnaryDescription op h =
+  fromIntegral (41 `hashWithSalt` op `hashWithSalt` h)
+{-# INLINE preHashFloatingUnaryDescription #-}
+
+preHashPowerDescription :: HashId -> HashId -> Digest
+preHashPowerDescription h1 h2 =
+  fromIntegral (42 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashPowerDescription #-}
+
+preHashFPUnaryDescription :: FPUnaryOp -> HashId -> Digest
+preHashFPUnaryDescription op h =
+  fromIntegral (43 `hashWithSalt` op `hashWithSalt` h)
+{-# INLINE preHashFPUnaryDescription #-}
+
+preHashFPBinaryDescription :: FPBinaryOp -> HashId -> HashId -> Digest
+preHashFPBinaryDescription op h1 h2 =
+  fromIntegral (44 `hashWithSalt` op `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashFPBinaryDescription #-}
+
+preHashFPRoundingUnaryDescription ::
+  FPRoundingUnaryOp -> HashId -> HashId -> Digest
+preHashFPRoundingUnaryDescription op mode h =
+  fromIntegral (45 `hashWithSalt` op `hashWithSalt` mode `hashWithSalt` h)
+{-# INLINE preHashFPRoundingUnaryDescription #-}
+
+preHashFPRoundingBinaryDescription ::
+  FPRoundingBinaryOp -> HashId -> HashId -> HashId -> Digest
+preHashFPRoundingBinaryDescription op mode h1 h2 =
+  fromIntegral
+    ( 46
+        `hashWithSalt` op
+        `hashWithSalt` mode
+        `hashWithSalt` h1
+        `hashWithSalt` h2
+    )
+
+preHashFPFMADescription ::
+  HashId -> HashId -> HashId -> HashId -> Digest
+preHashFPFMADescription mode h1 h2 h3 =
+  fromIntegral
+    ( 47
+        `hashWithSalt` mode
+        `hashWithSalt` h1
+        `hashWithSalt` h2
+        `hashWithSalt` h3
+    )
+{-# INLINE preHashFPFMADescription #-}
+
+preHashFromIntegralDescription :: TypeHashId -> Digest
+preHashFromIntegralDescription = fromIntegral . hashWithSalt 48
+{-# INLINE preHashFromIntegralDescription #-}
+
+preHashFromFPOrDescription ::
+  HashId -> HashId -> TypeHashId -> Digest
+preHashFromFPOrDescription h1 h2 h3 =
+  fromIntegral (49 `hashWithSalt` h1 `hashWithSalt` h2 `hashWithSalt` h3)
+{-# INLINE preHashFromFPOrDescription #-}
+
+preHashToFPTermDescription :: HashId -> TypeHashId -> Digest
+preHashToFPTermDescription h1 h2 =
+  fromIntegral (50 `hashWithSalt` h1 `hashWithSalt` h2)
+{-# INLINE preHashToFPTermDescription #-}
+
+instance Interned (Term t) where
+  type Uninterned (Term t) = UTerm t
+  data Description (Term t) where
+    DConTerm ::
+      (t -> t -> Bool) -> {-# UNPACK #-} !Digest -> t -> Description (Term t)
+    DSymTerm ::
+      {-# UNPACK #-} !Digest ->
+      TypedSymbol 'AnyKind t ->
+      Description (Term t)
+    DForallTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !(TypedSymbol 'ConstantKind t) ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term Bool)
+    DExistsTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !(TypedSymbol 'ConstantKind t) ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term Bool)
+    DNotTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term Bool)
+    DOrTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      !(HS.HashSet (Term Bool)) ->
+      Description (Term Bool)
+    DAndTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      !(HS.HashSet (Term Bool)) ->
+      Description (Term Bool)
+    DEqTerm ::
+      {-# UNPACK #-} !Digest ->
+      Fingerprint ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term Bool)
+    DDistinctTerm ::
+      {-# UNPACK #-} !Digest ->
+      Fingerprint ->
+      !(NonEmpty HashId) ->
+      Description (Term Bool)
+    DITETerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DAddNumTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DNegNumTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DMulNumTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DAbsNumTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DSignumNumTerm ::
+      {-# UNPACK #-} !Digest -> {-# UNPACK #-} !HashId -> Description (Term t)
+    DLtOrdTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !Fingerprint ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term Bool)
+    DLeOrdTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !Fingerprint ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term Bool)
+    DAndBitsTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DOrBitsTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DXorBitsTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DComplementBitsTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DShiftLeftTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DShiftRightTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DRotateLeftTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DRotateRightTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term t)
+    DBVConcatTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !TypeHashId ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term t)
+    DBitCastTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term b)
+    DBitCastOrTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term b)
+    DBVSelectTerm ::
+      forall bv (w :: Nat).
+      {-# UNPACK #-} !Digest ->
+      !Fingerprint ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term (bv w))
+    DBVExtendTerm ::
+      forall bv (r :: Nat).
+      {-# UNPACK #-} !Digest ->
+      !Bool ->
+      !(Proxy r) ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term (bv r))
+    DApplyTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !TypeHashId ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term b)
+    DDivIntegralTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DModIntegralTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DQuotIntegralTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DRemIntegralTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DFPTraitTerm ::
+      {-# UNPACK #-} !Digest ->
+      FPTrait ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term Bool)
+    DFdivTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DRecipTerm ::
+      {-# UNPACK #-} !Digest -> {-# UNPACK #-} !HashId -> Description (Term a)
+    DFloatingUnaryTerm ::
+      {-# UNPACK #-} !Digest ->
+      FloatingUnaryOp ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DPowerTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term a)
+    DFPUnaryTerm ::
+      forall fp (eb :: Nat) (sb :: Nat).
+      {-# UNPACK #-} !Digest ->
+      FPUnaryOp ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term (fp eb sb))
+    DFPBinaryTerm ::
+      forall fp (eb :: Nat) (sb :: Nat).
+      {-# UNPACK #-} !Digest ->
+      FPBinaryOp ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term (fp eb sb))
+    DFPRoundingUnaryTerm ::
+      forall fp (eb :: Nat) (sb :: Nat).
+      {-# UNPACK #-} !Digest ->
+      FPRoundingUnaryOp ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term (fp eb sb))
+    DFPRoundingBinaryTerm ::
+      forall fp (eb :: Nat) (sb :: Nat).
+      {-# UNPACK #-} !Digest ->
+      FPRoundingBinaryOp ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term (fp eb sb))
+    DFPFMATerm ::
+      forall fp (eb :: Nat) (sb :: Nat).
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      Description (Term (fp eb sb))
+    DFromIntegralTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term b)
+    DFromFPOrTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term a)
+    DToFPTerm ::
+      {-# UNPACK #-} !Digest ->
+      {-# UNPACK #-} !HashId ->
+      {-# UNPACK #-} !TypeHashId ->
+      Description (Term (FP eb sb))
+
+  describe (UConTerm v) = DConTerm sameCon (preHashConDescription v) v
+  describe ((USymTerm name) :: UTerm t) =
+    DSymTerm @t (preHashSymDescription name) name
+  describe (UForallTerm (sym :: TypedSymbol 'ConstantKind arg) arg) =
+    let argHashId = termHashId arg
+     in DForallTerm (preHashForallDescription sym argHashId) sym argHashId
+  describe (UExistsTerm (sym :: TypedSymbol 'ConstantKind arg) arg) =
+    let argHashId = termHashId arg
+     in DExistsTerm (preHashExistsDescription sym argHashId) sym argHashId
+  describe (UNotTerm arg) =
+    let argHashId = termHashId arg
+     in DNotTerm (preHashNotDescription argHashId) argHashId
+  describe (UOrTerm arg1 arg2 s) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DOrTerm
+          (preHashOrDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+          s
+  describe (UAndTerm arg1 arg2 s) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DAndTerm
+          (preHashAndDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+          s
+  describe (UEqTerm (arg1@SupportedTerm :: Term arg) arg2) = do
+    let fingerprint = typeFingerprint @arg
+        arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DEqTerm
+          (preHashEqDescription fingerprint arg1HashId arg2HashId)
+          fingerprint
+          arg1HashId
+          arg2HashId
+  describe (UDistinctTerm args@((SupportedTerm :: Term arg) :| _)) =
+    let fingerprint = typeFingerprint @arg
+        argsHashId = termHashId <$> args
+     in DDistinctTerm
+          (preHashDistinctDescription fingerprint argsHashId)
+          fingerprint
+          argsHashId
+  describe (UITETerm cond (l :: Term arg) r) =
+    let condHashId = termHashId cond
+        lHashId = termHashId l
+        rHashId = termHashId r
+     in DITETerm
+          (preHashITEDescription condHashId lHashId rHashId)
+          condHashId
+          lHashId
+          rHashId
+  describe (UAddNumTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DAddNumTerm
+          (preHashAddNumDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UNegNumTerm arg) =
+    let argHashId = termHashId arg
+     in DNegNumTerm (preHashNegNumDescription argHashId) argHashId
+  describe (UMulNumTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DMulNumTerm
+          (preHashMulNumDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UAbsNumTerm arg) =
+    let argHashId = termHashId arg
+     in DAbsNumTerm (preHashAbsNumDescription argHashId) argHashId
+  describe (USignumNumTerm arg) =
+    let argHashId = termHashId arg
+     in DSignumNumTerm (preHashSignumNumDescription argHashId) argHashId
+  describe (ULtOrdTerm (arg1 :: Term arg) arg2) =
+    let tr = typeFingerprint @arg
+        arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DLtOrdTerm
+          (preHashLtOrdDescription tr arg1HashId arg2HashId)
+          tr
+          arg1HashId
+          arg2HashId
+  describe (ULeOrdTerm (arg1 :: Term arg) arg2) =
+    let tr = typeFingerprint @arg
+        arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DLeOrdTerm
+          (preHashLeOrdDescription tr arg1HashId arg2HashId)
+          tr
+          arg1HashId
+          arg2HashId
+  describe (UAndBitsTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DAndBitsTerm
+          (preHashAndBitsDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UOrBitsTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DOrBitsTerm
+          (preHashOrBitsDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UXorBitsTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DXorBitsTerm
+          (preHashXorBitsDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UComplementBitsTerm arg) =
+    let argHashId = termHashId arg
+     in DComplementBitsTerm
+          (preHashComplementBitsDescription argHashId)
+          argHashId
+  describe (UShiftLeftTerm arg n) =
+    let argHashId = termHashId arg
+        nHashId = termHashId n
+     in DShiftLeftTerm
+          (preHashShiftLeftDescription argHashId nHashId)
+          argHashId
+          nHashId
+  describe (UShiftRightTerm arg n) =
+    let argHashId = termHashId arg
+        nHashId = termHashId n
+     in DShiftRightTerm
+          (preHashShiftRightDescription argHashId nHashId)
+          argHashId
+          nHashId
+  describe (URotateLeftTerm arg n) =
+    let argHashId = termHashId arg
+        nHashId = termHashId n
+     in DRotateLeftTerm
+          (preHashRotateLeftDescription argHashId nHashId)
+          argHashId
+          nHashId
+  describe (URotateRightTerm arg n) =
+    let argHashId = termHashId arg
+        nHashId = termHashId n
+     in DRotateRightTerm
+          (preHashRotateRightDescription argHashId nHashId)
+          argHashId
+          nHashId
+  describe (UBitCastTerm (arg :: Term a)) =
+    let argHashId = termTypeHashId arg
+     in DBitCastTerm (preHashBitCastDescription argHashId) argHashId
+  describe (UBitCastOrTerm d (arg :: Term a)) =
+    let dHashId = termHashId d
+        argHashId = termTypeHashId arg
+     in DBitCastOrTerm
+          (preHashBitCastOrDescription dHashId argHashId)
+          dHashId
+          argHashId
+  describe (UBVConcatTerm (arg1 :: Term bv1) (arg2 :: Term bv2)) =
+    let arg1HashId = termTypeHashId arg1
+        arg2HashId = termTypeHashId arg2
+     in DBVConcatTerm
+          (preHashBVConcatDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UBVSelectTerm (ix :: Proxy ix) _ (arg :: Term arg)) =
+    let ixFingerprint = typeRepFingerprint $ someTypeRep ix
+        argHashId = termTypeHashId arg
+     in DBVSelectTerm
+          (preHashBVSelectDescription ixFingerprint argHashId)
+          ixFingerprint
+          argHashId
+  describe (UBVExtendTerm signed (n :: Proxy n) (arg :: Term arg)) =
+    let argHashId = termTypeHashId arg
+     in DBVExtendTerm
+          (preHashBVExtendDescription signed argHashId)
+          signed
+          n
+          argHashId
+  describe (UApplyTerm (f :: Term f) (arg :: Term a)) =
+    let fHashId = termTypeHashId f
+        argHashId = termTypeHashId arg
+     in DApplyTerm
+          (preHashApplyDescription fHashId argHashId)
+          fHashId
+          argHashId
+  describe (UDivIntegralTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DDivIntegralTerm
+          (preHashDivIntegralDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UModIntegralTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DModIntegralTerm
+          (preHashModIntegralDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UQuotIntegralTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DQuotIntegralTerm
+          (preHashQuotIntegralDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (URemIntegralTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DRemIntegralTerm
+          (preHashRemIntegralDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UFPTraitTerm trait (arg :: Term arg)) =
+    let argHashId = termTypeHashId arg
+     in DFPTraitTerm
+          (preHashFPTraitDescription trait argHashId)
+          trait
+          argHashId
+  describe (UFdivTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DFdivTerm
+          (preHashFdivDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (URecipTerm arg) =
+    let argHashId = termHashId arg
+     in DRecipTerm (preHashRecipDescription argHashId) argHashId
+  describe (UFloatingUnaryTerm op arg) =
+    let argHashId = termHashId arg
+     in DFloatingUnaryTerm
+          (preHashFloatingUnaryDescription op argHashId)
+          op
+          argHashId
+  describe (UPowerTerm arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DPowerTerm
+          (preHashPowerDescription arg1HashId arg2HashId)
+          arg1HashId
+          arg2HashId
+  describe (UFPUnaryTerm op arg) =
+    let argHashId = termHashId arg
+     in DFPUnaryTerm
+          (preHashFPUnaryDescription op argHashId)
+          op
+          argHashId
+  describe (UFPBinaryTerm op arg1 arg2) =
+    let arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DFPBinaryTerm
+          (preHashFPBinaryDescription op arg1HashId arg2HashId)
+          op
+          arg1HashId
+          arg2HashId
+  describe (UFPRoundingUnaryTerm op mode arg) =
+    let modeHashId = termHashId mode
+        argHashId = termHashId arg
+     in DFPRoundingUnaryTerm
+          (preHashFPRoundingUnaryDescription op modeHashId argHashId)
+          op
+          modeHashId
+          argHashId
+  describe (UFPRoundingBinaryTerm op mode arg1 arg2) =
+    let modeHashId = termHashId mode
+        arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+     in DFPRoundingBinaryTerm
+          ( preHashFPRoundingBinaryDescription
+              op
+              modeHashId
+              arg1HashId
+              arg2HashId
+          )
+          op
+          modeHashId
+          arg1HashId
+          arg2HashId
+  describe (UFPFMATerm mode arg1 arg2 arg3) =
+    let modeHashId = termHashId mode
+        arg1HashId = termHashId arg1
+        arg2HashId = termHashId arg2
+        arg3HashId = termHashId arg3
+     in DFPFMATerm
+          (preHashFPFMADescription modeHashId arg1HashId arg2HashId arg3HashId)
+          modeHashId
+          arg1HashId
+          arg2HashId
+          arg3HashId
+  describe (UFromIntegralTerm (arg :: Term a)) =
+    let argHashId = termTypeHashId arg
+     in DFromIntegralTerm (preHashFromIntegralDescription argHashId) argHashId
+  describe (UFromFPOrTerm d mode (arg :: Term a)) =
+    let dHashId = termHashId d
+        modeHashId = termHashId mode
+        argHashId = termTypeHashId arg
+     in DFromFPOrTerm
+          (preHashFromFPOrDescription dHashId modeHashId argHashId)
+          dHashId
+          modeHashId
+          argHashId
+  describe (UToFPTerm mode (arg :: Term a) _ _) =
+    let modeHashId = termHashId mode
+        argHashId = termTypeHashId arg
+     in DToFPTerm
+          (preHashToFPTermDescription modeHashId argHashId)
+          modeHashId
+          argHashId
+
+  -- {-# INLINE describe #-}
+
+  identify info = go
+    where
+      go (UConTerm v) = goPhantomCon info getPhantomDict v
+      go (USymTerm v) = SymTerm' info v
+      go (UForallTerm sym arg) = ForallTerm' info sym arg
+      go (UExistsTerm sym arg) = ExistsTerm' info sym arg
+      go (UNotTerm arg) = NotTerm' info arg
+      go (UOrTerm arg1 arg2 s) = OrTerm' info arg1 arg2 s
+      go (UAndTerm arg1 arg2 s) = AndTerm' info arg1 arg2 s
+      go (UEqTerm arg1 arg2) = EqTerm' info arg1 arg2
+      go (UDistinctTerm args) = DistinctTerm' info args
+      -- ITE is propagated
+      go (UITETerm cond l r) = ITETerm' info cond l r
+      go (UAddNumTerm arg1 arg2) = AddNumTerm' info arg1 arg2
+      go (UNegNumTerm arg) = NegNumTerm' info arg
+      go (UMulNumTerm arg1 arg2) = MulNumTerm' info arg1 arg2
+      go (UAbsNumTerm arg) = AbsNumTerm' info arg
+      go (USignumNumTerm arg) = SignumNumTerm' info arg
+      go (ULtOrdTerm arg1 arg2) = LtOrdTerm' info arg1 arg2
+      go (ULeOrdTerm arg1 arg2) = LeOrdTerm' info arg1 arg2
+      go (UAndBitsTerm arg1 arg2) = AndBitsTerm' info arg1 arg2
+      go (UOrBitsTerm arg1 arg2) = OrBitsTerm' info arg1 arg2
+      go (UXorBitsTerm arg1 arg2) = XorBitsTerm' info arg1 arg2
+      go (UComplementBitsTerm arg) = ComplementBitsTerm' info arg
+      go (UShiftLeftTerm arg n) = ShiftLeftTerm' info arg n
+      go (UShiftRightTerm arg n) = ShiftRightTerm' info arg n
+      go (URotateLeftTerm arg n) = RotateLeftTerm' info arg n
+      go (URotateRightTerm arg n) = RotateRightTerm' info arg n
+      go (UBitCastTerm arg) = goPhantomBitCast info getPhantomDict arg
+      go (UBitCastOrTerm d arg) = BitCastOrTerm' info d arg
+      go (UBVConcatTerm arg1 arg2) =
+        goPhantomBVConcat info getPhantomDict arg1 arg2
+      go (UBVSelectTerm ix w arg) =
+        goPhantomBVSelect info getPhantomDict ix w arg
+      go (UBVExtendTerm signed n arg) =
+        goPhantomBVExtend info getPhantomDict signed n arg
+      go (UApplyTerm f arg) = goPhantomApply info getPhantomDict f arg
+      go (UDivIntegralTerm arg1 arg2) = DivIntegralTerm' info arg1 arg2
+      go (UModIntegralTerm arg1 arg2) = ModIntegralTerm' info arg1 arg2
+      go (UQuotIntegralTerm arg1 arg2) = QuotIntegralTerm' info arg1 arg2
+      go (URemIntegralTerm arg1 arg2) = RemIntegralTerm' info arg1 arg2
+      go (UFPTraitTerm trait arg) =
+        goPhantomFPTrait info getPhantomDict trait arg
+      go (UFdivTerm arg1 arg2) = FdivTerm' info arg1 arg2
+      go (URecipTerm arg) = RecipTerm' info arg
+      go (UFloatingUnaryTerm op arg) = FloatingUnaryTerm' info op arg
+      go (UPowerTerm arg1 arg2) = PowerTerm' info arg1 arg2
+      go (UFPUnaryTerm op arg) = goPhantomFPUnary info getPhantomDict op arg
+      go (UFPBinaryTerm op arg1 arg2) =
+        goPhantomFPBinary info getPhantomDict op arg1 arg2
+      go (UFPRoundingUnaryTerm op mode arg) =
+        goPhantomFPRoundingUnary info getPhantomDict op mode arg
+      go (UFPRoundingBinaryTerm op mode arg1 arg2) =
+        goPhantomFPRoundingBinary info getPhantomDict op mode arg1 arg2
+      go (UFPFMATerm mode arg1 arg2 arg3) =
+        goPhantomFPFMA info getPhantomDict mode arg1 arg2 arg3
+      go (UFromIntegralTerm arg) =
+        goPhantomFromIntegral info getPhantomDict arg
+      go (UFromFPOrTerm d mode arg) = FromFPOrTerm' info d mode arg
+      go (UToFPTerm mode (arg :: Term a) _ _) =
+        goPhantomToFP info getPhantomDict mode arg
+      {-# INLINE go #-}
+
+  -- {-# INLINE identify #-}
+  threadId = termThreadId
+  {-# INLINE threadId #-}
+
+  descriptionDigest (DConTerm _ h _) = h
+  descriptionDigest (DSymTerm h _) = h
+  descriptionDigest (DForallTerm h _ _) = h
+  descriptionDigest (DExistsTerm h _ _) = h
+  descriptionDigest (DNotTerm h _) = h
+  descriptionDigest (DOrTerm h _ _ _) = h
+  descriptionDigest (DAndTerm h _ _ _) = h
+  descriptionDigest (DEqTerm h _ _ _) = h
+  descriptionDigest (DDistinctTerm h _ _) = h
+  descriptionDigest (DITETerm h _ _ _) = h
+  descriptionDigest (DAddNumTerm h _ _) = h
+  descriptionDigest (DNegNumTerm h _) = h
+  descriptionDigest (DMulNumTerm h _ _) = h
+  descriptionDigest (DAbsNumTerm h _) = h
+  descriptionDigest (DSignumNumTerm h _) = h
+  descriptionDigest (DLtOrdTerm h _ _ _) = h
+  descriptionDigest (DLeOrdTerm h _ _ _) = h
+  descriptionDigest (DAndBitsTerm h _ _) = h
+  descriptionDigest (DOrBitsTerm h _ _) = h
+  descriptionDigest (DXorBitsTerm h _ _) = h
+  descriptionDigest (DComplementBitsTerm h _) = h
+  descriptionDigest (DShiftLeftTerm h _ _) = h
+  descriptionDigest (DShiftRightTerm h _ _) = h
+  descriptionDigest (DRotateLeftTerm h _ _) = h
+  descriptionDigest (DRotateRightTerm h _ _) = h
+  descriptionDigest (DBitCastTerm h _) = h
+  descriptionDigest (DBitCastOrTerm h _ _) = h
+  descriptionDigest (DBVConcatTerm h _ _) = h
+  descriptionDigest (DBVSelectTerm h _ _) = h
+  descriptionDigest (DBVExtendTerm h _ _ _) = h
+  descriptionDigest (DDivIntegralTerm h _ _) = h
+  descriptionDigest (DModIntegralTerm h _ _) = h
+  descriptionDigest (DQuotIntegralTerm h _ _) = h
+  descriptionDigest (DRemIntegralTerm h _ _) = h
+  descriptionDigest (DApplyTerm h _ _) = h
+  descriptionDigest (DFPTraitTerm h _ _) = h
+  descriptionDigest (DFdivTerm h _ _) = h
+  descriptionDigest (DRecipTerm h _) = h
+  descriptionDigest (DFloatingUnaryTerm h _ _) = h
+  descriptionDigest (DPowerTerm h _ _) = h
+  descriptionDigest (DFPUnaryTerm h _ _) = h
+  descriptionDigest (DFPBinaryTerm h _ _ _) = h
+  descriptionDigest (DFPRoundingUnaryTerm h _ _ _) = h
+  descriptionDigest (DFPRoundingBinaryTerm h _ _ _ _) = h
+  descriptionDigest (DFPFMATerm h _ _ _ _) = h
+  descriptionDigest (DFromIntegralTerm h _) = h
+  descriptionDigest (DFromFPOrTerm h _ _ _) = h
+  descriptionDigest (DToFPTerm h _ _) = h
+
+-- {-# INLINE descriptionDigest #-}
+{-# NOINLINE goPhantomCon #-}
+goPhantomCon ::
+  CachedInfo ->
+  PhantomDict t ->
+  t ->
+  Term t
+goPhantomCon info PhantomDict v = ConTerm' info v
+
+{-# NOINLINE goPhantomBitCast #-}
+goPhantomBitCast ::
+  (PEvalBitCastTerm a t) =>
+  CachedInfo ->
+  PhantomDict t ->
+  Term a ->
+  Term t
+goPhantomBitCast info PhantomDict arg = BitCastTerm' info arg
+
+{-# NOINLINE goPhantomBVConcat #-}
+goPhantomBVConcat ::
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    KnownNat (l + r),
+    1 <= l,
+    1 <= r,
+    1 <= l + r
+  ) =>
+  CachedInfo ->
+  PhantomDict (bv (l + r)) ->
+  Term (bv l) ->
+  Term (bv r) ->
+  Term (bv (l + r))
+goPhantomBVConcat info PhantomDict arg1 arg2 =
+  BVConcatTerm' info arg1 arg2
+
+{-# NOINLINE goPhantomBVSelect #-}
+goPhantomBVSelect ::
+  ( PEvalBVTerm bv,
+    KnownNat n,
+    KnownNat ix,
+    KnownNat w,
+    1 <= n,
+    1 <= w,
+    ix + w <= n
+  ) =>
+  CachedInfo ->
+  PhantomDict (bv w) ->
+  Proxy ix ->
+  Proxy w ->
+  Term (bv n) ->
+  Term (bv w)
+goPhantomBVSelect info PhantomDict ix w arg =
+  BVSelectTerm' info ix w arg
+
+{-# NOINLINE goPhantomBVExtend #-}
+goPhantomBVExtend ::
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r
+  ) =>
+  CachedInfo ->
+  PhantomDict (bv r) ->
+  Bool ->
+  Proxy r ->
+  Term (bv l) ->
+  Term (bv r)
+goPhantomBVExtend info PhantomDict signed n arg =
+  BVExtendTerm' info signed n arg
+
+{-# NOINLINE goPhantomApply #-}
+goPhantomApply ::
+  (PEvalApplyTerm f a t) =>
+  CachedInfo ->
+  PhantomDict t ->
+  Term f ->
+  Term a ->
+  Term t
+goPhantomApply info PhantomDict f arg = ApplyTerm' info f arg
+
+{-# NOINLINE goPhantomFPTrait #-}
+goPhantomFPTrait ::
+  (ValidFP eb sb, PEvalFPTerm fp) =>
+  CachedInfo ->
+  PhantomDict (fp eb sb) ->
+  FPTrait ->
+  Term (fp eb sb) ->
+  Term Bool
+goPhantomFPTrait info PhantomDict trait arg = FPTraitTerm' info trait arg
+
+{-# NOINLINE goPhantomFPUnary #-}
+goPhantomFPUnary ::
+  (ValidFP eb sb, PEvalFPTerm fp) =>
+  CachedInfo ->
+  PhantomDict (fp eb sb) ->
+  FPUnaryOp ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+goPhantomFPUnary info PhantomDict op arg = FPUnaryTerm' info op arg
+
+{-# NOINLINE goPhantomFPBinary #-}
+goPhantomFPBinary ::
+  (ValidFP eb sb, PEvalFPTerm fp) =>
+  CachedInfo ->
+  PhantomDict (fp eb sb) ->
+  FPBinaryOp ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+goPhantomFPBinary info PhantomDict op arg1 arg2 =
+  FPBinaryTerm' info op arg1 arg2
+
+{-# NOINLINE goPhantomFPRoundingUnary #-}
+goPhantomFPRoundingUnary ::
+  (ValidFP eb sb, PEvalFPTerm fp) =>
+  CachedInfo ->
+  PhantomDict (fp eb sb) ->
+  FPRoundingUnaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+goPhantomFPRoundingUnary info PhantomDict op mode arg =
+  FPRoundingUnaryTerm' info op mode arg
+
+{-# NOINLINE goPhantomFPRoundingBinary #-}
+goPhantomFPRoundingBinary ::
+  (ValidFP eb sb, PEvalFPTerm fp) =>
+  CachedInfo ->
+  PhantomDict (fp eb sb) ->
+  FPRoundingBinaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+goPhantomFPRoundingBinary info PhantomDict op mode arg1 arg2 =
+  FPRoundingBinaryTerm' info op mode arg1 arg2
+
+{-# NOINLINE goPhantomFPFMA #-}
+goPhantomFPFMA ::
+  (ValidFP eb sb, PEvalFPTerm fp) =>
+  CachedInfo ->
+  PhantomDict (fp eb sb) ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+goPhantomFPFMA info PhantomDict mode arg1 arg2 arg3 =
+  FPFMATerm' info mode arg1 arg2 arg3
+
+{-# NOINLINE goPhantomFromIntegral #-}
+goPhantomFromIntegral ::
+  (PEvalFromIntegralTerm a b) =>
+  CachedInfo ->
+  PhantomDict b ->
+  Term a ->
+  Term b
+goPhantomFromIntegral info PhantomDict arg = FromIntegralTerm' info arg
+
+{-# NOINLINE goPhantomToFP #-}
+goPhantomToFP ::
+  forall a eb sb.
+  (ValidFP eb sb, PEvalIEEEFPConvertibleTerm a) =>
+  CachedInfo ->
+  PhantomDict (FP eb sb) ->
+  Term FPRoundingMode ->
+  Term a ->
+  Term (FP eb sb)
+goPhantomToFP info PhantomDict mode arg =
+  ToFPTerm' info mode arg (Proxy @eb) (Proxy @sb)
+
+instance Eq (Description (Term t)) where
+  DConTerm eqFunc _ l == DConTerm _ _ r =
+    eqFunc l r
+  DSymTerm _ ls == DSymTerm _ rs = ls == rs
+  DForallTerm _ ls li == DForallTerm _ rs ri =
+    eqHeteroSymbol ls rs && eqHashId li ri
+  DExistsTerm _ ls li == DExistsTerm _ rs ri =
+    eqHeteroSymbol ls rs && eqHashId li ri
+  DNotTerm _ li == DNotTerm _ ri = eqHashId li ri
+  DOrTerm _ li1 li2 _ == DOrTerm _ ri1 ri2 _ = eqHashId li1 ri1 && eqHashId li2 ri2
+  DAndTerm _ li1 li2 _ == DAndTerm _ ri1 ri2 _ = eqHashId li1 ri1 && eqHashId li2 ri2
+  DEqTerm _ lfp li1 li2 == DEqTerm _ rfp ri1 ri2 = lfp == rfp && eqHashId li1 ri1 && eqHashId li2 ri2
+  DDistinctTerm _ lfp li == DDistinctTerm _ rfp ri =
+    lfp == rfp
+      && length li == length ri
+      && and (zipWith eqHashId (toList li) (toList ri))
+  DITETerm _ lc li1 li2 == DITETerm _ rc ri1 ri2 = eqHashId lc rc && eqHashId li1 ri1 && eqHashId li2 ri2
+  DAddNumTerm _ li1 li2 == DAddNumTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DNegNumTerm _ li == DNegNumTerm _ ri = eqHashId li ri
+  DMulNumTerm _ li1 li2 == DMulNumTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DAbsNumTerm _ li == DAbsNumTerm _ ri = eqHashId li ri
+  DSignumNumTerm _ li == DSignumNumTerm _ ri = eqHashId li ri
+  DLtOrdTerm _ lrep li1 li2 == DLtOrdTerm _ rrep ri1 ri2 = lrep == rrep && eqHashId li1 ri1 && eqHashId li2 ri2
+  DLeOrdTerm _ lrep li1 li2 == DLeOrdTerm _ rrep ri1 ri2 = lrep == rrep && eqHashId li1 ri1 && eqHashId li2 ri2
+  DAndBitsTerm _ li1 li2 == DAndBitsTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DOrBitsTerm _ li1 li2 == DOrBitsTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DXorBitsTerm _ li1 li2 == DXorBitsTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DComplementBitsTerm _ li == DComplementBitsTerm _ ri = eqHashId li ri
+  DShiftLeftTerm _ li ln == DShiftLeftTerm _ ri rn = eqHashId li ri && eqHashId ln rn
+  DShiftRightTerm _ li ln == DShiftRightTerm _ ri rn = eqHashId li ri && eqHashId ln rn
+  DRotateLeftTerm _ li ln == DRotateLeftTerm _ ri rn = eqHashId li ri && eqHashId ln rn
+  DRotateRightTerm _ li ln == DRotateRightTerm _ ri rn = eqHashId li ri && eqHashId ln rn
+  DBitCastTerm _ li == DBitCastTerm _ ri = li == ri
+  DBitCastOrTerm _ ld li == DBitCastOrTerm _ rd ri = ld == rd && li == ri
+  DBVConcatTerm _ li1 li2 == DBVConcatTerm _ ri1 ri2 = li1 == ri1 && li2 == ri2
+  DBVSelectTerm _ lix li == DBVSelectTerm _ rix ri =
+    lix == rix && li == ri
+  DBVExtendTerm _ lIsSigned _ li == DBVExtendTerm _ rIsSigned _ ri =
+    lIsSigned == rIsSigned
+      && li == ri
+  DApplyTerm _ lf li == DApplyTerm _ rf ri = lf == rf && li == ri
+  DDivIntegralTerm _ li1 li2 == DDivIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DModIntegralTerm _ li1 li2 == DModIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DQuotIntegralTerm _ li1 li2 == DQuotIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DRemIntegralTerm _ li1 li2 == DRemIntegralTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DFPTraitTerm _ lt li == DFPTraitTerm _ rt ri = lt == rt && li == ri
+  DFdivTerm _ li1 li2 == DFdivTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DRecipTerm _ li == DRecipTerm _ ri = eqHashId li ri
+  DFloatingUnaryTerm _ lop li == DFloatingUnaryTerm _ rop ri = lop == rop && eqHashId li ri
+  DPowerTerm _ li1 li2 == DPowerTerm _ ri1 ri2 = eqHashId li1 ri1 && eqHashId li2 ri2
+  DFPUnaryTerm _ lop li == DFPUnaryTerm _ rop ri = lop == rop && eqHashId li ri
+  DFPBinaryTerm _ lop li1 li2 == DFPBinaryTerm _ rop ri1 ri2 = lop == rop && eqHashId li1 ri1 && eqHashId li2 ri2
+  DFPRoundingUnaryTerm _ lop lmode li == DFPRoundingUnaryTerm _ rop rmode ri =
+    lop == rop && eqHashId lmode rmode && eqHashId li ri
+  DFPRoundingBinaryTerm _ lop lmode li1 li2 == DFPRoundingBinaryTerm _ rop rmode ri1 ri2 =
+    lop == rop && eqHashId lmode rmode && eqHashId li1 ri1 && eqHashId li2 ri2
+  DFPFMATerm _ lmode li1 li2 li3 == DFPFMATerm _ rmode ri1 ri2 ri3 =
+    eqHashId lmode rmode && eqHashId li1 ri1 && eqHashId li2 ri2 && eqHashId li3 ri3
+  DFromIntegralTerm _ li == DFromIntegralTerm _ ri = li == ri
+  DFromFPOrTerm _ ld li lai == DFromFPOrTerm _ rd ri rai = eqHashId ld rd && eqHashId li ri && lai == rai
+  DToFPTerm _ li lai == DToFPTerm _ ri rai = eqHashId li ri && lai == rai
+  _ == _ = False
+
+-- {-# INLINE (==) #-}
+
+instance Hashable (Description (Term t)) where
+  hashWithSalt s = hashWithSalt s . descriptionDigest
+  {-# INLINE hashWithSalt #-}
+
+fullReconstructTerm1 ::
+  forall a b.
+  (Term a -> IO (Term b)) ->
+  Term a ->
+  IO (Term b)
+fullReconstructTerm1 f x = fullReconstructTerm x >>= f
+{-# INLINE fullReconstructTerm1 #-}
+
+fullReconstructTerm2 ::
+  forall a b c.
+  (Term a -> Term b -> IO (Term c)) ->
+  Term a ->
+  Term b ->
+  IO (Term c)
+fullReconstructTerm2 f x y = do
+  rx <- fullReconstructTerm x
+  ry <- fullReconstructTerm y
+  f rx ry
+{-# INLINE fullReconstructTerm2 #-}
+
+fullReconstructTerm3 ::
+  forall a b c d.
+  (Term a -> Term b -> Term c -> IO (Term d)) ->
+  Term a ->
+  Term b ->
+  Term c ->
+  IO (Term d)
+fullReconstructTerm3 f x y z = do
+  rx <- fullReconstructTerm x
+  ry <- fullReconstructTerm y
+  rz <- fullReconstructTerm z
+  f rx ry rz
+{-# INLINE fullReconstructTerm3 #-}
+
+fullReconstructTerm2Set ::
+  forall a c.
+  (Term a -> Term a -> HS.HashSet (Term a) -> IO (Term c)) ->
+  Term a ->
+  Term a ->
+  HS.HashSet (Term a) ->
+  IO (Term c)
+fullReconstructTerm2Set f x y s = do
+  rx@SupportedTerm <- fullReconstructTerm x
+  ry <- fullReconstructTerm y
+  rs <- traverse fullReconstructTerm (HS.toList s)
+  f rx ry (HS.fromList rs)
+{-# INLINE fullReconstructTerm2Set #-}
+
+fullReconstructTerm :: forall t. Term t -> IO (Term t)
+fullReconstructTerm (ConTerm i) = curThreadConTerm i
+fullReconstructTerm (SymTerm sym) = curThreadSymTerm sym
+fullReconstructTerm (ForallTerm sym arg) =
+  fullReconstructTerm1 (curThreadForallTerm sym) arg
+fullReconstructTerm (ExistsTerm sym arg) =
+  fullReconstructTerm1 (curThreadExistsTerm sym) arg
+fullReconstructTerm (NotTerm arg) =
+  fullReconstructTerm1 curThreadNotTerm arg
+fullReconstructTerm (OrTermAll arg1 arg2 s) =
+  fullReconstructTerm2Set curThreadOrTerm arg1 arg2 s
+fullReconstructTerm (OrTerm _ _) = error "Make compiler happy"
+fullReconstructTerm (AndTermAll arg1 arg2 s) =
+  fullReconstructTerm2Set curThreadAndTerm arg1 arg2 s
+fullReconstructTerm (AndTerm _ _) = error "Make compiler happy"
+fullReconstructTerm (EqTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadEqTerm arg1 arg2
+fullReconstructTerm (DistinctTerm args) =
+  traverse fullReconstructTerm args >>= curThreadDistinctTerm
+fullReconstructTerm (ITETerm cond arg1 arg2) =
+  fullReconstructTerm3 curThreadIteTerm cond arg1 arg2
+fullReconstructTerm (AddNumTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadAddNumTerm arg1 arg2
+fullReconstructTerm (NegNumTerm arg) =
+  fullReconstructTerm1 curThreadNegNumTerm arg
+fullReconstructTerm (MulNumTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadMulNumTerm arg1 arg2
+fullReconstructTerm (AbsNumTerm arg) =
+  fullReconstructTerm1 curThreadAbsNumTerm arg
+fullReconstructTerm (SignumNumTerm arg) =
+  fullReconstructTerm1 curThreadSignumNumTerm arg
+fullReconstructTerm (LtOrdTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadLtOrdTerm arg1 arg2
+fullReconstructTerm (LeOrdTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadLeOrdTerm arg1 arg2
+fullReconstructTerm (AndBitsTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadAndBitsTerm arg1 arg2
+fullReconstructTerm (OrBitsTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadOrBitsTerm arg1 arg2
+fullReconstructTerm (XorBitsTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadXorBitsTerm arg1 arg2
+fullReconstructTerm (ComplementBitsTerm arg) =
+  fullReconstructTerm1 curThreadComplementBitsTerm arg
+fullReconstructTerm (ShiftLeftTerm arg n) =
+  fullReconstructTerm1 (curThreadShiftLeftTerm arg) n
+fullReconstructTerm (ShiftRightTerm arg n) =
+  fullReconstructTerm1 (curThreadShiftRightTerm arg) n
+fullReconstructTerm (RotateLeftTerm arg n) =
+  fullReconstructTerm1 (curThreadRotateLeftTerm arg) n
+fullReconstructTerm (RotateRightTerm arg n) =
+  fullReconstructTerm1 (curThreadRotateRightTerm arg) n
+fullReconstructTerm (BitCastTerm v) =
+  fullReconstructTerm1 curThreadBitCastTerm v
+fullReconstructTerm (BitCastOrTerm d v) =
+  fullReconstructTerm2 curThreadBitCastOrTerm d v
+fullReconstructTerm (BVConcatTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadBVConcatTerm arg1 arg2
+fullReconstructTerm (BVSelectTerm (_ :: Proxy ix) (_ :: Proxy w) arg) =
+  fullReconstructTerm1 (curThreadBVSelectTerm (Proxy @ix) (Proxy @w)) arg
+fullReconstructTerm (BVExtendTerm signed p arg) =
+  fullReconstructTerm1 (curThreadBVExtendTerm signed p) arg
+fullReconstructTerm (ApplyTerm f arg) =
+  fullReconstructTerm2 curThreadApplyTerm f arg
+fullReconstructTerm (DivIntegralTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadDivIntegralTerm arg1 arg2
+fullReconstructTerm (ModIntegralTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadModIntegralTerm arg1 arg2
+fullReconstructTerm (QuotIntegralTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadQuotIntegralTerm arg1 arg2
+fullReconstructTerm (RemIntegralTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadRemIntegralTerm arg1 arg2
+fullReconstructTerm (FPTraitTerm trait arg) =
+  fullReconstructTerm1 (curThreadFpTraitTerm trait) arg
+fullReconstructTerm (FdivTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadFdivTerm arg1 arg2
+fullReconstructTerm (RecipTerm arg) =
+  fullReconstructTerm1 curThreadRecipTerm arg
+fullReconstructTerm (FloatingUnaryTerm op arg) =
+  fullReconstructTerm1 (curThreadFloatingUnaryTerm op) arg
+fullReconstructTerm (PowerTerm arg1 arg2) =
+  fullReconstructTerm2 curThreadPowerTerm arg1 arg2
+fullReconstructTerm (FPUnaryTerm op arg) =
+  fullReconstructTerm1 (curThreadFpUnaryTerm op) arg
+fullReconstructTerm (FPBinaryTerm op arg1 arg2) =
+  fullReconstructTerm2 (curThreadFpBinaryTerm op) arg1 arg2
+fullReconstructTerm (FPRoundingUnaryTerm op mode arg) =
+  fullReconstructTerm2 (curThreadFpRoundingUnaryTerm op) mode arg
+fullReconstructTerm (FPRoundingBinaryTerm op mode arg1 arg2) =
+  fullReconstructTerm3 (curThreadFpRoundingBinaryTerm op) mode arg1 arg2
+fullReconstructTerm (FPFMATerm mode arg1 arg2 arg3) = do
+  rmode <- fullReconstructTerm mode
+  rarg1 <- fullReconstructTerm arg1
+  rarg2 <- fullReconstructTerm arg2
+  rarg3 <- fullReconstructTerm arg3
+  curThreadFpFMATerm rmode rarg1 rarg2 rarg3
+fullReconstructTerm (FromIntegralTerm arg) =
+  fullReconstructTerm1 curThreadFromIntegralTerm arg
+fullReconstructTerm (FromFPOrTerm d r arg) =
+  fullReconstructTerm3 curThreadFromFPOrTerm d r arg
+fullReconstructTerm (ToFPTerm r arg _ _) =
+  fullReconstructTerm2 curThreadToFPTerm r arg
+
+toCurThreadImpl :: forall t. WeakThreadId -> Term t -> IO (Term t)
+toCurThreadImpl tid t | termThreadId t == tid = return t
+toCurThreadImpl _ t = fullReconstructTerm t
+{-# INLINE toCurThreadImpl #-}
+
+-- | Convert a term to the current thread.
+toCurThread :: forall t. Term t -> IO (Term t)
+toCurThread t = do
+  tid <- myWeakThreadId
+  toCurThreadImpl tid t
+{-# INLINE toCurThread #-}
+
+-- | Construct and internalizing a 'ConTerm'.
+curThreadConTerm :: forall t. (SupportedPrim t) => t -> IO (Term t)
+curThreadConTerm t = intern $ UConTerm t
+{-# INLINE curThreadConTerm #-}
+
+-- | Construct and internalizing a 'SymTerm'.
+curThreadSymTerm :: forall knd t. TypedSymbol knd t -> IO (Term t)
+curThreadSymTerm (TypedSymbol s) = intern $ USymTerm $ TypedSymbol s
+{-# INLINE curThreadSymTerm #-}
+
+-- | Construct and internalizing a 'ForallTerm'.
+curThreadForallTerm ::
+  TypedSymbol 'ConstantKind t ->
+  Term Bool ->
+  IO (Term Bool)
+curThreadForallTerm sym arg = intern $ UForallTerm sym arg
+{-# INLINE curThreadForallTerm #-}
+
+-- | Construct and internalizing a 'ExistsTerm'.
+curThreadExistsTerm ::
+  TypedSymbol 'ConstantKind t ->
+  Term Bool ->
+  IO (Term Bool)
+curThreadExistsTerm sym arg = intern $ UExistsTerm sym arg
+{-# INLINE curThreadExistsTerm #-}
+
+-- | Construct and internalizing a 'SymTerm' with an identifier, using simple
+-- symbols.
+curThreadSsymTerm :: (SupportedPrim t) => Identifier -> IO (Term t)
+curThreadSsymTerm ident =
+  curThreadSymTerm @AnyKind $ TypedSymbol $ SimpleSymbol ident
+{-# INLINE curThreadSsymTerm #-}
+
+-- | Construct and internalizing a 'SymTerm' with an identifier and an index,
+-- using indexed symbols.
+curThreadIsymTerm :: (SupportedPrim t) => Identifier -> Int -> IO (Term t)
+curThreadIsymTerm str idx =
+  curThreadSymTerm @AnyKind $ TypedSymbol $ IndexedSymbol str idx
+{-# INLINE curThreadIsymTerm #-}
+
+-- | Construct and internalizing a 'NotTerm'.
+curThreadNotTerm :: Term Bool -> IO (Term Bool)
+curThreadNotTerm = intern . UNotTerm
+{-# INLINE curThreadNotTerm #-}
+
+-- | Construct and internalizing a 'OrTerm'.
+curThreadOrTerm :: Term Bool -> Term Bool -> HS.HashSet (Term Bool) -> IO (Term Bool)
+curThreadOrTerm l r s = intern $ UOrTerm l r s
+{-# INLINE curThreadOrTerm #-}
+
+-- | Construct and internalizing a 'AndTerm'.
+curThreadAndTerm :: Term Bool -> Term Bool -> HS.HashSet (Term Bool) -> IO (Term Bool)
+curThreadAndTerm l r s = intern $ UAndTerm l r s
+{-# INLINE curThreadAndTerm #-}
+
+-- | Construct and internalizing a 'EqTerm'.
+curThreadEqTerm :: Term a -> Term a -> IO (Term Bool)
+curThreadEqTerm l r = intern $ UEqTerm l r
+{-# INLINE curThreadEqTerm #-}
+
+-- | Construct and internalizing a 'DistinctTerm'.
+curThreadDistinctTerm :: NonEmpty (Term a) -> IO (Term Bool)
+curThreadDistinctTerm args = intern $ UDistinctTerm args
+{-# INLINE curThreadDistinctTerm #-}
+
+-- | Construct and internalizing a 'ITETerm'.
+curThreadIteTerm :: Term Bool -> Term a -> Term a -> IO (Term a)
+curThreadIteTerm c l@SupportedTerm r = intern $ UITETerm c l r
+{-# INLINE curThreadIteTerm #-}
+
+-- | Construct and internalizing a 'AddNumTerm'.
+curThreadAddNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> IO (Term a)
+curThreadAddNumTerm l@SupportedTerm r = intern $ UAddNumTerm l r
+{-# INLINE curThreadAddNumTerm #-}
+
+-- | Construct and internalizing a 'NegNumTerm'.
+curThreadNegNumTerm :: (PEvalNumTerm a) => Term a -> IO (Term a)
+curThreadNegNumTerm l@SupportedTerm = intern $ UNegNumTerm l
+{-# INLINE curThreadNegNumTerm #-}
+
+-- | Construct and internalizing a 'MulNumTerm'.
+curThreadMulNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> IO (Term a)
+curThreadMulNumTerm l@SupportedTerm r = intern $ UMulNumTerm l r
+{-# INLINE curThreadMulNumTerm #-}
+
+-- | Construct and internalizing a 'AbsNumTerm'.
+curThreadAbsNumTerm :: (PEvalNumTerm a) => Term a -> IO (Term a)
+curThreadAbsNumTerm l@SupportedTerm = intern $ UAbsNumTerm l
+{-# INLINE curThreadAbsNumTerm #-}
+
+-- | Construct and internalizing a 'SignumNumTerm'.
+curThreadSignumNumTerm :: (PEvalNumTerm a) => Term a -> IO (Term a)
+curThreadSignumNumTerm l@SupportedTerm = intern $ USignumNumTerm l
+{-# INLINE curThreadSignumNumTerm #-}
+
+-- | Construct and internalizing a 'LtOrdTerm'.
+curThreadLtOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> IO (Term Bool)
+curThreadLtOrdTerm l@SupportedTerm r = intern $ ULtOrdTerm l r
+{-# INLINE curThreadLtOrdTerm #-}
+
+-- | Construct and internalizing a 'LeOrdTerm'.
+curThreadLeOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> IO (Term Bool)
+curThreadLeOrdTerm l@SupportedTerm r = intern $ ULeOrdTerm l r
+{-# INLINE curThreadLeOrdTerm #-}
+
+-- | Construct and internalizing a 'AndBitsTerm'.
+curThreadAndBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> IO (Term a)
+curThreadAndBitsTerm l@SupportedTerm r = intern $ UAndBitsTerm l r
+{-# INLINE curThreadAndBitsTerm #-}
+
+-- | Construct and internalizing a 'OrBitsTerm'.
+curThreadOrBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> IO (Term a)
+curThreadOrBitsTerm l@SupportedTerm r = intern $ UOrBitsTerm l r
+{-# INLINE curThreadOrBitsTerm #-}
+
+-- | Construct and internalizing a 'XorBitsTerm'.
+curThreadXorBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> IO (Term a)
+curThreadXorBitsTerm l@SupportedTerm r = intern $ UXorBitsTerm l r
+{-# INLINE curThreadXorBitsTerm #-}
+
+-- | Construct and internalizing a 'ComplementBitsTerm'.
+curThreadComplementBitsTerm :: (PEvalBitwiseTerm a) => Term a -> IO (Term a)
+curThreadComplementBitsTerm l@SupportedTerm = intern $ UComplementBitsTerm l
+{-# INLINE curThreadComplementBitsTerm #-}
+
+-- | Construct and internalizing a 'ShiftLeftTerm'.
+curThreadShiftLeftTerm :: (PEvalShiftTerm a) => Term a -> Term a -> IO (Term a)
+curThreadShiftLeftTerm t@SupportedTerm n = intern $ UShiftLeftTerm t n
+{-# INLINE curThreadShiftLeftTerm #-}
+
+-- | Construct and internalizing a 'ShiftRightTerm'.
+curThreadShiftRightTerm :: (PEvalShiftTerm a) => Term a -> Term a -> IO (Term a)
+curThreadShiftRightTerm t@SupportedTerm n = intern $ UShiftRightTerm t n
+{-# INLINE curThreadShiftRightTerm #-}
+
+-- | Construct and internalizing a 'RotateLeftTerm'.
+curThreadRotateLeftTerm ::
+  (PEvalRotateTerm a) => Term a -> Term a -> IO (Term a)
+curThreadRotateLeftTerm t@SupportedTerm n = intern $ URotateLeftTerm t n
+{-# INLINE curThreadRotateLeftTerm #-}
+
+-- | Construct and internalizing a 'RotateRightTerm'.
+curThreadRotateRightTerm ::
+  (PEvalRotateTerm a) => Term a -> Term a -> IO (Term a)
+curThreadRotateRightTerm t@SupportedTerm n = intern $ URotateRightTerm t n
+{-# INLINE curThreadRotateRightTerm #-}
+
+-- | Construct and internalizing a 'BitCastTerm'.
+curThreadBitCastTerm ::
+  forall a b.
+  (SupportedPrim b, PEvalBitCastTerm a b) =>
+  Term a ->
+  IO (Term b)
+curThreadBitCastTerm = intern . UBitCastTerm
+{-# INLINE curThreadBitCastTerm #-}
+
+-- | Construct and internalizing a 'BitCastOrTerm'.
+curThreadBitCastOrTerm ::
+  (PEvalBitCastOrTerm a b) =>
+  Term b ->
+  Term a ->
+  IO (Term b)
+curThreadBitCastOrTerm d@SupportedTerm a = intern $ UBitCastOrTerm d a
+{-# INLINE curThreadBitCastOrTerm #-}
+
+-- | Construct and internalizing a 'BVConcatTerm'.
+curThreadBVConcatTerm ::
+  forall bv l r.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    KnownNat (l + r),
+    1 <= l,
+    1 <= r,
+    1 <= l + r,
+    SupportedPrim (bv (l + r))
+  ) =>
+  Term (bv l) ->
+  Term (bv r) ->
+  IO (Term (bv (l + r)))
+curThreadBVConcatTerm l r = intern $ UBVConcatTerm l r
+{-# INLINE curThreadBVConcatTerm #-}
+
+-- | Construct and internalizing a 'BVSelectTerm'.
+curThreadBVSelectTerm ::
+  forall bv n ix w p q.
+  ( PEvalBVTerm bv,
+    KnownNat n,
+    KnownNat ix,
+    KnownNat w,
+    1 <= n,
+    1 <= w,
+    ix + w <= n,
+    SupportedPrim (bv w)
+  ) =>
+  p ix ->
+  q w ->
+  Term (bv n) ->
+  IO (Term (bv w))
+curThreadBVSelectTerm _ _ v = intern $ UBVSelectTerm (Proxy @ix) (Proxy @w) v
+{-# INLINE curThreadBVSelectTerm #-}
+
+-- | Construct and internalizing a 'BVExtendTerm'.
+curThreadBVExtendTerm ::
+  forall bv l r proxy.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv r)
+  ) =>
+  Bool ->
+  proxy r ->
+  Term (bv l) ->
+  IO (Term (bv r))
+curThreadBVExtendTerm signed _ v = intern $ UBVExtendTerm signed (Proxy @r) v
+{-# INLINE curThreadBVExtendTerm #-}
+
+-- | Construct and internalizing a 'BVExtendTerm' with sign extension.
+curThreadBvsignExtendTerm ::
+  forall bv l r proxy.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv r)
+  ) =>
+  proxy r ->
+  Term (bv l) ->
+  IO (Term (bv r))
+curThreadBvsignExtendTerm _ v = intern $ UBVExtendTerm True (Proxy @r) v
+{-# INLINE curThreadBvsignExtendTerm #-}
+
+-- | Construct and internalizing a 'BVExtendTerm' with zero extension.
+curThreadBvzeroExtendTerm ::
+  forall bv l r proxy.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv r)
+  ) =>
+  proxy r ->
+  Term (bv l) ->
+  IO (Term (bv r))
+curThreadBvzeroExtendTerm _ v = intern $ UBVExtendTerm False (Proxy @r) v
+{-# INLINE curThreadBvzeroExtendTerm #-}
+
+-- | Construct and internalizing a 'ApplyTerm'.
+curThreadApplyTerm ::
+  forall f a b.
+  (PEvalApplyTerm f a b, SupportedPrim b) =>
+  Term f ->
+  Term a ->
+  IO (Term b)
+curThreadApplyTerm f a = intern $ UApplyTerm f a
+{-# INLINE curThreadApplyTerm #-}
+
+-- | Construct and internalizing a 'DivIntegralTerm'.
+curThreadDivIntegralTerm ::
+  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
+curThreadDivIntegralTerm l@SupportedTerm r = intern $ UDivIntegralTerm l r
+{-# INLINE curThreadDivIntegralTerm #-}
+
+-- | Construct and internalizing a 'ModIntegralTerm'.
+curThreadModIntegralTerm ::
+  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
+curThreadModIntegralTerm l@SupportedTerm r = intern $ UModIntegralTerm l r
+{-# INLINE curThreadModIntegralTerm #-}
+
+-- | Construct and internalizing a 'QuotIntegralTerm'.
+curThreadQuotIntegralTerm ::
+  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
+curThreadQuotIntegralTerm l@SupportedTerm r = intern $ UQuotIntegralTerm l r
+{-# INLINE curThreadQuotIntegralTerm #-}
+
+-- | Construct and internalizing a 'RemIntegralTerm'.
+curThreadRemIntegralTerm ::
+  (PEvalDivModIntegralTerm a) => Term a -> Term a -> IO (Term a)
+curThreadRemIntegralTerm l@SupportedTerm r = intern $ URemIntegralTerm l r
+{-# INLINE curThreadRemIntegralTerm #-}
+
+-- | Construct and internalizing a 'FPTraitTerm'.
+curThreadFpTraitTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPTrait ->
+  Term (fp eb sb) ->
+  IO (Term Bool)
+curThreadFpTraitTerm trait v = intern $ UFPTraitTerm trait v
+{-# INLINE curThreadFpTraitTerm #-}
+
+-- | Construct and internalizing a 'FdivTerm'.
+curThreadFdivTerm :: (PEvalFractionalTerm a) => Term a -> Term a -> IO (Term a)
+curThreadFdivTerm l@SupportedTerm r = intern $ UFdivTerm l r
+{-# INLINE curThreadFdivTerm #-}
+
+-- | Construct and internalizing a 'RecipTerm'.
+curThreadRecipTerm :: (PEvalFractionalTerm a) => Term a -> IO (Term a)
+curThreadRecipTerm l@SupportedTerm = intern $ URecipTerm l
+{-# INLINE curThreadRecipTerm #-}
+
+-- | Construct and internalizing a 'FloatingUnaryTerm'.
+curThreadFloatingUnaryTerm ::
+  (PEvalFloatingTerm a) => FloatingUnaryOp -> Term a -> IO (Term a)
+curThreadFloatingUnaryTerm op a@SupportedTerm = intern $ UFloatingUnaryTerm op a
+{-# INLINE curThreadFloatingUnaryTerm #-}
+
+-- | Construct and internalizing a 'PowerTerm'.
+curThreadPowerTerm :: (PEvalFloatingTerm a) => Term a -> Term a -> IO (Term a)
+curThreadPowerTerm l@SupportedTerm r = intern $ UPowerTerm l r
+{-# INLINE curThreadPowerTerm #-}
+
+-- | Construct and internalizing a 'FPUnaryTerm'.
+curThreadFpUnaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPUnaryOp ->
+  Term (fp eb sb) ->
+  IO (Term (fp eb sb))
+curThreadFpUnaryTerm op v = intern $ UFPUnaryTerm op v
+{-# INLINE curThreadFpUnaryTerm #-}
+
+-- | Construct and internalizing a 'FPBinaryTerm'.
+curThreadFpBinaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPBinaryOp ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  IO (Term (fp eb sb))
+curThreadFpBinaryTerm op l r = intern $ UFPBinaryTerm op l r
+{-# INLINE curThreadFpBinaryTerm #-}
+
+-- | Construct and internalizing a 'FPRoundingUnaryTerm'.
+curThreadFpRoundingUnaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPRoundingUnaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  IO (Term (fp eb sb))
+curThreadFpRoundingUnaryTerm op mode v = intern $ UFPRoundingUnaryTerm op mode v
+{-# INLINE curThreadFpRoundingUnaryTerm #-}
+
+-- | Construct and internalizing a 'FPRoundingBinaryTerm'.
+curThreadFpRoundingBinaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPRoundingBinaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  IO (Term (fp eb sb))
+curThreadFpRoundingBinaryTerm op mode l r =
+  intern $ UFPRoundingBinaryTerm op mode l r
+{-# INLINE curThreadFpRoundingBinaryTerm #-}
+
+-- | Construct and internalizing a 'FPFMATerm'.
+curThreadFpFMATerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  IO (Term (fp eb sb))
+curThreadFpFMATerm mode l r s = intern $ UFPFMATerm mode l r s
+{-# INLINE curThreadFpFMATerm #-}
+
+-- | Construct and internalizing a 'FromIntegralTerm'.
+curThreadFromIntegralTerm ::
+  forall a b.
+  (PEvalFromIntegralTerm a b, SupportedPrim b) =>
+  Term a ->
+  IO (Term b)
+curThreadFromIntegralTerm = intern . UFromIntegralTerm
+{-# INLINE curThreadFromIntegralTerm #-}
+
+-- | Construct and internalizing a 'FromFPOrTerm'.
+curThreadFromFPOrTerm ::
+  forall a eb sb.
+  ( PEvalIEEEFPConvertibleTerm a,
+    ValidFP eb sb
+  ) =>
+  Term a ->
+  Term FPRoundingMode ->
+  Term (FP eb sb) ->
+  IO (Term a)
+curThreadFromFPOrTerm d@SupportedTerm r f = intern $ UFromFPOrTerm d r f
+{-# INLINE curThreadFromFPOrTerm #-}
+
+-- | Construct and internalizing a 'ToFPTerm'.
+curThreadToFPTerm ::
+  forall a eb sb.
+  ( PEvalIEEEFPConvertibleTerm a,
+    ValidFP eb sb,
+    SupportedPrim (FP eb sb)
+  ) =>
+  Term FPRoundingMode ->
+  Term a ->
+  IO (Term (FP eb sb))
+curThreadToFPTerm r f = intern $ UToFPTerm r f (Proxy @eb) (Proxy @sb)
+{-# INLINE curThreadToFPTerm #-}
+
+inCurThread1 ::
+  forall a b.
+  (Term a -> IO (Term b)) ->
+  Term a ->
+  IO (Term b)
+inCurThread1 f t = do
+  tid <- myWeakThreadId
+  toCurThreadImpl tid t >>= f
+{-# INLINE inCurThread1 #-}
+
+inCurThread2 ::
+  forall a b c.
+  (Term a -> Term b -> IO (Term c)) ->
+  Term a ->
+  Term b ->
+  IO (Term c)
+inCurThread2 f a b = do
+  tid <- myWeakThreadId
+  ra <- toCurThreadImpl tid a
+  rb <- toCurThreadImpl tid b
+  f ra rb
+{-# INLINE inCurThread2 #-}
+
+inCurThread3 ::
+  forall a b c d.
+  (Term a -> Term b -> Term c -> IO (Term d)) ->
+  Term a ->
+  Term b ->
+  Term c ->
+  IO (Term d)
+inCurThread3 f a b c = do
+  tid <- myWeakThreadId
+  ra <- toCurThreadImpl tid a
+  rb <- toCurThreadImpl tid b
+  rc <- toCurThreadImpl tid c
+  f ra rb rc
+{-# INLINE inCurThread3 #-}
+
+unsafeInCurThread1 ::
+  forall a b.
+  (Term a -> IO (Term b)) ->
+  Term a ->
+  Term b
+unsafeInCurThread1 f = unsafePerformIO . inCurThread1 f
+{-# NOINLINE unsafeInCurThread1 #-}
+
+unsafeInCurThread2 ::
+  forall a b c.
+  (Term a -> Term b -> IO (Term c)) ->
+  Term a ->
+  Term b ->
+  Term c
+unsafeInCurThread2 f a b = unsafePerformIO $ inCurThread2 f a b
+{-# NOINLINE unsafeInCurThread2 #-}
+
+unsafeInCurThread3 ::
+  forall a b c d.
+  (Term a -> Term b -> Term c -> IO (Term d)) ->
+  Term a ->
+  Term b ->
+  Term c ->
+  Term d
+unsafeInCurThread3 f a b c = unsafePerformIO $ inCurThread3 f a b c
+{-# NOINLINE unsafeInCurThread3 #-}
+
+-- | Construct and internalizing a 'ConTerm'.
+conTerm :: (SupportedPrim t) => t -> Term t
+conTerm = unsafePerformIO . curThreadConTerm
+{-# NOINLINE conTerm #-}
+
+-- | Construct and internalizing a 'SymTerm'.
+symTerm :: TypedSymbol knd t -> Term t
+symTerm = unsafePerformIO . curThreadSymTerm
+{-# NOINLINE symTerm #-}
+
+-- | Construct and internalizing a 'ForallTerm'.
+forallTerm ::
+  TypedSymbol 'ConstantKind t ->
+  Term Bool ->
+  Term Bool
+forallTerm sym@TypedSymbol {} = unsafeInCurThread1 (curThreadForallTerm sym)
+{-# NOINLINE forallTerm #-}
+
+-- | Construct and internalizing a 'ExistsTerm'.
+existsTerm ::
+  TypedSymbol 'ConstantKind t ->
+  Term Bool ->
+  Term Bool
+existsTerm sym@TypedSymbol {} = unsafeInCurThread1 (curThreadExistsTerm sym)
+{-# NOINLINE existsTerm #-}
+
+-- | Construct and internalizing a 'SymTerm' with an identifier, using simple
+-- symbols.
+ssymTerm :: (SupportedPrim t) => Identifier -> Term t
+ssymTerm = unsafePerformIO . curThreadSsymTerm
+{-# NOINLINE ssymTerm #-}
+
+-- | Construct and internalizing a 'SymTerm' with an identifier and an index,
+-- using indexed symbols.
+isymTerm :: (SupportedPrim t) => Identifier -> Int -> Term t
+isymTerm ident index = unsafePerformIO $ curThreadIsymTerm ident index
+{-# NOINLINE isymTerm #-}
+
+-- | Construct and internalizing a 'NotTerm'.
+notTerm :: Term Bool -> Term Bool
+notTerm = unsafeInCurThread1 curThreadNotTerm
+{-# NOINLINE notTerm #-}
+
+inCurThread2Set ::
+  forall a c.
+  (Term a -> Term a -> HS.HashSet (Term a) -> IO (Term c)) ->
+  Term a ->
+  Term a ->
+  HS.HashSet (Term a) ->
+  IO (Term c)
+inCurThread2Set f a b s = do
+  tid <- myWeakThreadId
+  ra@SupportedTerm <- toCurThreadImpl tid a
+  rb <- toCurThreadImpl tid b
+  rs <- traverse (toCurThreadImpl tid) (HS.toList s)
+  f ra rb (HS.fromList rs)
+{-# INLINE inCurThread2Set #-}
+
+unsafeInCurThread2Set ::
+  forall a c.
+  (Term a -> Term a -> HS.HashSet (Term a) -> IO (Term c)) ->
+  Term a ->
+  Term a ->
+  HS.HashSet (Term a) ->
+  Term c
+unsafeInCurThread2Set f a b s = unsafePerformIO $ inCurThread2Set f a b s
+{-# NOINLINE unsafeInCurThread2Set #-}
+
+-- | Construct and internalizing a 'OrTerm'.
+orTerm :: Term Bool -> Term Bool -> Term Bool
+orTerm l@(OrTermAll _ _ s1) r@(OrTermAll _ _ s2) =
+  unsafeInCurThread2Set
+    curThreadOrTerm
+    l
+    r
+    ( if HS.size s1 + HS.size s2 > 30
+        then HS.fromList [l, r]
+        else HS.insert l $ HS.insert r $ HS.union s1 s2
+    )
+orTerm l@(OrTermAll _ _ s1) r =
+  unsafeInCurThread2Set
+    curThreadOrTerm
+    l
+    r
+    ( if HS.size s1 > 30
+        then HS.fromList [l, r]
+        else HS.insert r $ HS.insert l s1
+    )
+orTerm l r@(OrTermAll _ _ s2) =
+  unsafeInCurThread2Set
+    curThreadOrTerm
+    l
+    r
+    ( if HS.size s2 > 30
+        then HS.fromList [l, r]
+        else HS.insert l $ HS.insert r s2
+    )
+orTerm l r = unsafeInCurThread2Set curThreadOrTerm l r (HS.fromList [l, r])
+{-# NOINLINE orTerm #-}
+
+-- | Construct and internalizing a 'AndTerm'.
+andTerm :: Term Bool -> Term Bool -> Term Bool
+andTerm l@(AndTermAll _ _ s1) r@(AndTermAll _ _ s2) =
+  unsafeInCurThread2Set
+    curThreadAndTerm
+    l
+    r
+    ( if HS.size s1 + HS.size s2 > 30
+        then HS.fromList [l, r]
+        else HS.insert l $ HS.insert r $ HS.union s1 s2
+    )
+andTerm l@(AndTermAll _ _ s1) r =
+  unsafeInCurThread2Set
+    curThreadAndTerm
+    l
+    r
+    ( if HS.size s1 > 30
+        then HS.fromList [l, r]
+        else HS.insert r $ HS.insert l s1
+    )
+andTerm l r@(AndTermAll _ _ s2) =
+  unsafeInCurThread2Set
+    curThreadAndTerm
+    l
+    r
+    ( if HS.size s2 > 30
+        then HS.fromList [l, r]
+        else HS.insert l $ HS.insert r s2
+    )
+andTerm l r = unsafeInCurThread2Set curThreadAndTerm l r (HS.fromList [l, r])
+{-# NOINLINE andTerm #-}
+
+-- | Construct and internalizing a 'EqTerm'.
+eqTerm :: Term a -> Term a -> Term Bool
+eqTerm = unsafeInCurThread2 curThreadEqTerm
+{-# NOINLINE eqTerm #-}
+
+-- | Construct and internalizing a 'DistinctTerm'.
+distinctTerm :: NonEmpty (Term a) -> Term Bool
+distinctTerm args =
+  unsafePerformIO $ do
+    tid <- myWeakThreadId
+    traverse (toCurThreadImpl tid) args >>= curThreadDistinctTerm
+{-# NOINLINE distinctTerm #-}
+
+-- | Construct and internalizing a 'ITETerm'.
+iteTerm :: Term Bool -> Term a -> Term a -> Term a
+iteTerm = unsafeInCurThread3 curThreadIteTerm
+{-# NOINLINE iteTerm #-}
+
+-- | Construct and internalizing a 'AddNumTerm'.
+addNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> Term a
+addNumTerm = unsafeInCurThread2 curThreadAddNumTerm
+{-# NOINLINE addNumTerm #-}
+
+-- | Construct and internalizing a 'NegNumTerm'.
+negNumTerm :: (PEvalNumTerm a) => Term a -> Term a
+negNumTerm = unsafeInCurThread1 curThreadNegNumTerm
+{-# NOINLINE negNumTerm #-}
+
+-- | Construct and internalizing a 'MulNumTerm'.
+mulNumTerm :: (PEvalNumTerm a) => Term a -> Term a -> Term a
+mulNumTerm = unsafeInCurThread2 curThreadMulNumTerm
+{-# NOINLINE mulNumTerm #-}
+
+-- | Construct and internalizing a 'AbsNumTerm'.
+absNumTerm :: (PEvalNumTerm a) => Term a -> Term a
+absNumTerm = unsafeInCurThread1 curThreadAbsNumTerm
+{-# NOINLINE absNumTerm #-}
+
+-- | Construct and internalizing a 'SignumNumTerm'.
+signumNumTerm :: (PEvalNumTerm a) => Term a -> Term a
+signumNumTerm = unsafeInCurThread1 curThreadSignumNumTerm
+{-# NOINLINE signumNumTerm #-}
+
+-- | Construct and internalizing a 'LtOrdTerm'.
+ltOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
+ltOrdTerm = unsafeInCurThread2 curThreadLtOrdTerm
+{-# NOINLINE ltOrdTerm #-}
+
+-- | Construct and internalizing a 'LeOrdTerm'.
+leOrdTerm :: (PEvalOrdTerm a) => Term a -> Term a -> Term Bool
+leOrdTerm = unsafeInCurThread2 curThreadLeOrdTerm
+{-# NOINLINE leOrdTerm #-}
+
+-- | Construct and internalizing a 'AndBitsTerm'.
+andBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> Term a
+andBitsTerm a b =
+  unsafeInCurThread2 curThreadAndBitsTerm a b
+{-# NOINLINE andBitsTerm #-}
+
+-- | Construct and internalizing a 'OrBitsTerm'.
+orBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> Term a
+orBitsTerm = unsafeInCurThread2 curThreadOrBitsTerm
+{-# NOINLINE orBitsTerm #-}
+
+-- | Construct and internalizing a 'XorBitsTerm'.
+xorBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a -> Term a
+xorBitsTerm = unsafeInCurThread2 curThreadXorBitsTerm
+{-# NOINLINE xorBitsTerm #-}
+
+-- | Construct and internalizing a 'ComplementBitsTerm'.
+complementBitsTerm :: (PEvalBitwiseTerm a) => Term a -> Term a
+complementBitsTerm = unsafeInCurThread1 curThreadComplementBitsTerm
+{-# NOINLINE complementBitsTerm #-}
+
+-- | Construct and internalizing a 'ShiftLeftTerm'.
+shiftLeftTerm :: (PEvalShiftTerm a) => Term a -> Term a -> Term a
+shiftLeftTerm = unsafeInCurThread2 curThreadShiftLeftTerm
+{-# NOINLINE shiftLeftTerm #-}
+
+-- | Construct and internalizing a 'ShiftRightTerm'.
+shiftRightTerm :: (PEvalShiftTerm a) => Term a -> Term a -> Term a
+shiftRightTerm = unsafeInCurThread2 curThreadShiftRightTerm
+{-# NOINLINE shiftRightTerm #-}
+
+-- | Construct and internalizing a 'RotateLeftTerm'.
+rotateLeftTerm :: (PEvalRotateTerm a) => Term a -> Term a -> Term a
+rotateLeftTerm = unsafeInCurThread2 curThreadRotateLeftTerm
+{-# NOINLINE rotateLeftTerm #-}
+
+-- | Construct and internalizing a 'RotateRightTerm'.
+rotateRightTerm :: (PEvalRotateTerm a) => Term a -> Term a -> Term a
+rotateRightTerm = unsafeInCurThread2 curThreadRotateRightTerm
+{-# NOINLINE rotateRightTerm #-}
+
+-- | Construct and internalizing a 'BitCastTerm'.
+bitCastTerm ::
+  (PEvalBitCastTerm a b, SupportedPrim b) =>
+  Term a ->
+  Term b
+bitCastTerm = unsafeInCurThread1 curThreadBitCastTerm
+{-# NOINLINE bitCastTerm #-}
+
+-- | Construct and internalizing a 'BitCastOrTerm'.
+bitCastOrTerm ::
+  (PEvalBitCastOrTerm a b) =>
+  Term b ->
+  Term a ->
+  Term b
+bitCastOrTerm = unsafeInCurThread2 curThreadBitCastOrTerm
+{-# NOINLINE bitCastOrTerm #-}
+
+-- | Construct and internalizing a 'BVConcatTerm'.
+bvConcatTerm ::
+  forall bv l r.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    KnownNat (l + r),
+    1 <= l,
+    1 <= r,
+    1 <= l + r,
+    SupportedPrim (bv (l + r))
+  ) =>
+  Term (bv l) ->
+  Term (bv r) ->
+  Term (bv (l + r))
+bvConcatTerm = unsafeInCurThread2 curThreadBVConcatTerm
+{-# NOINLINE bvConcatTerm #-}
+
+-- | Construct and internalizing a 'BVSelectTerm'.
+bvSelectTerm ::
+  forall bv n ix w p q.
+  ( PEvalBVTerm bv,
+    KnownNat n,
+    KnownNat ix,
+    KnownNat w,
+    1 <= n,
+    1 <= w,
+    ix + w <= n,
+    SupportedPrim (bv w)
+  ) =>
+  p ix ->
+  q w ->
+  Term (bv n) ->
+  Term (bv w)
+bvSelectTerm ix w = unsafeInCurThread1 (curThreadBVSelectTerm ix w)
+{-# NOINLINE bvSelectTerm #-}
+
+-- | Construct and internalizing a 'BVExtendTerm'.
+bvExtendTerm ::
+  forall bv l r proxy.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv r)
+  ) =>
+  Bool ->
+  proxy r ->
+  Term (bv l) ->
+  Term (bv r)
+bvExtendTerm signed r = unsafeInCurThread1 (curThreadBVExtendTerm signed r)
+{-# NOINLINE bvExtendTerm #-}
+
+-- | Construct and internalizing a 'BVExtendTerm' with sign extension.
+bvsignExtendTerm ::
+  forall bv l r proxy.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv r)
+  ) =>
+  proxy r ->
+  Term (bv l) ->
+  Term (bv r)
+bvsignExtendTerm r = unsafeInCurThread1 (curThreadBvsignExtendTerm r)
+{-# NOINLINE bvsignExtendTerm #-}
+
+-- | Construct and internalizing a 'BVExtendTerm' with zero extension.
+bvzeroExtendTerm ::
+  forall bv l r proxy.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    SupportedPrim (bv r)
+  ) =>
+  proxy r ->
+  Term (bv l) ->
+  Term (bv r)
+bvzeroExtendTerm r = unsafeInCurThread1 (curThreadBvzeroExtendTerm r)
+{-# NOINLINE bvzeroExtendTerm #-}
+
+-- | Construct and internalizing a 'ApplyTerm'.
+applyTerm ::
+  (PEvalApplyTerm f a b, SupportedPrim b) => Term f -> Term a -> Term b
+applyTerm = unsafeInCurThread2 curThreadApplyTerm
+{-# NOINLINE applyTerm #-}
+
+-- | Construct and internalizing a 'DivIntegralTerm'.
+divIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
+divIntegralTerm = unsafeInCurThread2 curThreadDivIntegralTerm
+{-# NOINLINE divIntegralTerm #-}
+
+-- | Construct and internalizing a 'ModIntegralTerm'.
+modIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
+modIntegralTerm = unsafeInCurThread2 curThreadModIntegralTerm
+{-# NOINLINE modIntegralTerm #-}
+
+-- | Construct and internalizing a 'QuotIntegralTerm'.
+quotIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
+quotIntegralTerm = unsafeInCurThread2 curThreadQuotIntegralTerm
+{-# NOINLINE quotIntegralTerm #-}
+
+-- | Construct and internalizing a 'RemIntegralTerm'.
+remIntegralTerm :: (PEvalDivModIntegralTerm a) => Term a -> Term a -> Term a
+remIntegralTerm = unsafeInCurThread2 curThreadRemIntegralTerm
+{-# NOINLINE remIntegralTerm #-}
+
+-- | Construct and internalizing a 'FPTraitTerm'.
+fpTraitTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPTrait ->
+  Term (fp eb sb) ->
+  Term Bool
+fpTraitTerm trait = unsafeInCurThread1 (curThreadFpTraitTerm trait)
+{-# NOINLINE fpTraitTerm #-}
+
+-- | Construct and internalizing a 'FdivTerm'.
+fdivTerm :: (PEvalFractionalTerm a) => Term a -> Term a -> Term a
+fdivTerm = unsafeInCurThread2 curThreadFdivTerm
+{-# NOINLINE fdivTerm #-}
+
+-- | Construct and internalizing a 'RecipTerm'.
+recipTerm :: (PEvalFractionalTerm a) => Term a -> Term a
+recipTerm = unsafeInCurThread1 curThreadRecipTerm
+{-# NOINLINE recipTerm #-}
+
+-- | Construct and internalizing a 'FloatingUnaryTerm'.
+floatingUnaryTerm :: (PEvalFloatingTerm a) => FloatingUnaryOp -> Term a -> Term a
+floatingUnaryTerm op = unsafeInCurThread1 (curThreadFloatingUnaryTerm op)
+{-# NOINLINE floatingUnaryTerm #-}
+
+-- | Construct and internalizing a 'PowerTerm'.
+powerTerm :: (PEvalFloatingTerm a) => Term a -> Term a -> Term a
+powerTerm = unsafeInCurThread2 curThreadPowerTerm
+{-# NOINLINE powerTerm #-}
+
+-- | Construct and internalizing a 'FPUnaryTerm'.
+fpUnaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPUnaryOp ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+fpUnaryTerm op = unsafeInCurThread1 (curThreadFpUnaryTerm op)
+{-# NOINLINE fpUnaryTerm #-}
+
+-- | Construct and internalizing a 'FPBinaryTerm'.
+fpBinaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPBinaryOp ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+fpBinaryTerm op = unsafeInCurThread2 (curThreadFpBinaryTerm op)
+{-# NOINLINE fpBinaryTerm #-}
+
+-- | Construct and internalizing a 'FPRoundingUnaryTerm'.
+fpRoundingUnaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPRoundingUnaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+fpRoundingUnaryTerm op = unsafeInCurThread2 (curThreadFpRoundingUnaryTerm op)
+{-# NOINLINE fpRoundingUnaryTerm #-}
+
+-- | Construct and internalizing a 'FPRoundingBinaryTerm'.
+fpRoundingBinaryTerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  FPRoundingBinaryOp ->
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+fpRoundingBinaryTerm op = unsafeInCurThread3 (curThreadFpRoundingBinaryTerm op)
+{-# NOINLINE fpRoundingBinaryTerm #-}
+
+-- | Construct and internalizing a 'FPFMATerm'.
+fpFMATerm ::
+  (ValidFP eb sb, SupportedPrim (fp eb sb), PEvalFPTerm fp) =>
+  Term FPRoundingMode ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb) ->
+  Term (fp eb sb)
+fpFMATerm mode a b c = unsafePerformIO $ do
+  tid <- myWeakThreadId
+  mode' <- toCurThreadImpl tid mode
+  a' <- toCurThreadImpl tid a
+  b' <- toCurThreadImpl tid b
+  c' <- toCurThreadImpl tid c
+  curThreadFpFMATerm mode' a' b' c'
+{-# NOINLINE fpFMATerm #-}
+
+-- | Construct and internalizing a 'FromIntegralTerm'.
+fromIntegralTerm ::
+  (PEvalFromIntegralTerm a b, SupportedPrim b) => Term a -> Term b
+fromIntegralTerm = unsafeInCurThread1 curThreadFromIntegralTerm
+{-# NOINLINE fromIntegralTerm #-}
+
+-- | Construct and internalizing a 'FromFPOrTerm'.
+fromFPOrTerm ::
+  ( PEvalIEEEFPConvertibleTerm a,
+    ValidFP eb sb
+  ) =>
+  Term a ->
+  Term FPRoundingMode ->
+  Term (FP eb sb) ->
+  Term a
+fromFPOrTerm = unsafeInCurThread3 curThreadFromFPOrTerm
+{-# NOINLINE fromFPOrTerm #-}
+
+-- | Construct and internalizing a 'ToFPTerm'.
+toFPTerm ::
+  forall a eb sb.
+  ( PEvalIEEEFPConvertibleTerm a,
+    ValidFP eb sb,
+    SupportedPrim (FP eb sb)
+  ) =>
+  Term FPRoundingMode ->
+  Term a ->
+  Term (FP eb sb)
+toFPTerm = unsafeInCurThread2 curThreadToFPTerm
+{-# NOINLINE toFPTerm #-}
+
+-- Support for boolean type
+defaultValueForBool :: Bool
+defaultValueForBool = False
+
+-- | Construct and internalizing 'True' term.
+trueTerm :: Term Bool
+trueTerm = conTerm True
+{-# NOINLINE trueTerm #-}
+
+-- | Construct and internalizing 'False' term.
+falseTerm :: Term Bool
+falseTerm = conTerm False
+{-# NOINLINE falseTerm #-}
+
+boolConTermView :: forall a. Term a -> Maybe Bool
+boolConTermView (ConTerm b) = cast b
+boolConTermView _ = Nothing
+{-# INLINE boolConTermView #-}
+
+-- | Pattern matcher for concrete 'Bool' terms.
+pattern BoolConTerm :: Bool -> Term a
+pattern BoolConTerm b <- (boolConTermView -> Just b)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BoolConTerm #-}
+#endif
+
+-- | Pattern matcher for 'True' term.
+pattern TrueTerm :: Term a
+pattern TrueTerm <- BoolConTerm True
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE TrueTerm #-}
+#endif
+
+-- | Pattern matcher for 'False' term.
+pattern FalseTerm :: Term a
+pattern FalseTerm <- BoolConTerm False
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE FalseTerm #-}
+#endif
+
+boolTermView :: forall a. Term a -> Maybe (Term Bool)
+boolTermView t@SupportedTerm = cast t
+{-# INLINE boolTermView #-}
+
+-- | Pattern matcher for 'Bool' terms.
+pattern BoolTerm :: Term Bool -> Term a
+pattern BoolTerm b <- (boolTermView -> Just b)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# INLINE BoolTerm #-}
+#endif
+
+-- | Partial evaluation for not terms.
+pevalNotTerm :: Term Bool -> Term Bool
+pevalNotTerm (NotTerm tm) = tm
+pevalNotTerm (ConTerm a) = if a then falseTerm else trueTerm
+pevalNotTerm (OrTerm (NotTerm n1) n2) = pevalAndTerm n1 (pevalNotTerm n2)
+pevalNotTerm (OrTerm (DistinctTerm (n1 :| [n2])) n3) =
+  pevalAndTerm (pevalEqTerm n1 n2) (pevalNotTerm n3)
+pevalNotTerm (OrTerm n1 (NotTerm n2)) = pevalAndTerm (pevalNotTerm n1) n2
+pevalNotTerm (OrTerm n1 (DistinctTerm (n2 :| [n3]))) =
+  pevalAndTerm (pevalNotTerm n1) (pevalEqTerm n2 n3)
+pevalNotTerm (AndTerm (NotTerm n1) n2) = pevalOrTerm n1 (pevalNotTerm n2)
+pevalNotTerm (AndTerm (DistinctTerm (n1 :| [n2])) n3) =
+  pevalOrTerm (pevalEqTerm n1 n2) (pevalNotTerm n3)
+pevalNotTerm (AndTerm n1 (NotTerm n2)) = pevalOrTerm (pevalNotTerm n1) n2
+pevalNotTerm (AndTerm n1 (DistinctTerm (n2 :| [n3]))) =
+  pevalOrTerm (pevalNotTerm n1) (pevalEqTerm n2 n3)
+pevalNotTerm
+  (EqTerm a (DynTerm (ConTerm b :: Term (WordN 1))))
+    | b == 0 = eqTerm (unsafeCoerce a) (conTerm 1 :: Term (WordN 1))
+    | b == 1 = eqTerm (unsafeCoerce a) (conTerm 0 :: Term (WordN 1))
+pevalNotTerm
+  (EqTerm a (DynTerm (ConTerm b :: Term (IntN 1))))
+    | b == 0 = eqTerm (unsafeCoerce a) (conTerm 1 :: Term (IntN 1))
+    | b == 1 = eqTerm (unsafeCoerce a) (conTerm 0 :: Term (IntN 1))
+-- pevalNotTerm (EqTerm a b) = distinctTerm $ a :| [b]
+pevalNotTerm (DistinctTerm (a :| [b])) = eqTerm a b
+pevalNotTerm tm = notTerm tm
+{-# INLINEABLE pevalNotTerm #-}
+
+orEqFirst' :: Term Bool -> Term Bool -> Bool
+orEqFirst'
+  (DistinctTerm ((e1 :: Term a) :| [ec1@ConTerm {} :: Term b]))
+  (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
+    | e1 == e2 && ec1 /= ec2 = True
+orEqFirst'
+  (NotTerm (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b)))
+  (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
+    | e1 == e2 && ec1 /= ec2 = True
+orEqFirst' _ _ = False
+{-# INLINE orEqFirst' #-}
+
+orEqFirst :: Term Bool -> Term Bool -> Bool
+orEqFirst _ (ConTerm False) = True
+orEqFirst x y
+  | x == y = True
+  | otherwise = orEqFirst' x y
+{-# INLINE orEqFirst #-}
+
+orEqTrue' :: Term Bool -> Term Bool -> Bool
+orEqTrue'
+  (DistinctTerm ((e1 :: Term a) :| [ec1@ConTerm {} :: Term b]))
+  (DistinctTerm ((DynTerm (e2 :: Term a)) :| [DynTerm (ec2@ConTerm {} :: Term b)]))
+    | e1 == e2 && ec1 /= ec2 = True
+orEqTrue'
+  (NotTerm (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b)))
+  (NotTerm (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b))))
+    | e1 == e2 && ec1 /= ec2 = True
+orEqTrue' _ _ = False
+{-# INLINE orEqTrue' #-}
+
+orEqTrue :: Term Bool -> Term Bool -> Bool
+orEqTrue (ConTerm True) ~_ = True
+orEqTrue _ (ConTerm True) = True
+orEqTrue (NotTerm l) r | l == r = True
+orEqTrue l (NotTerm r) | l == r = True
+orEqTrue l r = orEqTrue' l r
+{-# INLINE orEqTrue #-}
+
+-- | Partial evaluation for or terms.
+pevalOrTerm :: Term Bool -> Term Bool -> Term Bool
+pevalOrTerm (ConTerm True) ~_ = trueTerm
+pevalOrTerm _ (ConTerm True) = trueTerm
+pevalOrTerm (ConTerm False) y = y
+pevalOrTerm x (ConTerm False) = x
+pevalOrTerm (NotTerm x) y | x == y = trueTerm
+pevalOrTerm x (NotTerm y) | x == y = trueTerm
+pevalOrTerm x y | x == y = x
+pevalOrTerm l ~r
+  | orEqTrue' l r = trueTerm
+  | orEqFirst' l r = l
+  | orEqFirst' r l = r
+pevalOrTerm l r@(OrTermAll r1 r2 s)
+  | HS.member l s = r
+  | HS.member (simpleNot l) s = trueTerm
+  | orEqTrue' l r1 = trueTerm
+  | orEqTrue' l r2 = trueTerm
+  | orEqFirst' r1 l = r
+  | orEqFirst' r2 l = r
+  | orEqFirst' l r1 = pevalOrTerm l r2
+  | orEqFirst' l r2 = pevalOrTerm l r1
+pevalOrTerm l@(OrTermAll l1 l2 s) r
+  | HS.member r s = l
+  | HS.member (simpleNot r) s = trueTerm
+  | orEqTrue' l1 r = trueTerm
+  | orEqTrue' l2 r = trueTerm
+  | orEqFirst' l1 r = l
+  | orEqFirst' l2 r = l
+  | orEqFirst' r l1 = pevalOrTerm l2 r
+  | orEqFirst' r l2 = pevalOrTerm l1 r
+pevalOrTerm (AndTerm l1 l2) (AndTerm r1 r2)
+  | l1 == r1 = pevalAndTerm l1 (pevalOrTerm l2 r2)
+  | l1 == r2 = pevalAndTerm l1 (pevalOrTerm l2 r1)
+  | l2 == r1 = pevalAndTerm l2 (pevalOrTerm l1 r2)
+  | l2 == r2 = pevalAndTerm l2 (pevalOrTerm l1 r1)
+pevalOrTerm l (AndTermAll r1 r2 s)
+  | HS.member l s = l
+  | orEqFirst l r1 = l
+  | orEqFirst l r2 = l
+  | orEqTrue l r1 = pevalOrTerm l r2
+  | orEqTrue l r2 = pevalOrTerm l r1
+pevalOrTerm (AndTermAll l1 l2 s) r
+  | HS.member r s = r
+  | orEqFirst r l1 = r
+  | orEqFirst r l2 = r
+  | orEqTrue l1 r = pevalOrTerm l2 r
+  | orEqTrue l2 r = pevalOrTerm l1 r
+pevalOrTerm
+  (AndTerm nl1@(NotTerm l1) l2)
+  (EqTerm (DynTerm (e1 :: Term Bool)) (DynTerm (e2 :: Term Bool)))
+    | l1 == e1 && l2 == e2 = pevalOrTerm nl1 l2
+pevalOrTerm (NotTerm nl) (NotTerm nr) =
+  pevalNotTerm $ pevalAndTerm nl nr
+pevalOrTerm (AndTermAll _ _ sa) r@(OrTermAll _ _ so)
+  | sa `HS.intersection` so /= HS.empty = r
+pevalOrTerm l@(OrTermAll _ _ so) (AndTermAll _ _ sa)
+  | sa `HS.intersection` so /= HS.empty = l
+pevalOrTerm
+  (EqTerm a (BVTerm bt@(ConTerm (b :: bv n))))
+  (EqTerm c (DynTerm (BVTerm (ConTerm d) :: Term (bv n))))
+    | natVal (Proxy @n) == 1 && b == -1 && d == -1 =
+        pevalEqTerm
+          ( pevalOrBitsTerm
+              (unsafeCoerce a :: Term (bv n))
+              (unsafeCoerce c :: Term (bv n))
+          )
+          bt
+pevalOrTerm
+  (EqTerm a (BVTerm bt@(ConTerm (b :: bv n))))
+  (EqTerm c (DynTerm (BVTerm (ConTerm d) :: Term (bv n))))
+    | natVal (Proxy @n) == 1 && b == 0 && d == 0 =
+        pevalEqTerm
+          ( pevalAndBitsTerm
+              (unsafeCoerce a :: Term (bv n))
+              (unsafeCoerce c :: Term (bv n))
+          )
+          bt
+pevalOrTerm l r = orTerm l r
+{-# INLINEABLE pevalOrTerm #-}
+
+andEqFalse' :: Term Bool -> Term Bool -> Bool
+andEqFalse'
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
+    | e1 == e2 && ec1 /= ec2 = True
+andEqFalse' _ _ = False
+{-# INLINE andEqFalse' #-}
+
+andEqFalse :: Term Bool -> Term Bool -> Bool
+andEqFalse (NotTerm x) y | x == y = True
+andEqFalse x (NotTerm y) | x == y = True
+andEqFalse l r = andEqFalse' l r
+{-# INLINE andEqFalse #-}
+
+andEqFirst' :: Term Bool -> Term Bool -> Bool
+andEqFirst'
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (DistinctTerm ((DynTerm (e2 :: Term a)) :| [DynTerm (ec2@ConTerm {} :: Term b)]))
+    | e1 == e2 && ec1 /= ec2 = True
+andEqFirst'
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (NotTerm (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b))))
+    | e1 == e2 && ec1 /= ec2 = True
+andEqFirst' _ _ = False
+{-# INLINE andEqFirst' #-}
+
+andEqFirst :: Term Bool -> Term Bool -> Bool
+andEqFirst _ (ConTerm True) = True
+andEqFirst x y
+  | x == y = True
+  | otherwise = andEqFirst' x y
+{-# INLINE andEqFirst #-}
+
+simpleNot :: Term Bool -> Term Bool
+simpleNot (NotTerm n) = n
+simpleNot n = notTerm n
+{-# INLINEABLE simpleNot #-}
+
+-- | Partial evaluation for and terms.
+pevalAndTerm :: Term Bool -> Term Bool -> Term Bool
+pevalAndTerm (ConTerm False) ~_ = falseTerm
+pevalAndTerm _ (ConTerm False) = falseTerm
+pevalAndTerm (ConTerm True) y = y
+pevalAndTerm x (ConTerm True) = x
+pevalAndTerm (NotTerm x) y | x == y = falseTerm
+pevalAndTerm x (NotTerm y) | x == y = falseTerm
+pevalAndTerm x y | x == y = x
+pevalAndTerm l ~r
+  | andEqFalse' l r = falseTerm
+  | andEqFirst' l r = l
+  | andEqFirst' r l = r
+pevalAndTerm l r@(AndTermAll r1 r2 s)
+  | HS.member l s = r
+  | HS.member (simpleNot l) s = falseTerm
+  | andEqFalse' l r1 = falseTerm
+  | andEqFalse' l r2 = falseTerm
+  | andEqFirst' r1 l = r
+  | andEqFirst' r2 l = r
+  | andEqFirst' l r1 = pevalAndTerm l r2
+  | andEqFirst' l r2 = pevalAndTerm l r1
+pevalAndTerm l@(AndTermAll l1 l2 s) r
+  | HS.member r s = l
+  | HS.member (simpleNot r) s = falseTerm
+  | andEqFalse' l1 r = falseTerm
+  | andEqFalse' l2 r = falseTerm
+  | andEqFirst' l1 r = l
+  | andEqFirst' l2 r = l
+  | andEqFirst' r l1 = pevalAndTerm l2 r
+  | andEqFirst' r l2 = pevalAndTerm l1 r
+pevalAndTerm (OrTerm l1 l2) (OrTerm r1 r2)
+  | l1 == r1 = pevalOrTerm l1 (pevalAndTerm l2 r2)
+  | l1 == r2 = pevalOrTerm l1 (pevalAndTerm l2 r1)
+  | l2 == r1 = pevalOrTerm l2 (pevalAndTerm l1 r2)
+  | l2 == r2 = pevalOrTerm l2 (pevalAndTerm l1 r1)
+pevalAndTerm l (OrTermAll r1 r2 s)
+  | HS.member l s = l
+  | andEqFirst l r1 = l
+  | andEqFirst l r2 = l
+  | andEqFalse l r1 = pevalAndTerm l r2
+  | andEqFalse l r2 = pevalAndTerm l r1
+pevalAndTerm (OrTermAll l1 l2 s) r
+  | HS.member r s = r
+  | andEqFirst r l1 = r
+  | andEqFirst r l2 = r
+  | andEqFalse l1 r = pevalAndTerm l2 r
+  | andEqFalse l2 r = pevalAndTerm l1 r
+pevalAndTerm
+  (OrTerm l1 nl2@(NotTerm l2))
+  (NotTerm (EqTerm (DynTerm (e1 :: Term Bool)) (DynTerm (e2 :: Term Bool))))
+    | l1 == e1 && l2 == e2 = pevalAndTerm l1 nl2
+pevalAndTerm (NotTerm nl) (NotTerm nr) = pevalNotTerm $ pevalOrTerm nl nr
+pevalAndTerm (OrTermAll _ _ so) r@(AndTermAll _ _ sa)
+  | sa `HS.intersection` so /= HS.empty = r
+pevalAndTerm l@(AndTermAll _ _ sa) (OrTermAll _ _ so)
+  | sa `HS.intersection` so /= HS.empty = l
+pevalAndTerm
+  (EqTerm a (BVTerm bt@(ConTerm (b :: bv n))))
+  (EqTerm c (DynTerm (BVTerm (ConTerm d) :: Term (bv n))))
+    | natVal (Proxy @n) == 1 && b == 0 && d == 0 =
+        pevalEqTerm
+          ( pevalOrBitsTerm
+              (unsafeCoerce a :: Term (bv n))
+              (unsafeCoerce c :: Term (bv n))
+          )
+          bt
+pevalAndTerm
+  (EqTerm a (BVTerm bt@(ConTerm (b :: bv n))))
+  (EqTerm c (DynTerm (BVTerm (ConTerm d) :: Term (bv n))))
+    | natVal (Proxy @n) == 1 && b == -1 && d == -1 =
+        pevalEqTerm
+          ( pevalAndBitsTerm
+              (unsafeCoerce a :: Term (bv n))
+              (unsafeCoerce c :: Term (bv n))
+          )
+          bt
+pevalAndTerm l r = andTerm l r
+{-# INLINEABLE pevalAndTerm #-}
+
+data BVTermView where
+  BVTermView ::
+    forall bv n.
+    ( KnownNat n,
+      1 <= n,
+      PEvalBitwiseTerm (bv n),
+      Eq (bv n),
+      Num (bv n)
+    ) =>
+    Term (bv n) -> BVTermView
+
+bvTermViewPattern ::
+  forall a.
+  (SupportedPrim a) =>
+  Term a ->
+  Maybe BVTermView
+bvTermViewPattern b = case R.typeRep @a of
+  R.App i _ -> case ( R.eqTypeRep i (R.typeRep @IntN),
+                      R.eqTypeRep i (R.typeRep @WordN)
+                    ) of
+    (Just R.HRefl, _) -> withPrim @a $ Just (BVTermView b)
+    (_, Just R.HRefl) -> withPrim @a $ Just (BVTermView b)
+    _ -> Nothing
+  _ -> Nothing
+
+pattern BVTerm ::
+  forall a.
+  (SupportedPrim a) =>
+  forall bv n.
+  (KnownNat n, 1 <= n, PEvalBitwiseTerm (bv n), Eq (bv n), Num (bv n)) =>
+  Term (bv n) -> Term a
+pattern BVTerm x <- (bvTermViewPattern -> Just (BVTermView x))
+
+-- | Partial evaluation for imply terms.
+pevalImplyTerm :: Term Bool -> Term Bool -> Term Bool
+pevalImplyTerm l r | termImplies l r = trueTerm
+pevalImplyTerm l r = pevalOrTerm (pevalNotTerm l) r
+
+-- | Partial evaluation for xor terms.
+pevalXorTerm :: Term Bool -> Term Bool -> Term Bool
+pevalXorTerm l r = pevalOrTerm (pevalAndTerm (pevalNotTerm l) r) (pevalAndTerm l (pevalNotTerm r))
+
+termImplies :: Term Bool -> Term Bool -> Bool
+termImplies (ConTerm False) _ = True
+termImplies _ (ConTerm True) = True
+termImplies
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (DistinctTerm ((DynTerm (e2 :: Term a)) :| [(DynTerm (ec2@ConTerm {} :: Term b))]))
+    | e1 == e2 && ec1 /= ec2 = True
+termImplies
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (NotTerm (EqTerm (DynTerm (e2 :: Term a)) ((DynTerm (ec2@ConTerm {} :: Term b)))))
+    | e1 == e2 && ec1 /= ec2 = True
+termImplies a (OrTermAll _ _ s) | HS.member a s = True
+termImplies (AndTermAll _ _ s) b | HS.member b s = True
+termImplies (AndTermAll _ _ s) (OrTermAll _ _ s2) | HS.intersection s s2 /= HS.empty = True
+termImplies (AndTermAll _ _ s) (AndTermAll _ _ s2) | s2 `HS.isSubsetOf` s = True
+termImplies (OrTermAll _ _ s) (OrTermAll _ _ s2) | s `HS.isSubsetOf` s2 = True
+termImplies a b
+  | a == b = True
+  | otherwise = False
+{-# INLINE termImplies #-}
+
+pevalITEBoolLeftNot :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolLeftNot cond nIfTrue ifFalse
+  -- need test
+  | cond == nIfTrue = Just $ pevalAndTerm (pevalNotTerm cond) ifFalse
+  | otherwise = case nIfTrue of
+      AndTerm nt1 nt2 -> ra
+        where
+          ra
+            | termImplies cond nt1 =
+                Just $ pevalITETerm cond (pevalNotTerm nt2) ifFalse
+            | termImplies cond nt2 =
+                Just $ pevalITETerm cond (pevalNotTerm nt1) ifFalse
+            | termImplies cond (pevalNotTerm nt1)
+                || termImplies cond (pevalNotTerm nt2) =
+                Just $ pevalOrTerm cond ifFalse
+            | otherwise = Nothing
+      OrTerm nt1 nt2 -> ra
+        where
+          ra
+            | termImplies cond nt1 || termImplies cond nt2 =
+                Just $ pevalAndTerm (pevalNotTerm cond) ifFalse
+            | termImplies cond (pevalNotTerm nt1) =
+                Just $ pevalITETerm cond (pevalNotTerm nt2) ifFalse
+            | termImplies cond (pevalNotTerm nt2) =
+                Just $ pevalITETerm cond (pevalNotTerm nt1) ifFalse
+            | otherwise = Nothing
+      _ -> Nothing
+
+pevalITEBoolBothNot :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolBothNot cond nIfTrue nIfFalse =
+  Just $ pevalNotTerm $ pevalITETerm cond nIfTrue nIfFalse
+
+pevalITEBoolRightNot :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolRightNot cond ifTrue nIfFalse
+  -- need test
+  | cond == nIfFalse = Just $ pevalOrTerm (pevalNotTerm cond) ifTrue
+  | otherwise = Nothing -- need work
+
+pevalInferImplies :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalInferImplies
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (NotTerm (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b))))
+  trueRes
+  _
+    | e1 == e2 && ec1 /= ec2 = Just trueRes
+pevalInferImplies cond (NotTerm nt1) _ falseRes
+  | cond == nt1 = Just falseRes
+  | otherwise = Nothing
+-- \| otherwise = case (cond, nt1) of
+--     ( EqTerm _ (e1 :: Term a) (ec1@(ConTerm _ _ _ _) :: Term b),
+--       EqTerm _ (Dyn (e2 :: Term a)) (Dyn (ec2@(ConTerm _ _ _ _) :: Term b))
+--       )
+--         | e1 == e2 && ec1 /= ec2 -> Just trueRes
+--     _ -> Nothing
+pevalInferImplies
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (DistinctTerm ((DynTerm (e2 :: Term a)) :| [DynTerm (ec2@ConTerm {} :: Term b)]))
+  trueRes
+  _
+    | e1 == e2 && ec1 /= ec2 = Just trueRes
+pevalInferImplies
+  (EqTerm (e1 :: Term a) (ec1@ConTerm {} :: Term b))
+  (EqTerm (DynTerm (e2 :: Term a)) (DynTerm (ec2@ConTerm {} :: Term b)))
+  _
+  falseRes
+    | e1 == e2 && ec1 /= ec2 = Just falseRes
+pevalInferImplies _ _ _ _ = Nothing
+
+pevalITEBoolLeftAnd :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolLeftAnd cond t1 t2 ifFalse
+  | t1 == ifFalse = Just $ pevalAndTerm t1 $ pevalImplyTerm cond t2
+  | t2 == ifFalse = Just $ pevalAndTerm t2 $ pevalImplyTerm cond t1
+  | cond == t1 = Just $ pevalITETerm cond t2 ifFalse
+  | cond == t2 = Just $ pevalITETerm cond t1 ifFalse
+  | otherwise =
+      msum
+        [ pevalInferImplies cond t1 (pevalITETerm cond t2 ifFalse) (pevalAndTerm (pevalNotTerm cond) ifFalse),
+          pevalInferImplies cond t2 (pevalITETerm cond t1 ifFalse) (pevalAndTerm (pevalNotTerm cond) ifFalse)
+        ]
+
+pevalITEBoolBothAnd :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolBothAnd cond t1 t2 f1 f2
+  | t1 == f1 = Just $ pevalAndTerm t1 $ pevalITETerm cond t2 f2
+  | t1 == f2 = Just $ pevalAndTerm t1 $ pevalITETerm cond t2 f1
+  | t2 == f1 = Just $ pevalAndTerm t2 $ pevalITETerm cond t1 f2
+  | t2 == f2 = Just $ pevalAndTerm t2 $ pevalITETerm cond t1 f1
+  | otherwise = Nothing
+
+pevalITEBoolRightAnd :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolRightAnd cond ifTrue f1 f2
+  | f1 == ifTrue = Just $ pevalAndTerm f1 $ pevalOrTerm cond f2
+  | f2 == ifTrue = Just $ pevalAndTerm f2 $ pevalOrTerm cond f1
+  | otherwise = Nothing
+
+pevalITEBoolLeftOr :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolLeftOr cond t1 t2 ifFalse
+  | t1 == ifFalse = Just $ pevalOrTerm t1 $ pevalAndTerm cond t2
+  | t2 == ifFalse = Just $ pevalOrTerm t2 $ pevalAndTerm cond t1
+  | cond == t1 = Just $ pevalOrTerm cond ifFalse
+  | cond == t2 = Just $ pevalOrTerm cond ifFalse
+  | otherwise =
+      msum
+        [ pevalInferImplies cond t1 (pevalOrTerm cond ifFalse) (pevalITETerm cond t2 ifFalse),
+          pevalInferImplies cond t2 (pevalOrTerm cond ifFalse) (pevalITETerm cond t1 ifFalse)
+        ]
+
+pevalITEBoolBothOr :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolBothOr cond t1 t2 f1 f2
+  | t1 == f1 = Just $ pevalOrTerm t1 $ pevalITETerm cond t2 f2
+  | t1 == f2 = Just $ pevalOrTerm t1 $ pevalITETerm cond t2 f1
+  | t2 == f1 = Just $ pevalOrTerm t2 $ pevalITETerm cond t1 f2
+  | t2 == f2 = Just $ pevalOrTerm t2 $ pevalITETerm cond t1 f1
+  | otherwise = Nothing
+
+pevalITEBoolRightOr :: Term Bool -> Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolRightOr cond ifTrue f1 f2
+  | f1 == ifTrue = Just $ pevalOrTerm f1 $ pevalAndTerm (pevalNotTerm cond) f2
+  | f2 == ifTrue = Just $ pevalOrTerm f2 $ pevalAndTerm (pevalNotTerm cond) f1
+  | otherwise = Nothing
+
+pevalITEBoolLeft :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolLeft cond (AndTerm t1 t2) ifFalse =
+  msum
+    [ pevalITEBoolLeftAnd cond t1 t2 ifFalse,
+      case ifFalse of
+        AndTerm f1 f2 -> pevalITEBoolBothAnd cond t1 t2 f1 f2
+        _ -> Nothing
+    ]
+pevalITEBoolLeft cond (OrTerm t1 t2) ifFalse =
+  msum
+    [ pevalITEBoolLeftOr cond t1 t2 ifFalse,
+      case ifFalse of
+        OrTerm f1 f2 -> pevalITEBoolBothOr cond t1 t2 f1 f2
+        _ -> Nothing
+    ]
+pevalITEBoolLeft cond (NotTerm nIfTrue) ifFalse =
+  msum
+    [ pevalITEBoolLeftNot cond nIfTrue ifFalse,
+      case ifFalse of
+        NotTerm nIfFalse ->
+          pevalITEBoolBothNot cond nIfTrue nIfFalse
+        _ -> Nothing
+    ]
+pevalITEBoolLeft _ _ _ = Nothing
+
+pevalITEBoolNoLeft :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolNoLeft cond ifTrue (AndTerm f1 f2) = pevalITEBoolRightAnd cond ifTrue f1 f2
+pevalITEBoolNoLeft cond ifTrue (OrTerm f1 f2) = pevalITEBoolRightOr cond ifTrue f1 f2
+pevalITEBoolNoLeft cond ifTrue (NotTerm nIfFalse) = pevalITEBoolRightNot cond ifTrue nIfFalse
+pevalITEBoolNoLeft _ _ _ = Nothing
+
+-- | Basic partial evaluation for ITE terms.
+pevalITEBasic :: (SupportedPrim a) => Term Bool -> Term a -> Term a -> Maybe (Term a)
+pevalITEBasic (ConTerm True) ~ifTrue ~_ = Just ifTrue
+pevalITEBasic (ConTerm False) ~_ ~ifFalse = Just ifFalse
+pevalITEBasic (NotTerm ncond) ifTrue ifFalse = Just $ pevalITETerm ncond ifFalse ifTrue
+pevalITEBasic _ ifTrue ifFalse | ifTrue == ifFalse = Just ifTrue
+pevalITEBasic (ITETerm cc ct cf) (ITETerm tc tt tf) (ITETerm fc ft ff) -- later
+  | cc == tc && cc == fc = Just $ pevalITETerm cc (pevalITETerm ct tt ft) (pevalITETerm cf tf ff)
+pevalITEBasic cond (ITETerm tc tt tf) ifFalse -- later
+  | tt == ifFalse = Just $ pevalITETerm (pevalOrTerm (pevalNotTerm cond) tc) tt tf
+  | tf == ifFalse = Just $ pevalITETerm (pevalAndTerm cond tc) tt tf
+  | termImplies cond tc = Just $ pevalITETerm cond tt ifFalse
+pevalITEBasic cond (ITETerm (AndTerm c1 c2) tt tf) ifFalse
+  | cond == c1 = Just $ pevalITETerm cond (pevalITETerm c2 tt tf) ifFalse
+  | cond == c2 = Just $ pevalITETerm cond (pevalITETerm c1 tt tf) ifFalse
+pevalITEBasic cond ifTrue (ITETerm fc ft ff) -- later
+  | ifTrue == ft = Just $ pevalITETerm (pevalOrTerm cond fc) ifTrue ff
+  | ifTrue == ff = Just $ pevalITETerm (pevalOrTerm cond (pevalNotTerm fc)) ifTrue ft
+  | termImplies fc cond = Just $ pevalITETerm cond ifTrue ff
+pevalITEBasic cond ifTrue (ITETerm (OrTerm c1 c2) ft ff)
+  | cond == c1 = Just $ pevalITETerm cond ifTrue (pevalITETerm c2 ft ff)
+  | cond == c2 = Just $ pevalITETerm cond ifTrue (pevalITETerm c1 ft ff)
+pevalITEBasic _ _ _ = Nothing
+
+pevalITEBoolBasic :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBoolBasic cond ifTrue ifFalse
+  | cond == ifTrue = Just $ pevalOrTerm cond ifFalse
+  | cond == ifFalse = Just $ pevalAndTerm cond ifTrue
+pevalITEBoolBasic cond (ConTerm v) ifFalse
+  | v = Just $ pevalOrTerm cond ifFalse
+  | otherwise = Just $ pevalAndTerm (pevalNotTerm cond) ifFalse
+pevalITEBoolBasic cond ifTrue (ConTerm v)
+  | v = Just $ pevalOrTerm (pevalNotTerm cond) ifTrue
+  | otherwise = Just $ pevalAndTerm cond ifTrue
+pevalITEBoolBasic _ _ _ = Nothing
+
+pevalITEBool :: Term Bool -> Term Bool -> Term Bool -> Maybe (Term Bool)
+pevalITEBool cond ~ifTrue ~ifFalse =
+  msum
+    [ pevalITEBasic cond ifTrue ifFalse,
+      pevalITEBoolBasic cond ifTrue ifFalse,
+      pevalITEBoolLeft cond ifTrue ifFalse,
+      pevalITEBoolNoLeft cond ifTrue ifFalse
+    ]
+
+-- | Basic partial evaluation for ITE terms.
+pevalITEBasicTerm :: (SupportedPrim a) => Term Bool -> Term a -> Term a -> Term a
+pevalITEBasicTerm cond ~ifTrue ~ifFalse =
+  fromMaybe (iteTerm cond ifTrue ifFalse) $
+    pevalITEBasic cond ifTrue ifFalse
+
+-- | Default partial evaluation for equality terms.
+pevalDefaultEqTerm :: (SupportedNonFuncPrim a) => Term a -> Term a -> Term Bool
+pevalDefaultEqTerm l@ConTerm {} r@ConTerm {} = conTerm $ l == r
+pevalDefaultEqTerm l@ConTerm {} r = pevalDefaultEqTerm r l
+pevalDefaultEqTerm l (BoolConTerm rv) =
+  if rv
+    then unsafeCoerce l
+    else pevalNotTerm (unsafeCoerce l)
+pevalDefaultEqTerm (NotTerm lv) r
+  | lv == r = falseTerm
+pevalDefaultEqTerm l (NotTerm rv)
+  | l == rv = falseTerm
+pevalDefaultEqTerm (AddNumTerm (ConTerm c) v) (ConTerm c2) =
+  pevalDefaultEqTerm v (conTerm $ c2 - c)
+pevalDefaultEqTerm l (ITETerm c t f)
+  | l == t = pevalOrTerm c (pevalDefaultEqTerm l f)
+  | l == f = pevalOrTerm (pevalNotTerm c) (pevalDefaultEqTerm l t)
+pevalDefaultEqTerm (ITETerm c t f) r
+  | t == r = pevalOrTerm c (pevalDefaultEqTerm f r)
+  | f == r = pevalOrTerm (pevalNotTerm c) (pevalDefaultEqTerm t r)
+pevalDefaultEqTerm l r
+  | l == r = trueTerm
+  | otherwise = eqTerm l r
+{-# INLINEABLE pevalDefaultEqTerm #-}
+
+instance SBVRep Bool where
+  type SBVType Bool = SBV.SBV Bool
+
+instance SupportedPrimConstraint Bool
+
+instance SupportedPrim Bool where
+  pformatCon True = "true"
+  pformatCon False = "false"
+  defaultValue = defaultValueForBool
+  pevalITETerm cond ~ifTrue ~ifFalse =
+    fromMaybe (iteTerm cond ifTrue ifFalse) $
+      pevalITEBool cond ifTrue ifFalse
+  pevalEqTerm (EqTerm (DynTerm (l1 :: Term Bool)) l2) (EqTerm r1 r2)
+    | l1 == unsafeCoerce r1 = pevalEqTerm l2 (unsafeCoerce r2)
+    | l1 == unsafeCoerce r2 = pevalEqTerm l2 (unsafeCoerce r1)
+    | l2 == unsafeCoerce r1 = pevalEqTerm (unsafeCoerce l1) r2
+    | l2 == unsafeCoerce r2 = pevalEqTerm (unsafeCoerce l1) r1
+  pevalEqTerm (EqTerm (DynTerm (l1 :: Term (WordN 1))) l2) (EqTerm r1 r2)
+    | l1 == unsafeCoerce r1 = pevalEqTerm l2 (unsafeCoerce r2)
+    | l1 == unsafeCoerce r2 = pevalEqTerm l2 (unsafeCoerce r1)
+    | l2 == unsafeCoerce r1 = pevalEqTerm (unsafeCoerce l1) r2
+    | l2 == unsafeCoerce r2 = pevalEqTerm (unsafeCoerce l1) r1
+  pevalEqTerm (EqTerm (DynTerm (l1 :: Term (IntN 1))) l2) (EqTerm r1 r2)
+    | l1 == unsafeCoerce r1 = pevalEqTerm l2 (unsafeCoerce r2)
+    | l1 == unsafeCoerce r2 = pevalEqTerm l2 (unsafeCoerce r1)
+    | l2 == unsafeCoerce r1 = pevalEqTerm (unsafeCoerce l1) r2
+    | l2 == unsafeCoerce r2 = pevalEqTerm (unsafeCoerce l1) r1
+  pevalEqTerm l r = pevalDefaultEqTerm l r
+  pevalDistinctTerm (_ :| []) = conTerm True
+  pevalDistinctTerm (a :| [b]) = pevalNotTerm $ pevalEqTerm a b
+  pevalDistinctTerm _ = conTerm False
+  conSBVTerm n = if n then SBV.sTrue else SBV.sFalse
+  symSBVName symbol _ = show symbol
+  symSBVTerm = sbvFresh
+  withPrim r = r
+  parseSMTModelResult _ = parseScalarSMTModelResult id
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd Bool ->
+    Maybe (TypedSymbol knd' Bool)
+  castTypedSymbol (TypedSymbol s) =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ TypedSymbol s
+      Right HRefl -> Just $ TypedSymbol s
+  funcDummyConstraint _ = SBV.sTrue
+
+instance NonFuncSBVRep Bool where
+  type NonFuncSBVBaseType Bool = Bool
+
+instance SupportedNonFuncPrim Bool where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @Bool
+  withNonFuncPrim r = r
+
+data PhantomDict a where
+  PhantomDict :: (SupportedPrim a) => PhantomDict a
+
+data PhantomNonFuncDict a where
+  PhantomNonFuncDict ::
+    (SupportedNonFuncPrim a) => PhantomNonFuncDict a
+
+{-# NOINLINE phantomDictCache #-}
+phantomDictCache :: IORef (HM.HashMap SomeTypeRep (PhantomDict Any))
+phantomDictCache = unsafePerformIO $ newIORef HM.empty
+
+-- TODO
+{-# NOINLINE getPhantomDict #-}
+getPhantomDict :: forall a. (SupportedPrim a) => PhantomDict a
+getPhantomDict = unsafePerformIO $ do
+  cache <- readIORef phantomDictCache
+  let !tr = SomeTypeRep $ primTypeRep @a
+  case HM.lookup tr cache of
+    Just p -> return $ unsafeCoerce p
+    Nothing -> do
+      let r = PhantomDict :: PhantomDict a
+      atomicModifyIORefCAS_ phantomDictCache $ HM.insert tr $ unsafeCoerce r
+      return r
+
+{-# NOINLINE phantomNonFuncDictCache #-}
+phantomNonFuncDictCache ::
+  IORef (HM.HashMap SomeTypeRep (PhantomNonFuncDict Any))
+phantomNonFuncDictCache = unsafePerformIO $ newIORef HM.empty
+
+-- TODO
+{-# NOINLINE getPhantomNonFuncDict #-}
+getPhantomNonFuncDict ::
+  forall a. (SupportedNonFuncPrim a) => PhantomNonFuncDict a
+getPhantomNonFuncDict = unsafePerformIO $ do
+  cache <- readIORef phantomNonFuncDictCache
+  let !tr = SomeTypeRep $ primTypeRep @a
+  case HM.lookup tr cache of
+    Just p -> return $ unsafeCoerce p
+    Nothing -> do
+      let r = PhantomNonFuncDict :: PhantomNonFuncDict a
+      atomicModifyIORefCAS_ phantomNonFuncDictCache $
+        HM.insert tr $
+          unsafeCoerce r
+      return r
+
+defaultValueForInteger :: Integer
+defaultValueForInteger = 0
+
+-- Basic Integer
+instance SBVRep Integer where
+  type SBVType Integer = SBV.SBV Integer
+
+instance SupportedPrimConstraint Integer where
+  type PrimConstraint Integer = (Integral (NonFuncSBVBaseType Integer))
+
+pairwiseHasConcreteEqual :: (SupportedNonFuncPrim a) => [Term a] -> Bool
+pairwiseHasConcreteEqual [] = False
+pairwiseHasConcreteEqual [_] = False
+pairwiseHasConcreteEqual (x : xs) =
+  go x xs || pairwiseHasConcreteEqual xs
+  where
+    go _ [] = False
+    go x (y : ys) = x == y || go x ys
+
+getAllConcrete :: [Term a] -> Maybe [a]
+getAllConcrete [] = return []
+getAllConcrete (ConTerm x : xs) = (x :) <$> getAllConcrete xs
+getAllConcrete _ = Nothing
+
+checkConcreteDistinct :: (Eq t) => [t] -> Bool
+checkConcreteDistinct [] = True
+checkConcreteDistinct (x : xs) = check0 x xs && checkConcreteDistinct xs
+  where
+    check0 _ [] = True
+    check0 x (y : ys) = x /= y && check0 x ys
+
+pevalGeneralDistinct ::
+  (SupportedNonFuncPrim a) => NonEmpty (Term a) -> Term Bool
+pevalGeneralDistinct (_ :| []) = conTerm True
+pevalGeneralDistinct (a :| [b]) = pevalNotTerm $ pevalEqTerm a b
+pevalGeneralDistinct l | pairwiseHasConcreteEqual $ toList l = conTerm False
+pevalGeneralDistinct l =
+  case getAllConcrete (toList l) of
+    Nothing -> distinctTerm l
+    Just xs -> conTerm $ checkConcreteDistinct xs
+
+instance SupportedPrim Integer where
+  pformatCon = show
+  defaultValue = defaultValueForInteger
+  pevalITETerm = pevalITEBasicTerm
+  pevalEqTerm = pevalDefaultEqTerm
+  pevalDistinctTerm = pevalGeneralDistinct
+  conSBVTerm n = fromInteger n
+  symSBVName symbol _ = show symbol
+  symSBVTerm name = sbvFresh name
+  parseSMTModelResult _ = parseScalarSMTModelResult id
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd Integer ->
+    Maybe (TypedSymbol knd' Integer)
+  castTypedSymbol s =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
+      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
+  funcDummyConstraint _ = SBV.sTrue
+
+instance NonFuncSBVRep Integer where
+  type NonFuncSBVBaseType Integer = Integer
+
+instance SupportedNonFuncPrim Integer where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @Integer
+  withNonFuncPrim r = r
+
+pevalITEBVTerm ::
+  forall bv n.
+  ( KnownNat n,
+    1 <= n,
+    forall m. (KnownNat m, 1 <= m) => SupportedPrim (bv m),
+    forall m. (KnownNat m, 1 <= m) => Show (bv m),
+    PEvalBVTerm bv
+  ) =>
+  Term Bool -> Term (bv n) -> Term (bv n) -> Maybe (Term (bv n))
+pevalITEBVTerm
+  ( EqTerm
+      (DynTerm (l :: Term (bv n)))
+      (DynTerm (ConTerm (r :: bv n)))
+    )
+  (ConTerm t)
+  (ConTerm f)
+    | natVal (Proxy @n) == 1 && r == 1 && t == 0 && f == 1 = Just $ pevalComplementBitsTerm l
+    | natVal (Proxy @n) == 1 && r == 1 && t == 1 && f == 0 = Just l
+    | natVal (Proxy @n) == 1 && r == 0 && t == 0 && f == 1 = Just l
+    | natVal (Proxy @n) == 1 && r == 0 && t == 1 && f == 0 = Just $ pevalComplementBitsTerm l
+pevalITEBVTerm
+  (EqTerm (DynTerm (l :: Term (bv 1))) (DynTerm (ConTerm (r :: bv 1))))
+  (ConTerm t)
+  f
+    | n > 1 && (t == 0 || t == -1) && (r == -1 || r == 0) =
+        Just $
+          (if t == 0 then pevalAndBitsTerm else pevalOrBitsTerm)
+            ( unsafePevalBVExtendTerm
+                (natRepr @1)
+                (natRepr @n)
+                True
+                (if (r == 0) == (t == 0) then l else pevalComplementBitsTerm l)
+            )
+            f
+    where
+      n = natVal (Proxy @n)
+pevalITEBVTerm
+  (EqTerm (DynTerm (_ :: Term (bv 1))) (DynTerm (ConTerm (_ :: bv 1))))
+  (ConTerm _)
+  (ConTerm _) = Nothing
+pevalITEBVTerm
+  (EqTerm (DynTerm (l :: Term (bv 1))) (DynTerm (ConTerm (r :: bv 1))))
+  t
+  f@(ConTerm _) = pevalITEBVTerm (eqTerm l (conTerm $ complement r)) f t
+pevalITEBVTerm
+  cond
+  (BVConcatTerm (a :: Term (bv a)) (b :: Term (bv b)))
+  (BVConcatTerm (DynTerm (c :: Term (bv a))) d) =
+    Just $
+      pevalBVConcatTerm
+        (pevalITETerm cond a c)
+        (pevalITETerm cond b (unsafeCoerce d))
+pevalITEBVTerm
+  cond
+  (BVExtendTerm True pl (a :: Term (bv a)))
+  (BVExtendTerm True _ (DynTerm (b :: Term (bv a)))) =
+    Just $
+      pevalBVExtendTerm
+        True
+        pl
+        (pevalITETerm cond a b)
+pevalITEBVTerm cond (AndBitsTerm a b) (AndBitsTerm c d)
+  | a == c = Just $ andBitsTerm a $ pevalITETerm cond b d
+  | a == d = Just $ andBitsTerm a $ pevalITETerm cond b c
+  | b == c = Just $ andBitsTerm b $ pevalITETerm cond a d
+  | b == d = Just $ andBitsTerm b $ pevalITETerm cond a c
+pevalITEBVTerm cond (AndBitsTerm a b) c
+  | a == c = Just $ andBitsTerm c $ pevalOrBitsTerm (boolToBVTerm $ pevalNotTerm cond) b
+  | b == c = Just $ andBitsTerm c $ pevalOrBitsTerm (boolToBVTerm $ pevalNotTerm cond) a
+pevalITEBVTerm cond a (AndBitsTerm b c)
+  | a == b = Just $ andBitsTerm a $ pevalOrBitsTerm (boolToBVTerm cond) c
+  | a == c = Just $ andBitsTerm a $ pevalOrBitsTerm (boolToBVTerm cond) b
+pevalITEBVTerm cond (OrBitsTerm a b) (OrBitsTerm c d)
+  | a == c = Just $ orBitsTerm a $ pevalITETerm cond b d
+  | a == d = Just $ orBitsTerm a $ pevalITETerm cond b c
+  | b == c = Just $ orBitsTerm b $ pevalITETerm cond a d
+  | b == d = Just $ orBitsTerm b $ pevalITETerm cond a c
+pevalITEBVTerm cond (OrBitsTerm a b) c
+  | a == c = Just $ orBitsTerm c $ pevalAndBitsTerm (boolToBVTerm cond) b
+  | b == c = Just $ orBitsTerm c $ pevalAndBitsTerm (boolToBVTerm cond) a
+pevalITEBVTerm cond a (OrBitsTerm b c)
+  | a == b = Just $ orBitsTerm a $ pevalAndBitsTerm (boolToBVTerm $ pevalNotTerm cond) c
+  | a == c = Just $ orBitsTerm a $ pevalAndBitsTerm (boolToBVTerm $ pevalNotTerm cond) b
+pevalITEBVTerm _ _ _ = Nothing
+
+-- | Convert boolean term to a 1-bit bitvector term.
+boolToBVTerm ::
+  forall bv n.
+  ( PEvalBVTerm bv,
+    KnownNat n,
+    1 <= n,
+    forall m. (KnownNat m, 1 <= m) => SupportedPrim (bv m)
+  ) =>
+  Term Bool -> Term (bv n)
+boolToBVTerm cond =
+  let bv =
+        case cond of
+          NotTerm c -> iteTerm c (conTerm 0) (conTerm 1)
+          _ -> iteTerm cond (conTerm 1 :: Term (bv 1)) (conTerm 0) :: Term (bv 1)
+   in if natVal (Proxy @n) == 1
+        then unsafeCoerce bv
+        else bvExtendTerm True (natRepr @n) bv
+
+-- Signed BV
+instance (KnownNat w, 1 <= w) => SupportedPrimConstraint (IntN w) where
+  type PrimConstraint (IntN w) = (KnownNat w, 1 <= w, BVIsNonZero w)
+
+instance (KnownNat w, 1 <= w) => SBVRep (IntN w) where
+  type SBVType (IntN w) = SBV.SBV (SBV.IntN w)
+
+instance (KnownNat w, 1 <= w) => SupportedPrim (IntN w) where
+  sbvDistinct = withPrim @(IntN w) $ SBV.distinct . toList
+  sbvEq = withPrim @(IntN w) (SBV..==)
+  pformatCon = show
+  defaultValue = 0
+  pevalITETerm cond ifTrue ifFalse =
+    fromMaybe (iteTerm cond ifTrue ifFalse) $
+      msum
+        [ pevalITEBasic cond ifTrue ifFalse,
+          pevalITEBVTerm cond ifTrue ifFalse
+        ]
+  pevalEqTerm = pevalDefaultEqTerm
+  pevalDistinctTerm = pevalGeneralDistinct
+  conSBVTerm n = bvIsNonZeroFromGEq1 (Proxy @w) $ fromIntegral n
+  symSBVName symbol _ = show symbol
+  symSBVTerm name = bvIsNonZeroFromGEq1 (Proxy @w) $ sbvFresh name
+  withPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
+  {-# INLINE withPrim #-}
+  parseSMTModelResult _ cv =
+    withPrim @(IntN w) $
+      parseScalarSMTModelResult (\(x :: SBV.IntN w) -> fromIntegral x) cv
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd (IntN w) ->
+    Maybe (TypedSymbol knd' (IntN w))
+  castTypedSymbol s =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
+      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
+  funcDummyConstraint _ = SBV.sTrue
+
+-- | Construct the 'SBV.BVIsNonZero' constraint from the proof that the width is
+-- at least 1.
+bvIsNonZeroFromGEq1 ::
+  forall w r proxy.
+  (1 <= w) =>
+  proxy w ->
+  ((SBV.BVIsNonZero w) => r) ->
+  r
+bvIsNonZeroFromGEq1 _ r1 = case unsafeAxiom :: w :~: 1 of
+  Refl -> r1
+{-# INLINE bvIsNonZeroFromGEq1 #-}
+
+instance (KnownNat w, 1 <= w) => NonFuncSBVRep (IntN w) where
+  type NonFuncSBVBaseType (IntN w) = SBV.IntN w
+
+instance (KnownNat w, 1 <= w) => SupportedNonFuncPrim (IntN w) where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @(IntN w)
+  withNonFuncPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
+
+-- Unsigned BV
+instance (KnownNat w, 1 <= w) => SupportedPrimConstraint (WordN w) where
+  type PrimConstraint (WordN w) = (KnownNat w, 1 <= w, BVIsNonZero w)
+
+instance (KnownNat w, 1 <= w) => SBVRep (WordN w) where
+  type SBVType (WordN w) = SBV.SBV (SBV.WordN w)
+
+instance (KnownNat w, 1 <= w) => SupportedPrim (WordN w) where
+  sbvDistinct = withPrim @(WordN w) $ SBV.distinct . toList
+  sbvEq = withPrim @(WordN w) (SBV..==)
+  pformatCon = show
+  defaultValue = 0
+  pevalITETerm cond ifTrue ifFalse =
+    fromMaybe (iteTerm cond ifTrue ifFalse) $
+      msum
+        [ pevalITEBasic cond ifTrue ifFalse,
+          pevalITEBVTerm cond ifTrue ifFalse
+        ]
+  pevalEqTerm = pevalDefaultEqTerm
+  pevalDistinctTerm = pevalGeneralDistinct
+  conSBVTerm n = bvIsNonZeroFromGEq1 (Proxy @w) $ fromIntegral n
+  symSBVName symbol _ = show symbol
+  symSBVTerm name = bvIsNonZeroFromGEq1 (Proxy @w) $ sbvFresh name
+  withPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
+  {-# INLINE withPrim #-}
+  parseSMTModelResult _ cv =
+    withPrim @(WordN w) $
+      parseScalarSMTModelResult (\(x :: SBV.WordN w) -> fromIntegral x) cv
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd (WordN w) ->
+    Maybe (TypedSymbol knd' (WordN w))
+  castTypedSymbol s =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
+      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
+  funcDummyConstraint _ = SBV.sTrue
+
+instance (KnownNat w, 1 <= w) => NonFuncSBVRep (WordN w) where
+  type NonFuncSBVBaseType (WordN w) = SBV.WordN w
+
+instance (KnownNat w, 1 <= w) => SupportedNonFuncPrim (WordN w) where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @(WordN w)
+  withNonFuncPrim r = bvIsNonZeroFromGEq1 (Proxy @w) r
+
+-- FP
+instance (ValidFP eb sb) => SupportedPrimConstraint (FP eb sb) where
+  type PrimConstraint (FP eb sb) = ValidFP eb sb
+
+instance (ValidFP eb sb) => SBVRep (FP eb sb) where
+  type SBVType (FP eb sb) = SBV.SBV (SBV.FloatingPoint eb sb)
+
+instance (ValidFP eb sb) => SupportedPrim (FP eb sb) where
+  sameCon a b
+    | isNaN a = isNaN b
+    | fpIsPositiveZero a = fpIsPositiveZero b
+    | fpIsNegativeZero a = fpIsNegativeZero b
+    | otherwise = a == b
+  hashConWithSalt s a
+    | isNaN a = hashWithSalt s (2654435761 :: Int)
+    | otherwise = hashWithSalt s a
+  defaultValue = 0
+  pevalITETerm = pevalITEBasicTerm
+  pevalEqTerm (ConTerm l) (ConTerm r) = conTerm $ l == r
+  pevalEqTerm l@ConTerm {} r = pevalEqTerm r l
+  pevalEqTerm l r = eqTerm l r
+  pevalDistinctTerm (_ :| []) = conTerm True
+  pevalDistinctTerm (a :| [b]) = pevalNotTerm $ pevalEqTerm a b
+  pevalDistinctTerm l =
+    case getAllConcrete (toList l) of
+      Nothing -> distinctTerm l
+      Just xs | any isNaN xs -> distinctTerm l
+      Just xs -> conTerm $ checkConcreteDistinct xs
+  conSBVTerm (FP fp) = SBV.literal fp
+  symSBVName symbol _ = show symbol
+  symSBVTerm name = sbvFresh name
+  parseSMTModelResult _ cv =
+    withPrim @(FP eb sb) $
+      parseScalarSMTModelResult (\(x :: SBV.FloatingPoint eb sb) -> coerce x) cv
+  funcDummyConstraint _ = SBV.sTrue
+
+  -- Workaround for sbv#702.
+  sbvIte = withPrim @(FP eb sb) $ \c a b ->
+    case (SBV.unliteral a, SBV.unliteral b) of
+      (Just a', Just b')
+        | isInfinite a' && isInfinite b' ->
+            let correspondingZero x = if x > 0 then 0 else -0
+             in 1
+                  / sbvIte @(FP eb sb)
+                    c
+                    (conSBVTerm @(FP eb sb) $ correspondingZero a')
+                    (conSBVTerm @(FP eb sb) $ correspondingZero b')
+      _ -> SBV.ite c a b
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd (FP eb sb) ->
+    Maybe (TypedSymbol knd' (FP eb sb))
+  castTypedSymbol s =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
+      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
+
+instance (ValidFP eb sb) => NonFuncSBVRep (FP eb sb) where
+  type NonFuncSBVBaseType (FP eb sb) = SBV.FloatingPoint eb sb
+
+instance (ValidFP eb sb) => SupportedNonFuncPrim (FP eb sb) where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @(FP eb sb)
+  withNonFuncPrim r = r
+
+-- FPRoundingMode
+instance SupportedPrimConstraint FPRoundingMode
+
+instance SBVRep FPRoundingMode where
+  type SBVType FPRoundingMode = SBV.SBV SBV.RoundingMode
+
+instance SupportedPrim FPRoundingMode where
+  defaultValue = RNE
+  pevalITETerm = pevalITEBasicTerm
+  pevalEqTerm (ConTerm l) (ConTerm r) = conTerm $ l == r
+  pevalEqTerm l@ConTerm {} r = pevalEqTerm r l
+  pevalEqTerm l r = eqTerm l r
+  pevalDistinctTerm = pevalGeneralDistinct
+  conSBVTerm RNE = SBV.sRNE
+  conSBVTerm RNA = SBV.sRNA
+  conSBVTerm RTP = SBV.sRTP
+  conSBVTerm RTN = SBV.sRTN
+  conSBVTerm RTZ = SBV.sRTZ
+  symSBVName symbol _ = show symbol
+  symSBVTerm name = sbvFresh name
+  parseSMTModelResult _ cv =
+    withPrim @(FPRoundingMode) $
+      parseScalarSMTModelResult
+        ( \(x :: SBV.RoundingMode) -> case x of
+            SBV.RoundNearestTiesToEven -> RNE
+            SBV.RoundNearestTiesToAway -> RNA
+            SBV.RoundTowardPositive -> RTP
+            SBV.RoundTowardNegative -> RTN
+            SBV.RoundTowardZero -> RTZ
+        )
+        cv
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd FPRoundingMode ->
+    Maybe (TypedSymbol knd' FPRoundingMode)
+  castTypedSymbol s =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
+      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
+  funcDummyConstraint _ = SBV.sTrue
+
+instance NonFuncSBVRep FPRoundingMode where
+  type NonFuncSBVBaseType FPRoundingMode = SBV.RoundingMode
+
+instance SupportedNonFuncPrim FPRoundingMode where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @FPRoundingMode
+  withNonFuncPrim r = r
+
+-- AlgReal
+
+instance SupportedPrimConstraint AlgReal
+
+instance SBVRep AlgReal where
+  type SBVType AlgReal = SBV.SBV SBV.AlgReal
+
+instance SupportedPrim AlgReal where
+  defaultValue = 0
+  pevalITETerm = pevalITEBasicTerm
+  pevalEqTerm (ConTerm l) (ConTerm r) = conTerm $ l == r
+  pevalEqTerm l@ConTerm {} r = pevalEqTerm r l
+  pevalEqTerm l r = eqTerm l r
+  pevalDistinctTerm = pevalGeneralDistinct
+  conSBVTerm = SBV.literal . toSBVAlgReal
+  symSBVName symbol _ = show symbol
+  symSBVTerm name = sbvFresh name
+  parseSMTModelResult _ cv =
+    withPrim @AlgReal $
+      parseScalarSMTModelResult fromSBVAlgReal cv
+  castTypedSymbol ::
+    forall knd knd'.
+    (IsSymbolKind knd') =>
+    TypedSymbol knd AlgReal ->
+    Maybe (TypedSymbol knd' AlgReal)
+  castTypedSymbol s =
+    case decideSymbolKind @knd' of
+      Left HRefl -> Just $ typedConstantSymbol $ unTypedSymbol s
+      Right HRefl -> Just $ typedAnySymbol $ unTypedSymbol s
+  funcDummyConstraint _ = SBV.sTrue
+
+instance NonFuncSBVRep AlgReal where
+  type NonFuncSBVBaseType AlgReal = SBV.AlgReal
+
+instance SupportedNonFuncPrim AlgReal where
+  conNonFuncSBVTerm = conSBVTerm
+  symNonFuncSBVTerm = symSBVTerm @AlgReal
+  withNonFuncPrim r = r
+
+-- Bitwise
+
+bitOpOnConcat ::
+  forall bv m.
+  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
+    PEvalBVTerm bv,
+    KnownNat m,
+    1 <= m
+  ) =>
+  ( forall n.
+    (KnownNat n, 1 <= n) =>
+    Term (bv n) -> Term (bv n) -> Term (bv n)
+  ) ->
+  Term (bv m) ->
+  Term (bv m) ->
+  Maybe (Term (bv m))
+bitOpOnConcat
+  peval
+  (BVConcatTerm (l0 :: Term (bv l)) (r0 :: Term (bv r)))
+  (BVConcatTerm (DynTerm (l :: Term (bv l))) (DynTerm (r :: Term (bv r)))) =
+    let r' = peval r0 r
+        l' = peval l0 l
+     in Just $ pevalBVConcatTerm l' r'
+bitOpOnConcat
+  peval
+  at@(ConTerm _)
+  (BVConcatTerm (l :: Term (bv l)) (r :: Term (bv r))) =
+    let nzero = natRepr @0
+        nr = natRepr @r
+        nl = natRepr @l
+        nlpr = natRepr @(l + r)
+        ar =
+          unsafePevalBVSelectTerm
+            nlpr
+            nzero
+            nr
+            (unsafeCoerce at :: Term (bv (l + r)))
+        al =
+          unsafePevalBVSelectTerm
+            nlpr
+            nr
+            nl
+            (unsafeCoerce at :: Term (bv (l + r)))
+        r' = peval ar r
+        l' = peval al l
+     in Just $ pevalBVConcatTerm l' r'
+bitOpOnConcat
+  peval
+  (BVExtendTerm True pl (l :: Term (bv n)))
+  (BVExtendTerm True _ (DynTerm (r :: Term (bv n)))) =
+    Just $ pevalBVExtendTerm True pl (peval l r)
+bitOpOnConcat _ _ _ = Nothing
+
+doPevalAndBitsTerm ::
+  forall bv m.
+  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
+    PEvalBVTerm bv,
+    KnownNat m,
+    1 <= m
+  ) =>
+  Term (bv m) ->
+  Term (bv m) ->
+  Maybe (Term (bv m))
+doPevalAndBitsTerm (ConTerm a) (ConTerm b) =
+  Just $ conTerm (a .&. b)
+doPevalAndBitsTerm (ConTerm a) b
+  | a == zeroBits = Just $ conTerm zeroBits
+  | a == complement zeroBits = Just b
+  | aok || acok =
+      case ( mkPositiveNatRepr $ fromIntegral leadingBits,
+             mkPositiveNatRepr $ fromIntegral trailingBits
+           ) of
+        ( SomePositiveNatRepr (pleadingBits :: NatRepr leadingBits),
+          SomePositiveNatRepr (ptrailingBitsRepr :: NatRepr trailingBits)
+          ) ->
+            case ( unsafeAxiom @(leadingBits + trailingBits) @m,
+                   unsafeAxiom @(trailingBits + leadingBits) @m,
+                   unsafeLeqProof @trailingBits @m
+                 ) of
+              (Refl, Refl, LeqProof) ->
+                if aok
+                  then
+                    Just $
+                      pevalBVConcatTerm (conTerm 0 :: Term (bv leadingBits)) $
+                        pevalBVSelectTerm (natRepr @0) ptrailingBitsRepr b
+                  else
+                    Just $
+                      pevalBVConcatTerm
+                        (pevalBVSelectTerm ptrailingBitsRepr pleadingBits b)
+                        (conTerm 0 :: Term (bv trailingBits))
+  where
+    leadingBits = if aok then countLeadingZeros a else countLeadingZeros ac
+    trailingBits = fromIntegral (natVal @m a) - leadingBits
+    ac = complement a
+    aok = a .&. (a + 1) == 0
+    acok = ac .&. (ac + 1) == 0
+doPevalAndBitsTerm a b@(ConTerm _) = doPevalAndBitsTerm b a
+doPevalAndBitsTerm a b | a == b = Just a
+doPevalAndBitsTerm (ITETerm cond a@(ConTerm av) b@(ConTerm bv)) c
+  | av `elem` [0, -1] || bv `elem` [0, -1] =
+      Just $ pevalITETerm cond (pevalAndBitsTerm a c) (pevalAndBitsTerm b c)
+doPevalAndBitsTerm a (ITETerm cond b@(ConTerm bv) c@(ConTerm cv))
+  | bv `elem` [0, -1] || cv `elem` [0, -1] =
+      Just $ pevalITETerm cond (pevalAndBitsTerm a b) (pevalAndBitsTerm a c)
+doPevalAndBitsTerm (ITETerm cond a@(ConTerm v) b) c
+  | v == 0 = Just $ pevalITETerm cond a (pevalAndBitsTerm b c)
+doPevalAndBitsTerm (ITETerm cond a b@(ConTerm v)) c
+  | v == 0 = Just $ pevalITETerm cond (pevalAndBitsTerm a c) b
+doPevalAndBitsTerm a (ITETerm cond b@(ConTerm v) c)
+  | v == 0 = Just $ pevalITETerm cond b (pevalAndBitsTerm a c)
+doPevalAndBitsTerm a (ITETerm cond b c@(ConTerm v))
+  | v == 0 = Just $ pevalITETerm cond (pevalAndBitsTerm a b) c
+doPevalAndBitsTerm (BVExtendTerm True pl (ITETerm cond at@(ConTerm a) bt@(ConTerm b))) c
+  | a `elem` [0, -1] && b `elem` [0, -1] =
+      Just $
+        pevalITETerm
+          cond
+          (pevalAndBitsTerm (pevalBVExtendTerm True pl at) c)
+          (pevalAndBitsTerm (pevalBVExtendTerm True pl bt) c)
+doPevalAndBitsTerm a (BVExtendTerm True pl (ITETerm cond bt@(ConTerm b) ct@(ConTerm c)))
+  | b `elem` [0, -1] && c `elem` [0, -1] =
+      Just $
+        pevalITETerm
+          cond
+          (pevalAndBitsTerm a (pevalBVExtendTerm True pl bt))
+          (pevalAndBitsTerm a (pevalBVExtendTerm True pl ct))
+doPevalAndBitsTerm a b = bitOpOnConcat @bv @m pevalDefaultAndBitsTerm a b
+
+pevalDefaultAndBitsTerm ::
+  forall bv m.
+  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
+    PEvalBVTerm bv,
+    KnownNat m,
+    1 <= m
+  ) =>
+  Term (bv m) ->
+  Term (bv m) ->
+  Term (bv m)
+pevalDefaultAndBitsTerm = binaryUnfoldOnce doPevalAndBitsTerm andBitsTerm
+
+doPevalOrBitsTerm ::
+  forall bv m.
+  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
+    PEvalBVTerm bv,
+    KnownNat m,
+    1 <= m
+  ) =>
+  Term (bv m) ->
+  Term (bv m) ->
+  Maybe (Term (bv m))
+doPevalOrBitsTerm (ConTerm a) (ConTerm b) = Just $ conTerm (a .|. b)
+doPevalOrBitsTerm (ConTerm a) b
+  | a == zeroBits = Just b
+  | a == complement zeroBits = Just $ conTerm $ complement zeroBits
+  | aok || acok =
+      case ( mkPositiveNatRepr $ fromIntegral leadingBits,
+             mkPositiveNatRepr $ fromIntegral trailingBits
+           ) of
+        ( SomePositiveNatRepr (pleadingBits :: NatRepr leadingBits),
+          SomePositiveNatRepr (ptrailingBitsRepr :: NatRepr trailingBits)
+          ) ->
+            case ( unsafeAxiom @(leadingBits + trailingBits) @m,
+                   unsafeAxiom @(trailingBits + leadingBits) @m,
+                   unsafeLeqProof @trailingBits @m
+                 ) of
+              (Refl, Refl, LeqProof) ->
+                if acok
+                  then
+                    Just $
+                      pevalBVConcatTerm (conTerm $ -1 :: Term (bv leadingBits)) $
+                        pevalBVSelectTerm (natRepr @0) ptrailingBitsRepr b
+                  else
+                    Just $
+                      pevalBVConcatTerm
+                        (pevalBVSelectTerm ptrailingBitsRepr pleadingBits b)
+                        (conTerm $ -1 :: Term (bv trailingBits))
+  where
+    leadingBits = if aok then countLeadingZeros a else countLeadingZeros ac
+    trailingBits = fromIntegral (natVal @m a) - leadingBits
+    ac = complement a
+    aok = a .&. (a + 1) == 0
+    acok = ac .&. (ac + 1) == 0
+doPevalOrBitsTerm a b@(ConTerm _) = doPevalOrBitsTerm b a
+doPevalOrBitsTerm a b | a == b = Just a
+doPevalOrBitsTerm (ITETerm cond a@(ConTerm _) b@(ConTerm _)) c =
+  Just $ pevalITETerm cond (pevalOrBitsTerm a c) (pevalOrBitsTerm b c)
+doPevalOrBitsTerm a (ITETerm cond b@(ConTerm _) c@(ConTerm _)) =
+  Just $ pevalITETerm cond (pevalOrBitsTerm a b) (pevalOrBitsTerm a c)
+doPevalOrBitsTerm (ITETerm cond a@(ConTerm v) b) c
+  | v == -1 = Just $ pevalITETerm cond a (pevalOrBitsTerm b c)
+doPevalOrBitsTerm (ITETerm cond a b@(ConTerm v)) c
+  | v == -1 = Just $ pevalITETerm cond (pevalOrBitsTerm a c) b
+doPevalOrBitsTerm a (ITETerm cond b@(ConTerm v) c)
+  | v == -1 = Just $ pevalITETerm cond b (pevalOrBitsTerm a c)
+doPevalOrBitsTerm a (ITETerm cond b c@(ConTerm v))
+  | v == -1 = Just $ pevalITETerm cond (pevalOrBitsTerm a b) c
+doPevalOrBitsTerm (BVExtendTerm True pl (ITETerm cond at@(ConTerm a) bt@(ConTerm b))) c
+  | a `elem` [0, -1] && b `elem` [0, -1] =
+      Just $
+        pevalITETerm
+          cond
+          (pevalOrBitsTerm (pevalBVExtendTerm True pl at) c)
+          (pevalOrBitsTerm (pevalBVExtendTerm True pl bt) c)
+doPevalOrBitsTerm a (BVExtendTerm True pl (ITETerm cond bt@(ConTerm b) ct@(ConTerm c)))
+  | b `elem` [0, -1] && c `elem` [0, -1] =
+      Just $
+        pevalITETerm
+          cond
+          (pevalOrBitsTerm a (pevalBVExtendTerm True pl bt))
+          (pevalOrBitsTerm a (pevalBVExtendTerm True pl ct))
+doPevalOrBitsTerm a b = bitOpOnConcat @bv @m pevalDefaultOrBitsTerm a b
+
+pevalDefaultOrBitsTerm ::
+  forall bv m.
+  ( KnownNat m,
+    1 <= m,
+    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
+    PEvalBVTerm bv
+  ) =>
+  Term (bv m) -> Term (bv m) -> Term (bv m)
+pevalDefaultOrBitsTerm = binaryUnfoldOnce doPevalOrBitsTerm orBitsTerm
+
+pevalDefaultXorBitsTerm ::
+  forall bv m.
+  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
+    PEvalBVTerm bv,
+    KnownNat m,
+    1 <= m
+  ) =>
+  Term (bv m) -> Term (bv m) -> Term (bv m)
+pevalDefaultXorBitsTerm = binaryUnfoldOnce doPevalXorBitsTerm xorBitsTerm
+  where
+    doPevalXorBitsTerm (ConTerm a) (ConTerm b) =
+      Just $ conTerm (a `xor` b)
+    doPevalXorBitsTerm (ConTerm a) b
+      | a == zeroBits = Just b
+      | a == complement zeroBits = Just $ pevalComplementBitsTerm b
+    doPevalXorBitsTerm a b@(ConTerm _) = doPevalXorBitsTerm b a
+    doPevalXorBitsTerm a b | a == b = Just $ conTerm zeroBits
+    doPevalXorBitsTerm (ComplementBitsTerm i) (ComplementBitsTerm j) =
+      Just $ pevalXorBitsTerm i j
+    doPevalXorBitsTerm (ComplementBitsTerm i) j =
+      Just $ pevalComplementBitsTerm $ pevalXorBitsTerm i j
+    doPevalXorBitsTerm i (ComplementBitsTerm j) =
+      Just $ pevalComplementBitsTerm $ pevalXorBitsTerm i j
+    doPevalXorBitsTerm a b = bitOpOnConcat @bv @m pevalDefaultXorBitsTerm a b
+
+pevalDefaultComplementBitsTerm ::
+  (Bits a, SupportedPrim a, PEvalBitwiseTerm a) => Term a -> Term a
+pevalDefaultComplementBitsTerm =
+  unaryUnfoldOnce doPevalComplementBitsTerm complementBitsTerm
+  where
+    doPevalComplementBitsTerm (ConTerm a) = Just $ conTerm $ complement a
+    doPevalComplementBitsTerm (ComplementBitsTerm a) = Just a
+    doPevalComplementBitsTerm (BVConcatTerm l r) =
+      Just $
+        pevalBVConcatTerm
+          (pevalComplementBitsTerm l)
+          (pevalComplementBitsTerm r)
+    doPevalComplementBitsTerm (BVExtendTerm True pr t) =
+      Just $ pevalBVExtendTerm True pr $ pevalComplementBitsTerm t
+    doPevalComplementBitsTerm _ = Nothing
+
+instance (KnownNat n, 1 <= n) => PEvalBitwiseTerm (WordN n) where
+  pevalAndBitsTerm = pevalDefaultAndBitsTerm
+  pevalOrBitsTerm = pevalDefaultOrBitsTerm
+  pevalXorBitsTerm = pevalDefaultXorBitsTerm
+  pevalComplementBitsTerm = pevalDefaultComplementBitsTerm
+  withSbvBitwiseTermConstraint r = withPrim @(WordN n) r
+
+instance (KnownNat n, 1 <= n) => PEvalBitwiseTerm (IntN n) where
+  pevalAndBitsTerm = pevalDefaultAndBitsTerm
+  pevalOrBitsTerm = pevalDefaultOrBitsTerm
+  pevalXorBitsTerm = pevalDefaultXorBitsTerm
+  pevalComplementBitsTerm = pevalDefaultComplementBitsTerm
+  withSbvBitwiseTermConstraint r = withPrim @(IntN n) r
+
+-- BVTerm
+
+pevalDefaultBVSelectTerm ::
+  forall (bv2 :: Nat -> Type) bv n ix w p q.
+  ( KnownNat n,
+    KnownNat ix,
+    KnownNat w,
+    1 <= n,
+    1 <= w,
+    ix + w <= n,
+    PEvalBVTerm bv,
+    forall x. (KnownNat x, 1 <= x) => PEvalBitCastTerm (bv2 x) (bv x),
+    PEvalBVTerm bv2,
+    Typeable bv,
+    SupportedPrim (bv w),
+    SupportedPrim (bv2 n)
+  ) =>
+  p ix ->
+  q w ->
+  Term (bv n) ->
+  Term (bv w)
+pevalDefaultBVSelectTerm ix w =
+  unaryUnfoldOnce (doPevalDefaultBVSelectTerm @bv2 ix w) (bvSelectTerm ix w)
+
+-- | Unsafe version of `pevalBVSelectTerm`. Use `NatRepr` for the bit-width
+-- representations.
+unsafePevalBVSelectTerm ::
+  forall bv n ix w.
+  (PEvalBVTerm bv) =>
+  NatRepr n ->
+  NatRepr ix ->
+  NatRepr w ->
+  Term (bv n) ->
+  Term (bv w)
+unsafePevalBVSelectTerm n ix w term =
+  withKnownNat n $
+    withKnownNat ix $
+      withKnownNat w $
+        case ( unsafeLeqProof @1 @n,
+               unsafeLeqProof @1 @w,
+               unsafeLeqProof @(ix + w) @n
+             ) of
+          (LeqProof, LeqProof, LeqProof) -> pevalBVSelectTerm ix w term
+
+doPevalDefaultBVSelectTerm ::
+  forall (bv2 :: Nat -> Type) bv n ix w p q.
+  ( KnownNat n,
+    KnownNat ix,
+    KnownNat w,
+    forall x. (KnownNat x, 1 <= x) => PEvalBitCastTerm (bv2 x) (bv x),
+    1 <= n,
+    1 <= w,
+    ix + w <= n,
+    PEvalBVTerm bv,
+    PEvalBVTerm bv2,
+    Typeable bv,
+    SupportedPrim (bv w),
+    SupportedPrim (bv2 n)
+  ) =>
+  p ix ->
+  q w ->
+  Term (bv n) ->
+  Maybe (Term (bv w))
+doPevalDefaultBVSelectTerm _ _ rhs
+  | isJust (sameNat (Proxy @ix) (Proxy @0))
+      && isJust (sameNat (Proxy @w) (Proxy @n)) =
+      Just rhs >>= castTerm
+doPevalDefaultBVSelectTerm ix w (ConTerm b) =
+  Just $ conTerm $ sizedBVSelect ix w b
+doPevalDefaultBVSelectTerm ix w (BitCastTerm (DynTerm (b :: Term (bv2 n)))) =
+  Just $ pevalBitCastTerm $ pevalBVSelectTerm ix w b
+doPevalDefaultBVSelectTerm ix w (AddNumTerm t1 t2)
+  | natVal @ix ix == 0 =
+      Just $
+        AddNumTerm
+          (pevalDefaultBVSelectTerm @bv2 @bv ix w t1)
+          (pevalDefaultBVSelectTerm @bv2 @bv ix w t2)
+doPevalDefaultBVSelectTerm ix w (MulNumTerm t1 t2)
+  | natVal @ix ix == 0 =
+      Just $
+        MulNumTerm
+          (pevalDefaultBVSelectTerm @bv2 @bv ix w t1)
+          (pevalDefaultBVSelectTerm @bv2 @bv ix w t2)
+doPevalDefaultBVSelectTerm ix w (AndBitsTerm t1 t2) =
+  Just $
+    AndBitsTerm
+      (pevalDefaultBVSelectTerm @bv2 @bv ix w t1)
+      (pevalDefaultBVSelectTerm @bv2 @bv ix w t2)
+doPevalDefaultBVSelectTerm ix w (OrBitsTerm t1 t2) =
+  Just $
+    OrBitsTerm
+      (pevalDefaultBVSelectTerm @bv2 @bv ix w t1)
+      (pevalDefaultBVSelectTerm @bv2 @bv ix w t2)
+doPevalDefaultBVSelectTerm ix w (XorBitsTerm t1 t2) =
+  Just $
+    XorBitsTerm
+      (pevalDefaultBVSelectTerm @bv2 @bv ix w t1)
+      (pevalDefaultBVSelectTerm @bv2 @bv ix w t2)
+doPevalDefaultBVSelectTerm
+  pix
+  pw
+  (BVConcatTerm (b1 :: Term (bv n1)) (b2 :: Term (bv n2)))
+    | ix + w <= n2 = Just $ unsafePevalBVSelectTerm n2Repr ixRepr wRepr b2
+    | ix >= n2 =
+        case mkNatRepr (ix - n2) of
+          SomeNatRepr ixpn2Repr ->
+            Just $ unsafePevalBVSelectTerm n1Repr ixpn2Repr wRepr b1
+    | otherwise =
+        case (mkNatRepr (w + ix - n2), mkNatRepr (n2 - ix)) of
+          (SomeNatRepr wixpn2Repr, SomeNatRepr n2pixRepr) ->
+            let b1Part =
+                  unsafePevalBVSelectTerm n1Repr (natRepr @0) wixpn2Repr b1
+                b2Part = unsafePevalBVSelectTerm n2Repr ixRepr n2pixRepr b2
+             in Just $
+                  unsafePevalBVConcatTerm
+                    wixpn2Repr
+                    n2pixRepr
+                    wRepr
+                    b1Part
+                    b2Part
+    where
+      ixRepr = natRepr @ix
+      wRepr = natRepr @w
+      n1Repr = natRepr @n1
+      n2Repr = natRepr @n2
+      ix = natVal @ix pix
+      w = natVal @w pw
+      n2 = natVal @n2 (Proxy @n2)
+doPevalDefaultBVSelectTerm
+  _
+  _
+  (BVSelectTerm (_ :: proxy ix1) _ (b :: Term (bv n1))) =
+    Just $
+      unsafePevalBVSelectTerm
+        (natRepr @n1)
+        (addNat (natRepr @ix) (natRepr @ix1))
+        (natRepr @w)
+        b
+doPevalDefaultBVSelectTerm
+  pix
+  pw
+  (BVExtendTerm signed _ (b :: Term (bv n1)))
+    | ix + w <= n1 = Just $ unsafePevalBVSelectTerm n1Repr ixRepr wRepr b
+    | ix < n1 =
+        case mkNatRepr (n1 - ix) of
+          SomeNatRepr n1pixRepr ->
+            let bPart = unsafePevalBVSelectTerm n1Repr ixRepr n1pixRepr b
+             in Just $ unsafePevalBVExtendTerm n1pixRepr wRepr signed bPart
+    | otherwise = Nothing
+    where
+      ixRepr = natRepr @ix
+      wRepr = natRepr @w
+      n1Repr = natRepr @n1
+      ix = natVal @ix pix
+      w = natVal @w pw
+      n1 = natVal @n1 (Proxy @n1)
+doPevalDefaultBVSelectTerm _ _ _ = Nothing
+
+pevalDefaultBVExtendTerm ::
+  forall proxy l r bv.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    Typeable bv,
+    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
+  ) =>
+  Bool ->
+  proxy r ->
+  Term (bv l) ->
+  Term (bv r)
+pevalDefaultBVExtendTerm signed p =
+  unaryUnfoldOnce (doPevalDefaultBVExtendTerm signed p) (bvExtendTerm signed p)
+
+-- | Unsafe version of `pevalBVExtendTerm`. Use `NatRepr` for the bit-width
+-- representations.
+unsafePevalBVExtendTerm ::
+  forall bv l r.
+  (PEvalBVTerm bv) =>
+  NatRepr l ->
+  NatRepr r ->
+  Bool ->
+  Term (bv l) ->
+  Term (bv r)
+unsafePevalBVExtendTerm lRepr rRepr signed v =
+  case (unsafeLeqProof @1 @l, unsafeLeqProof @1 @r, unsafeLeqProof @l @r) of
+    (LeqProof, LeqProof, LeqProof) ->
+      withKnownNat lRepr $
+        withKnownNat rRepr $
+          pevalBVExtendTerm signed (Proxy @r) v
+
+doPevalDefaultBVExtendTerm ::
+  forall proxy l r bv.
+  ( PEvalBVTerm bv,
+    KnownNat l,
+    KnownNat r,
+    1 <= l,
+    1 <= r,
+    l <= r,
+    Typeable bv,
+    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
+  ) =>
+  Bool ->
+  proxy r ->
+  Term (bv l) ->
+  Maybe (Term (bv r))
+doPevalDefaultBVExtendTerm signed p (ConTerm b) =
+  Just $ conTerm $ if signed then sizedBVSext p b else sizedBVZext p b
+doPevalDefaultBVExtendTerm _ _ b
+  | isJust $ sameNat (Proxy @l) (Proxy @r) =
+      Just b >>= castTerm
+doPevalDefaultBVExtendTerm False pr b =
+  case (mkPositiveNatRepr $ r - l) of
+    SomePositiveNatRepr (rplRepr :: NatRepr lpr) ->
+      Just $
+        unsafePevalBVConcatTerm
+          rplRepr
+          lRepr
+          rRepr
+          (conTerm $ sizedBVFromIntegral 0)
+          b
+  where
+    lRepr = natRepr @l
+    rRepr = natRepr @r
+    l = natVal @l (Proxy @l)
+    r = natVal @r pr
+doPevalDefaultBVExtendTerm True p (BVExtendTerm True _ (b :: Term (bv l1))) =
+  case unsafeLeqProof @l1 @r of
+    LeqProof -> Just $ pevalBVExtendTerm True p b
+doPevalDefaultBVExtendTerm _ _ _ = Nothing
+
+pevalDefaultBVConcatTerm ::
+  forall bv a b.
+  ( KnownNat a,
+    KnownNat b,
+    1 <= a,
+    1 <= b,
+    PEvalBVTerm bv,
+    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
+  ) =>
+  Term (bv a) ->
+  Term (bv b) ->
+  Term (bv (a + b))
+pevalDefaultBVConcatTerm =
+  withKnownNat (addNat (natRepr @a) (natRepr @b)) $
+    case (unsafeLeqProof @1 @(a + b)) of
+      LeqProof ->
+        binaryUnfoldOnce doPevalDefaultBVConcatTerm bvConcatTerm
+
+unsafeBVConcatTerm ::
+  forall bv n1 n2 r.
+  (PEvalBVTerm bv, forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)) =>
+  NatRepr n1 ->
+  NatRepr n2 ->
+  NatRepr r ->
+  Term (bv n1) ->
+  Term (bv n2) ->
+  Term (bv r)
+unsafeBVConcatTerm n1Repr n2Repr rRepr lhs rhs =
+  case ( unsafeAxiom :: (n1 + n2) :~: r,
+         unsafeLeqProof @1 @r,
+         unsafeLeqProof @1 @n1,
+         unsafeLeqProof @1 @n2
+       ) of
+    (Refl, LeqProof, LeqProof, LeqProof) ->
+      withKnownNat n1Repr $
+        withKnownNat n2Repr $
+          withKnownNat rRepr $
+            bvConcatTerm lhs rhs
+
+-- | Unsafe version of `pevalBVConcatTerm`. Use `NatRepr` for the bit-width
+-- representations.
+unsafePevalBVConcatTerm ::
+  forall bv n1 n2 r.
+  (PEvalBVTerm bv) =>
+  NatRepr n1 ->
+  NatRepr n2 ->
+  NatRepr r ->
+  Term (bv n1) ->
+  Term (bv n2) ->
+  Term (bv r)
+unsafePevalBVConcatTerm n1Repr n2Repr rRepr lhs rhs =
+  case ( unsafeAxiom :: (n1 + n2) :~: r,
+         unsafeLeqProof @1 @r,
+         unsafeLeqProof @1 @n1,
+         unsafeLeqProof @1 @n2
+       ) of
+    (Refl, LeqProof, LeqProof, LeqProof) ->
+      withKnownNat n1Repr $
+        withKnownNat n2Repr $
+          withKnownNat rRepr $
+            pevalBVConcatTerm lhs rhs
+
+doPevalDefaultBVConcatTerm ::
+  forall bv l r.
+  ( KnownNat l,
+    KnownNat r,
+    KnownNat (l + r),
+    1 <= l,
+    1 <= r,
+    1 <= (l + r),
+    PEvalBVTerm bv,
+    forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n)
+  ) =>
+  Term (bv l) ->
+  Term (bv r) ->
+  Maybe (Term (bv (l + r)))
+-- 1. [c1 c2] -> c1c2
+doPevalDefaultBVConcatTerm (ConTerm v) (ConTerm v') =
+  withKnownNat (addNat (natRepr @l) (natRepr @r)) $
+    Just $
+      conTerm $
+        sizedBVConcat v v'
+-- 2. [c1 (c2 ?)] -> (c1c2 ?)
+doPevalDefaultBVConcatTerm
+  (ConTerm vl)
+  (BVConcatTerm (ConTerm (vrl :: bv rl)) (rr :: Term (bv rr))) =
+    case unsafeLeqProof @1 @(l + rl) of
+      LeqProof ->
+        Just $
+          withKnownNat lRlRepr $
+            unsafeBVConcatTerm
+              lRlRepr
+              (natRepr @rr)
+              (addNat (natRepr @l) (natRepr @r))
+              (conTerm $ sizedBVConcat vl vrl)
+              rr
+    where
+      lRlRepr = addNat (natRepr @l) (natRepr @rl)
+-- 3. [c1 (s c2)] -> (c1 (s c2))
+doPevalDefaultBVConcatTerm (ConTerm {}) (BVConcatTerm _ ConTerm {}) = Nothing
+-- 4. [(c s) ?) -> (c [s ?])
+doPevalDefaultBVConcatTerm
+  (BVConcatTerm (ll@ConTerm {} :: Term (bv ll)) (lr :: Term (bv lr)))
+  r =
+    Just $ unsafeBVConcatTerm llRepr lrRRepr lRRepr ll rhs
+    where
+      llRepr = natRepr @ll
+      lrRepr = natRepr @lr
+      lRepr = natRepr @l
+      rRepr = natRepr @r
+      lrRRepr = addNat lrRepr rRepr
+      lRRepr = addNat lRepr rRepr
+      rhs :: Term (bv (lr + r))
+      rhs = unsafePevalBVConcatTerm lrRepr rRepr lrRRepr lr r
+-- 5. [? (c1 (s2 c2))] -> (([? c1] s2) c2)
+doPevalDefaultBVConcatTerm
+  l
+  ( BVConcatTerm
+      (rl@ConTerm {} :: Term (bv rl))
+      (BVConcatTerm (rrl :: Term (bv rrl)) (rrr@ConTerm {} :: Term (bv rrr)))
+    ) =
+    Just $ unsafeBVConcatTerm lRlRrlRepr rrrRepr lRRepr lRlRrl rrr
+    where
+      lRepr = natRepr @l
+      rlRepr = natRepr @rl
+      rrlRepr = natRepr @rrl
+      rrrRepr = natRepr @rrr
+      lRlRepr = addNat lRepr rlRepr
+      rRepr = natRepr @r
+      lRRepr = addNat lRepr rRepr
+      lRl = unsafePevalBVConcatTerm lRepr rlRepr lRlRepr l rl
+      lRlRrlRepr = addNat lRlRepr rrlRepr
+      lRlRrl = unsafeBVConcatTerm lRlRepr rrlRepr lRlRrlRepr lRl rrl
+-- 6. [(s1 c1) c2] -> (s1 c1c2)
+doPevalDefaultBVConcatTerm
+  (BVConcatTerm (ll :: Term (bv ll)) ((ConTerm vlr) :: Term (bv lr)))
+  (ConTerm vr) =
+    Just $ unsafeBVConcatTerm llRepr lrRRepr lRRepr ll rhs
+    where
+      llRepr = natRepr @ll
+      lrRepr = natRepr @lr
+      lRepr = natRepr @l
+      rRepr = natRepr @r
+      lrRRepr = addNat lrRepr rRepr
+      lRRepr = addNat lRepr rRepr
+      rhs :: Term (bv (lr + r))
+      rhs = case unsafeLeqProof @1 @(lr + r) of
+        LeqProof ->
+          withKnownNat lrRRepr $ conTerm $ sizedBVConcat vlr vr
+-- 7. [(s1 c1) (c2 s2)] -> (s1 (c1c2 s2))
+doPevalDefaultBVConcatTerm
+  (BVConcatTerm (ll :: Term (bv ll)) ((ConTerm vlr) :: Term (bv lr)))
+  (BVConcatTerm ((ConTerm vrl) :: Term (bv rl)) (rr :: Term (bv rr))) =
+    Just $ unsafeBVConcatTerm llRepr lrRlRrRepr lRRepr ll lrRlRR
+    where
+      lRepr = natRepr @l
+      rRepr = natRepr @r
+      llRepr = natRepr @ll
+      lrRepr = natRepr @lr
+      rlRepr = natRepr @rl
+      rrRepr = natRepr @rr
+      lRRepr = addNat lRepr rRepr
+      lrRlRepr :: NatRepr (lr + rl)
+      lrRlRepr = addNat lrRepr rlRepr
+      lrRlRrRepr :: NatRepr ((lr + rl) + rr)
+      lrRlRrRepr = addNat lrRlRepr rrRepr
+      lrRl :: Term (bv (lr + rl))
+      lrRl = case unsafeLeqProof @1 @(lr + rl) of
+        LeqProof -> withKnownNat lrRlRepr $ conTerm $ sizedBVConcat vlr vrl
+      lrRlRR :: Term (bv ((lr + rl) + rr))
+      lrRlRR = unsafeBVConcatTerm lrRlRepr rrRepr lrRlRrRepr lrRl rr
+-- 8. [?notc (s2 c)] -> ((s1 s2) c)
+doPevalDefaultBVConcatTerm
+  l
+  (BVConcatTerm (rl :: Term (bv rl)) (rr@ConTerm {} :: Term (bv rr))) =
+    Just $
+      unsafeBVConcatTerm
+        lRlRepr
+        (natRepr @rr)
+        (addNat (natRepr @l) (natRepr @r))
+        lhs
+        rr
+    where
+      lRepr = natRepr @l
+      rlRepr = natRepr @rl
+      lRlRepr = addNat lRepr rlRepr
+      lhs :: Term (bv (l + rl))
+      lhs = unsafeBVConcatTerm lRepr rlRepr lRlRepr l rl
+doPevalDefaultBVConcatTerm
+  (BVSelectTerm ix0 (_ :: p w0) (bv0 :: Term (bv n)))
+  (BVSelectTerm (ix1 :: p ix1) (w1 :: p w1) (DynTerm (bv1 :: Term (bv n))))
+    | ix1v + w1v == ix0v && bv0 == bv1 =
+        Just $ unsafePevalBVSelectTerm nRepr ix1Repr (addNat w0Repr w1Repr) bv0
+    where
+      nRepr = natRepr @n
+      w1v = natVal w1
+      ix0v = natVal ix0
+      ix1v = natVal ix1
+      ix1Repr = natRepr @ix1
+      w0Repr = natRepr @w0
+      w1Repr = natRepr @w1
+doPevalDefaultBVConcatTerm _ _ = Nothing
+
+instance PEvalBVTerm WordN where
+  pevalBVSelectTerm = pevalDefaultBVSelectTerm @IntN
+  pevalBVConcatTerm = pevalDefaultBVConcatTerm
+  pevalBVExtendTerm = pevalDefaultBVExtendTerm
+  sbvBVConcatTerm pl pr l r =
+    bvIsNonZeroFromGEq1 pl $
+      bvIsNonZeroFromGEq1 pr $
+        l SBV.# r
+  sbvBVSelectTerm (pix :: p0 ix) (pw :: p1 w) (pn :: p2 n) bv =
+    bvIsNonZeroFromGEq1 (Proxy @n) $
+      bvIsNonZeroFromGEq1 (Proxy @w) $
+        sbvDefaultBVSelectTerm pix pw pn bv
+  sbvBVExtendTerm (_ :: p0 l) (_ :: p1 r) signed bv =
+    withKnownProof
+      (unsafeKnownProof @(r - l) (natVal (Proxy @r) - natVal (Proxy @l)))
+      $ case (unsafeLeqProof @(l + 1) @r, unsafeLeqProof @1 @(r - l)) of
+        (LeqProof, LeqProof) ->
+          bvIsNonZeroFromGEq1 (Proxy @r) $
+            bvIsNonZeroFromGEq1 (Proxy @l) $
+              bvIsNonZeroFromGEq1 (Proxy @(r - l)) $
+                if signed then SBV.signExtend bv else SBV.zeroExtend bv
+
+instance PEvalBVTerm IntN where
+  pevalBVSelectTerm = pevalDefaultBVSelectTerm @WordN
+  pevalBVConcatTerm = pevalDefaultBVConcatTerm
+  pevalBVExtendTerm = pevalDefaultBVExtendTerm
+  sbvBVConcatTerm (pl :: p l) (pr :: q r) l r =
+    bvIsNonZeroFromGEq1 pl $
+      bvIsNonZeroFromGEq1 pr $
+        withKnownNat (addNat (natRepr @l) (natRepr @r)) $
+          case unsafeLeqProof @1 @(l + r) of
+            LeqProof ->
+              bvIsNonZeroFromGEq1 (Proxy @(l + r)) $
+                sbvBitCast @(WordN (l + r)) @(IntN (l + r)) $
+                  (sbvBitCast @(IntN l) @(WordN l) l)
+                    SBV.# (sbvBitCast @(IntN r) @(WordN r) r)
+  sbvBVSelectTerm (pix :: p0 ix) (pw :: p1 w) (pn :: p2 n) bv =
+    bvIsNonZeroFromGEq1 (Proxy @n) $
+      bvIsNonZeroFromGEq1 (Proxy @w) $
+        sbvDefaultBVSelectTerm pix pw pn bv
+  sbvBVExtendTerm (_ :: p0 l) (_ :: p1 r) signed bv =
+    withKnownProof
+      (unsafeKnownProof @(r - l) (natVal (Proxy @r) - natVal (Proxy @l)))
+      $ case (unsafeLeqProof @(l + 1) @r, unsafeLeqProof @1 @(r - l)) of
+        (LeqProof, LeqProof) ->
+          bvIsNonZeroFromGEq1 (Proxy @r) $
+            bvIsNonZeroFromGEq1 (Proxy @l) $
+              bvIsNonZeroFromGEq1 (Proxy @(r - l)) $
+                if signed
+                  then SBV.signExtend bv
+                  else
+                    SBV.sFromIntegral
+                      ( SBV.zeroExtend
+                          (SBV.sFromIntegral bv :: SBV.SBV (SBV.WordN l)) ::
+                          SBV.SBV (SBV.WordN r)
+                      )
+
+sbvDefaultBVSelectTerm ::
+  ( KnownNat ix,
+    KnownNat w,
+    KnownNat n,
+    1 <= n,
+    1 <= w,
+    (ix + w) <= n,
+    SBV.SymVal (bv n)
+  ) =>
+  p1 ix ->
+  p2 w ->
+  p3 n ->
+  SBV.SBV (bv n) ->
+  SBV.SBV (bv w)
+sbvDefaultBVSelectTerm (_ :: p0 ix) (_ :: p1 w) (_ :: p2 n) bv =
+  withKnownProof
+    ( unsafeKnownProof @(w + ix - 1)
+        (natVal (Proxy @w) + natVal (Proxy @ix) - 1)
+    )
+    $ case ( unsafeAxiom @(w + ix - 1 - ix + 1) @w,
+             unsafeLeqProof @(((w + ix) - 1) + 1) @n,
+             unsafeLeqProof @ix @(w + ix - 1)
+           ) of
+      (Refl, LeqProof, LeqProof) ->
+        bvIsNonZeroFromGEq1 (Proxy @n) $
+          bvIsNonZeroFromGEq1 (Proxy @w) $
+            SBV.bvExtract (Proxy @(w + ix - 1)) (Proxy @ix) bv
+
+doPevalBitCastSameType ::
+  forall x b. (SupportedPrim b) => Term x -> Maybe (Term b)
+doPevalBitCastSameType (BitCastTerm (DynTerm (b :: Term b))) = Just b
+doPevalBitCastSameType (BitCastTerm x) = doPevalBitCastSameType x
+doPevalBitCastSameType _ = Nothing
+
+-- | Partially evaluate a bitcast term. If no reduction is performed, return
+-- Nothing.
+doPevalBitCast :: (PEvalBitCastTerm a b, SupportedPrim b) => Term a -> Maybe (Term b)
+doPevalBitCast (ConTerm v) = Just $ conTerm $ bitCast v
+doPevalBitCast t = doPevalBitCastSameType t
+
+instance (KnownNat n, 1 <= n) => PEvalBitCastTerm (WordN n) (IntN n) where
+  pevalBitCastTerm = unaryUnfoldOnce doPevalBitCastBV bitCastTerm
+    where
+      doPevalBitCastBV :: Term (WordN n) -> Maybe (Term (IntN n))
+      doPevalBitCastBV
+        (BVConcatTerm (l :: Term (WordN l)) (r :: Term (WordN r))) =
+          Just $
+            pevalBVConcatTerm
+              (pevalBitCastTerm @(WordN l) @(IntN l) l)
+              (pevalBitCastTerm @(WordN r) @(IntN r) r)
+      doPevalBitCastBV (BVExtendTerm signed pr (b :: Term (WordN l))) =
+        Just $
+          pevalBVExtendTerm signed pr $
+            pevalBitCastTerm @(WordN l) @(IntN l) b
+      doPevalBitCastBV v = doPevalBitCast v
+  sbvBitCast = bvIsNonZeroFromGEq1 (Proxy @n) SBV.sFromIntegral
+
+instance (KnownNat n, 1 <= n) => PEvalBitCastTerm (IntN n) (WordN n) where
+  pevalBitCastTerm = unaryUnfoldOnce doPevalBitCastBV bitCastTerm
+    where
+      doPevalBitCastBV :: Term (IntN n) -> Maybe (Term (WordN n))
+      doPevalBitCastBV
+        (BVConcatTerm (l :: Term (IntN l)) (r :: Term (IntN r))) =
+          Just $
+            pevalBVConcatTerm
+              (pevalBitCastTerm @(IntN l) @(WordN l) l)
+              (pevalBitCastTerm @(IntN r) @(WordN r) r)
+      doPevalBitCastBV (BVExtendTerm signed pr (b :: Term (IntN l))) =
+        Just $
+          pevalBVExtendTerm signed pr $
+            pevalBitCastTerm @(IntN l) @(WordN l) b
+      doPevalBitCastBV v = doPevalBitCast v
+  sbvBitCast = bvIsNonZeroFromGEq1 (Proxy @n) SBV.sFromIntegral
+
+-- Num
+
+-- | Default partial evaluation of addition of numerical terms.
+pevalDefaultAddNumTerm :: (PEvalNumTerm a, Eq a) => Term a -> Term a -> Term a
+pevalDefaultAddNumTerm l@SupportedTerm r =
+  binaryUnfoldOnce
+    doPevalDefaultAddNumTerm
+    (\a b -> normalizeAddNum $ addNumTerm a b)
+    l
+    r
+
+doPevalDefaultAddNumTerm ::
+  (PEvalNumTerm a, Eq a) => Term a -> Term a -> Maybe (Term a)
+doPevalDefaultAddNumTerm (ConTerm a) (ConTerm b) = Just $ conTerm $ a + b
+doPevalDefaultAddNumTerm l@(ConTerm a) b = case (a, b) of
+  (0, k) -> Just k
+  (l1, AddNumTerm (ConTerm j) k) ->
+    Just $ pevalAddNumTerm (conTerm $ l1 + j) k
+  _ -> doPevalDefaultAddNumTermNoCon l b
+doPevalDefaultAddNumTerm a r@(ConTerm {}) = doPevalDefaultAddNumTerm r a
+doPevalDefaultAddNumTerm l r = doPevalDefaultAddNumTermNoCon l r
+
+doPevalDefaultAddNumTermNoCon ::
+  (PEvalNumTerm a) => Term a -> Term a -> Maybe (Term a)
+doPevalDefaultAddNumTermNoCon (AddNumTerm i@ConTerm {} j) k =
+  Just $ pevalAddNumTerm i $ pevalAddNumTerm j k
+doPevalDefaultAddNumTermNoCon i (AddNumTerm j@ConTerm {} k) =
+  Just $ pevalAddNumTerm j $ pevalAddNumTerm i k
+doPevalDefaultAddNumTermNoCon (NegNumTerm i) (NegNumTerm j) =
+  Just $ pevalNegNumTerm $ pevalAddNumTerm i j
+doPevalDefaultAddNumTermNoCon
+  (MulNumTerm (ConTerm i) j)
+  (MulNumTerm (ConTerm k) l)
+    | j == l = Just $ pevalMulNumTerm (conTerm $ i + k) j
+doPevalDefaultAddNumTermNoCon
+  (MulNumTerm i@ConTerm {} j)
+  (MulNumTerm k@(ConTerm {}) l)
+    | i == k = Just $ pevalMulNumTerm i (pevalAddNumTerm j l)
+doPevalDefaultAddNumTermNoCon _ _ = Nothing
+
+normalizeAddNum :: (PEvalNumTerm a) => Term a -> Term a
+normalizeAddNum (AddNumTerm l r@(ConTerm {})) = addNumTerm r l
+normalizeAddNum v = v
+
+-- | Default partial evaluation of negation of numerical terms.
+pevalDefaultNegNumTerm :: (PEvalNumTerm a, Eq a) => Term a -> Term a
+pevalDefaultNegNumTerm l@SupportedTerm =
+  unaryUnfoldOnce doPevalDefaultNegNumTerm negNumTerm l
+
+doPevalDefaultNegNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
+doPevalDefaultNegNumTerm (ConTerm a) = Just $ conTerm $ -a
+doPevalDefaultNegNumTerm (NegNumTerm v) = Just v
+doPevalDefaultNegNumTerm (AddNumTerm (ConTerm l) r) =
+  Just $ pevalSubNumTerm (conTerm $ -l) r
+doPevalDefaultNegNumTerm (AddNumTerm (NegNumTerm l) r) =
+  Just $ pevalAddNumTerm l (pevalNegNumTerm r)
+doPevalDefaultNegNumTerm (AddNumTerm l (NegNumTerm r)) =
+  Just $ pevalAddNumTerm (pevalNegNumTerm l) r
+doPevalDefaultNegNumTerm (MulNumTerm (ConTerm l) r) =
+  Just $ pevalMulNumTerm (conTerm $ -l) r
+doPevalDefaultNegNumTerm (MulNumTerm (NegNumTerm {}) _) =
+  error "Should not happen"
+doPevalDefaultNegNumTerm (MulNumTerm _ (NegNumTerm {})) =
+  error "Should not happen"
+doPevalDefaultNegNumTerm (AddNumTerm _ ConTerm {}) = error "Should not happen"
+doPevalDefaultNegNumTerm _ = Nothing
+
+-- Mul
+
+-- | Default partial evaluation of multiplication of numerical terms.
+pevalDefaultMulNumTerm :: (PEvalNumTerm a, Eq a) => Term a -> Term a -> Term a
+pevalDefaultMulNumTerm l@SupportedTerm r =
+  binaryUnfoldOnce
+    doPevalDefaultMulNumTerm
+    (\a b -> normalizeMulNum $ mulNumTerm a b)
+    l
+    r
+
+normalizeMulNum :: (PEvalNumTerm a) => Term a -> Term a
+normalizeMulNum (MulNumTerm l r@(ConTerm {})) = mulNumTerm r l
+normalizeMulNum v = v
+
+doPevalDefaultMulNumTerm ::
+  (PEvalNumTerm a, Eq a) => Term a -> Term a -> Maybe (Term a)
+doPevalDefaultMulNumTerm (ConTerm a) (ConTerm b) =
+  Just $ conTerm $ a * b
+doPevalDefaultMulNumTerm l@(ConTerm a) b = case (a, b) of
+  (0, _) -> Just $ conTerm 0
+  (1, k) -> Just k
+  (-1, k) -> Just $ pevalNegNumTerm k
+  (l1, MulNumTerm (ConTerm j) k) ->
+    Just $ pevalMulNumTerm (conTerm $ l1 * j) k
+  (l1, AddNumTerm (ConTerm j) k) ->
+    Just $ pevalAddNumTerm (conTerm $ l1 * j) (pevalMulNumTerm (conTerm l1) k)
+  (l1, NegNumTerm j) -> Just (pevalMulNumTerm (conTerm $ -l1) j)
+  (_, MulNumTerm _ ConTerm {}) -> error "Should not happen"
+  (_, AddNumTerm _ ConTerm {}) -> error "Should not happen"
+  _ -> doPevalDefaultMulNumTermNoCon l b
+doPevalDefaultMulNumTerm a r@(ConTerm {}) = doPevalDefaultMulNumTerm r a
+doPevalDefaultMulNumTerm l r = doPevalDefaultMulNumTermNoCon l r
+
+doPevalDefaultMulNumTermNoCon ::
+  (PEvalNumTerm a) => Term a -> Term a -> Maybe (Term a)
+doPevalDefaultMulNumTermNoCon (MulNumTerm i@ConTerm {} j) k =
+  Just $ pevalMulNumTerm i $ pevalMulNumTerm j k
+doPevalDefaultMulNumTermNoCon i (MulNumTerm j@ConTerm {} k) =
+  Just $ pevalMulNumTerm j $ pevalMulNumTerm i k
+doPevalDefaultMulNumTermNoCon (NegNumTerm i) j =
+  Just $ pevalNegNumTerm $ pevalMulNumTerm i j
+doPevalDefaultMulNumTermNoCon i (NegNumTerm j) =
+  Just $ pevalNegNumTerm $ pevalMulNumTerm i j
+doPevalDefaultMulNumTermNoCon i j@ConTerm {} = Just $ pevalMulNumTerm j i
+doPevalDefaultMulNumTermNoCon (MulNumTerm _ ConTerm {}) _ =
+  error "Should not happen"
+doPevalDefaultMulNumTermNoCon _ (MulNumTerm _ ConTerm {}) =
+  error "Should not happen"
+doPevalDefaultMulNumTermNoCon _ _ = Nothing
+
+-- Abs
+
+-- | Default partial evaluation of absolute value of finite-bit numerical terms.
+pevalBitsAbsNumTerm :: (PEvalNumTerm a, Bits a) => Term a -> Term a
+pevalBitsAbsNumTerm l@SupportedTerm =
+  unaryUnfoldOnce doPevalBitsAbsNumTerm absNumTerm l
+
+doPevalGeneralAbsNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
+doPevalGeneralAbsNumTerm (ConTerm a) = Just $ conTerm $ abs a
+doPevalGeneralAbsNumTerm (NegNumTerm v) = Just $ pevalAbsNumTerm v
+doPevalGeneralAbsNumTerm t@(AbsNumTerm {}) = Just t
+doPevalGeneralAbsNumTerm _ = Nothing
+
+doPevalBitsAbsNumTerm ::
+  forall a. (PEvalNumTerm a, Bits a) => Term a -> Maybe (Term a)
+doPevalBitsAbsNumTerm t =
+  msum
+    [ if isSigned (undefined :: a) then Nothing else Just t,
+      doPevalGeneralAbsNumTerm t
+    ]
+
+-- | Partial evaluation of absolute value of numerical terms that does not
+-- overflow.
+doPevalNoOverflowAbsNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
+doPevalNoOverflowAbsNumTerm t =
+  msum
+    [ doPevalGeneralAbsNumTerm t,
+      case t of
+        MulNumTerm l r ->
+          Just $ pevalMulNumTerm (pevalAbsNumTerm l) $ pevalAbsNumTerm r
+        _ -> Nothing
+    ]
+
+-- Signum
+
+-- | Default partial evaluation of signum of numerical terms.
+pevalGeneralSignumNumTerm :: (PEvalNumTerm a) => Term a -> Term a
+pevalGeneralSignumNumTerm l@SupportedTerm =
+  unaryUnfoldOnce doPevalGeneralSignumNumTerm signumNumTerm l
+
+doPevalGeneralSignumNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
+doPevalGeneralSignumNumTerm (ConTerm a) = Just $ conTerm $ signum a
+doPevalGeneralSignumNumTerm _ = Nothing
+
+-- | Partial evaluation of signum of numerical terms that does not overflow.
+doPevalNoOverflowSignumNumTerm :: (PEvalNumTerm a) => Term a -> Maybe (Term a)
+doPevalNoOverflowSignumNumTerm t =
+  msum
+    [ doPevalGeneralSignumNumTerm t,
+      case t of
+        NegNumTerm v -> Just $ pevalNegNumTerm $ pevalSignumNumTerm v
+        MulNumTerm l r ->
+          Just $
+            pevalMulNumTerm (pevalSignumNumTerm l) $
+              pevalSignumNumTerm r
+        _ -> Nothing
+    ]
+
+instance (KnownNat n, 1 <= n) => PEvalNumTerm (WordN n) where
+  pevalAddNumTerm = pevalDefaultAddNumTerm
+  pevalNegNumTerm = pevalDefaultNegNumTerm
+  pevalMulNumTerm = pevalDefaultMulNumTerm
+  pevalAbsNumTerm = pevalBitsAbsNumTerm
+  pevalSignumNumTerm = pevalGeneralSignumNumTerm
+  withSbvNumTermConstraint r = withPrim @(WordN n) r
+
+instance (KnownNat n, 1 <= n) => PEvalNumTerm (IntN n) where
+  pevalAddNumTerm = pevalDefaultAddNumTerm
+  pevalNegNumTerm = pevalDefaultNegNumTerm
+  pevalMulNumTerm = pevalDefaultMulNumTerm
+  pevalAbsNumTerm = pevalBitsAbsNumTerm
+  pevalSignumNumTerm = pevalGeneralSignumNumTerm
+  withSbvNumTermConstraint r = withPrim @(IntN n) r
+
+-- Partial evaluation
+
+-- | A partial function from a to b.
+type PartialFun a b = a -> Maybe b
+
+-- | A partial rule for unary operations.
+type PartialRuleUnary a b = PartialFun (Term a) (Term b)
+
+-- | A total rule for unary operations.
+type TotalRuleUnary a b = Term a -> Term b
+
+-- | A partial rule for binary operations.
+type PartialRuleBinary a b c = Term a -> PartialFun (Term b) (Term c)
+
+-- | A total rule for binary operations.
+type TotalRuleBinary a b c = Term a -> Term b -> Term c
+
+-- | Totalize a partial function with a fallback function.
+totalize :: PartialFun a b -> (a -> b) -> a -> b
+totalize partial fallback a =
+  case partial a of
+    Just b -> b
+    Nothing -> fallback a
+
+-- | Totalize a binary partial function with a fallback function.
+totalize2 :: (a -> PartialFun b c) -> (a -> b -> c) -> a -> b -> c
+totalize2 partial fallback a b =
+  case partial a b of
+    Just c -> c
+    Nothing -> fallback a b
+
+-- | A strategy for partially evaluating unary operations.
+class UnaryPartialStrategy tag a b | tag a -> b where
+  extractor :: tag -> Term a -> Maybe a
+  constantHandler :: tag -> a -> Maybe (Term b)
+  nonConstantHandler :: tag -> Term a -> Maybe (Term b)
+
+-- | Partially evaluate a unary operation.
+unaryPartial :: forall tag a b. (UnaryPartialStrategy tag a b) => tag -> PartialRuleUnary a b
+unaryPartial tag a = case extractor tag a of
+  Nothing -> nonConstantHandler tag a
+  Just a' -> constantHandler tag a'
+
+-- | A strategy for partially evaluating commutative binary operations.
+class BinaryCommPartialStrategy tag a c | tag a -> c where
+  singleConstantHandler :: tag -> a -> Term a -> Maybe (Term c)
+
+-- | A strategy for partially evaluating operations.
+class BinaryPartialStrategy tag a b c | tag a b -> c where
+  extractora :: tag -> Term a -> Maybe a
+  extractorb :: tag -> Term b -> Maybe b
+  allConstantHandler :: tag -> a -> b -> Maybe (Term c)
+  leftConstantHandler :: tag -> a -> Term b -> Maybe (Term c)
+  default leftConstantHandler :: (a ~ b, BinaryCommPartialStrategy tag a c) => tag -> a -> Term b -> Maybe (Term c)
+  leftConstantHandler = singleConstantHandler @tag @a
+  rightConstantHandler :: tag -> Term a -> b -> Maybe (Term c)
+  default rightConstantHandler :: (a ~ b, BinaryCommPartialStrategy tag a c) => tag -> Term a -> b -> Maybe (Term c)
+  rightConstantHandler tag = flip $ singleConstantHandler @tag @a tag
+  nonBinaryConstantHandler :: tag -> Term a -> Term b -> Maybe (Term c)
+
+-- | Partially evaluate a binary operation.
+binaryPartial :: forall tag a b c. (BinaryPartialStrategy tag a b c) => tag -> PartialRuleBinary a b c
+binaryPartial tag a b = case (extractora @tag @a @b @c tag a, extractorb @tag @a @b @c tag b) of
+  (Nothing, Nothing) -> nonBinaryConstantHandler @tag @a @b @c tag a b
+  (Just a', Nothing) ->
+    leftConstantHandler @tag @a @b @c tag a' b
+      `catchError` \_ -> nonBinaryConstantHandler @tag @a @b @c tag a b
+  (Nothing, Just b') ->
+    rightConstantHandler @tag @a @b @c tag a b'
+      `catchError` \_ -> nonBinaryConstantHandler @tag @a @b @c tag a b
+  (Just a', Just b') ->
+    allConstantHandler @tag @a @b @c tag a' b'
+
+unaryPartialUnfoldOnce ::
+  forall a b.
+  (SupportedPrim b) =>
+  PartialRuleUnary a b ->
+  TotalRuleUnary a b ->
+  PartialRuleUnary a b
+unaryPartialUnfoldOnce partial fallback = ret
+  where
+    oneLevel :: TotalRuleUnary a b -> PartialRuleUnary a b
+    oneLevel fallback' x = case (x, partial x) of
+      (ITETerm cond vt vf, pr) ->
+        let pt = partial vt
+            pf = partial vf
+         in case (pt, pf) of
+              (Nothing, Nothing) -> pr
+              (mt, mf) ->
+                pevalITETerm cond
+                  <$> catchError mt (\_ -> Just $ totalize (oneLevel fallback') fallback' vt)
+                  <*> catchError mf (\_ -> Just $ totalize (oneLevel fallback') fallback vf)
+      (_, pr) -> pr
+    ret :: PartialRuleUnary a b
+    ret = oneLevel (totalize @(Term a) @(Term b) partial fallback)
+
+-- | Unfold a unary operation once.
+unaryUnfoldOnce ::
+  forall a b.
+  (SupportedPrim b) =>
+  PartialRuleUnary a b ->
+  TotalRuleUnary a b ->
+  TotalRuleUnary a b
+unaryUnfoldOnce partial fallback = totalize (unaryPartialUnfoldOnce partial fallback) fallback
+
+binaryPartialUnfoldOnce ::
+  forall a b c.
+  (SupportedPrim c) =>
+  PartialRuleBinary a b c ->
+  TotalRuleBinary a b c ->
+  PartialRuleBinary a b c
+binaryPartialUnfoldOnce partial fallback = ret
+  where
+    oneLevel :: PartialRuleBinary x y c -> TotalRuleBinary x y c -> PartialRuleBinary x y c
+    oneLevel partial' fallback' x y =
+      catchError
+        (partial' x y)
+        ( \_ ->
+            case (x, y) of
+              (ITETerm _ ITETerm {} _, ITETerm {}) -> Nothing
+              (ITETerm _ _ ITETerm {}, ITETerm {}) -> Nothing
+              (ITETerm {}, ITETerm _ ITETerm {} _) -> Nothing
+              (ITETerm {}, ITETerm _ _ ITETerm {}) -> Nothing
+              (ITETerm cond vt vf, _) ->
+                left cond vt vf y partial' fallback'
+              (_, ITETerm cond vt vf) ->
+                left cond vt vf x (flip partial') (flip fallback')
+              _ -> Nothing
+        )
+    left ::
+      Term Bool ->
+      Term x ->
+      Term x ->
+      Term y ->
+      PartialRuleBinary x y c ->
+      TotalRuleBinary x y c ->
+      Maybe (Term c)
+    left cond vt vf y partial' fallback' =
+      let pt = partial' vt y
+          pf = partial' vf y
+       in case (pt, pf) of
+            (Nothing, Nothing) -> Nothing
+            (mt, mf) ->
+              pevalITETerm cond
+                <$> catchError mt (\_ -> Just $ totalize2 (oneLevel partial' fallback') fallback' vt y)
+                <*> catchError mf (\_ -> Just $ totalize2 (oneLevel partial' fallback') fallback' vf y)
+    ret :: PartialRuleBinary a b c
+    ret = oneLevel partial (totalize2 @(Term a) @(Term b) @(Term c) partial fallback)
+
+-- | Unfold a binary operation once.
+binaryUnfoldOnce ::
+  forall a b c.
+  (SupportedPrim c) =>
+  PartialRuleBinary a b c ->
+  TotalRuleBinary a b c ->
+  TotalRuleBinary a b c
+binaryUnfoldOnce partial fallback = totalize2 (binaryPartialUnfoldOnce partial fallback) fallback
+
+-- | Unfold a unary operation once.
+generalUnaryUnfolded ::
+  forall a b.
+  (Typeable a, SupportedPrim b) =>
+  (a -> b) ->
+  (Term a -> Term b) ->
+  Term a ->
+  Term b
+generalUnaryUnfolded compute =
+  unaryUnfoldOnce
+    ( \case
+        ConTerm lv -> Just $ conTerm $ compute lv
+        _ -> Nothing
+    )
+
+-- | Unfold a binary operation once.
+generalBinaryUnfolded ::
+  forall a b c.
+  (Typeable a, Typeable b, SupportedPrim c) =>
+  (a -> b -> c) ->
+  (Term a -> Term b -> Term c) ->
+  Term a ->
+  Term b ->
+  Term c
+generalBinaryUnfolded compute =
+  binaryUnfoldOnce
+    ( \l r -> case (l, r) of
+        (ConTerm lv, ConTerm rv) -> Just $ conTerm $ compute lv rv
+        _ -> Nothing
+    )
diff --git a/src/Grisette/Internal/SymPrim/Prim/Internal/Unfold.hs b/src/Grisette/Internal/SymPrim/Prim/Internal/Unfold.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Internal/Unfold.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Internal/Unfold.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -31,8 +32,10 @@
   )
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( SupportedPrim (pevalITETerm),
-    Term (ConTerm, ITETerm),
+    Term,
     conTerm,
+    pattern ConTerm,
+    pattern ITETerm,
   )
 
 unaryPartialUnfoldOnce ::
@@ -45,7 +48,7 @@
   where
     oneLevel :: TotalRuleUnary a b -> PartialRuleUnary a b
     oneLevel fallback' x = case (x, partial x) of
-      (ITETerm _ _ _ _ cond vt vf, pr) ->
+      (ITETerm cond vt vf, pr) ->
         let pt = partial vt
             pf = partial vf
          in case (pt, pf) of
@@ -81,13 +84,13 @@
         (partial' x y)
         ( \_ ->
             case (x, y) of
-              (ITETerm _ _ _ _ _ ITETerm {} _, ITETerm {}) -> Nothing
-              (ITETerm _ _ _ _ _ _ ITETerm {}, ITETerm {}) -> Nothing
-              (ITETerm {}, ITETerm _ _ _ _ _ ITETerm {} _) -> Nothing
-              (ITETerm {}, ITETerm _ _ _ _ _ _ ITETerm {}) -> Nothing
-              (ITETerm _ _ _ _ cond vt vf, _) ->
+              (ITETerm _ ITETerm {} _, ITETerm {}) -> Nothing
+              (ITETerm _ _ ITETerm {}, ITETerm {}) -> Nothing
+              (ITETerm {}, ITETerm _ ITETerm {} _) -> Nothing
+              (ITETerm {}, ITETerm _ _ ITETerm {}) -> Nothing
+              (ITETerm cond vt vf, _) ->
                 left cond vt vf y partial' fallback'
-              (_, ITETerm _ _ _ _ cond vt vf) ->
+              (_, ITETerm cond vt vf) ->
                 left cond vt vf x (flip partial') (flip fallback')
               _ -> Nothing
         )
@@ -131,7 +134,7 @@
 generalUnaryUnfolded compute =
   unaryUnfoldOnce
     ( \case
-        ConTerm _ _ _ _ lv -> Just $ conTerm $ compute lv
+        ConTerm lv -> Just $ conTerm $ compute lv
         _ -> Nothing
     )
 
@@ -147,6 +150,6 @@
 generalBinaryUnfolded compute =
   binaryUnfoldOnce
     ( \l r -> case (l, r) of
-        (ConTerm _ _ _ _ lv, ConTerm _ _ _ _ rv) -> Just $ conTerm $ compute lv rv
+        (ConTerm lv, ConTerm rv) -> Just $ conTerm $ compute lv rv
         _ -> Nothing
     )
diff --git a/src/Grisette/Internal/SymPrim/Prim/Model.hs b/src/Grisette/Internal/SymPrim/Prim/Model.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Model.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Model.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -90,7 +91,7 @@
     symTerm,
     toModelValue,
     unsafeFromModelValue,
-    withSymbolSupported,
+    pattern SupportedTypedSymbol,
   )
 import Language.Haskell.TH.Syntax (Lift)
 
@@ -179,7 +180,7 @@
 -- | Given a typed symbol and a model, return the equation (symbol = value)
 -- encoded in the model.
 equation :: TypedAnySymbol a -> Model -> Maybe (Term Bool)
-equation tsym m = withSymbolSupported tsym $
+equation tsym@SupportedTypedSymbol m =
   case valueOf tsym m of
     Just v -> Just $ pevalEqTerm (symTerm tsym) (conTerm v)
     Nothing -> Nothing
@@ -363,10 +364,8 @@
   emptyModel = Model M.empty
   isEmptyModel (Model m) = M.null m
   valueOf :: forall t. TypedAnySymbol t -> Model -> Maybe t
-  valueOf sym (Model m) =
-    withSymbolSupported sym $
-      (unsafeFromModelValue @t)
-        <$> M.lookup (someTypedSymbol sym) m
+  valueOf sym@SupportedTypedSymbol (Model m) =
+    (unsafeFromModelValue @t) <$> M.lookup (someTypedSymbol sym) m
   modelContains sym (Model m) = M.member (someTypedSymbol sym) m
   exceptFor (SymbolSet s) (Model m) = Model $ S.foldl' (flip M.delete) m s
   exceptFor' s (Model m) = Model $ M.delete (someTypedSymbol s) m
@@ -382,16 +381,16 @@
   extendTo (SymbolSet s) (Model m) =
     Model $
       S.foldl'
-        ( \acc sym@(SomeTypedSymbol (tsym :: TypedAnySymbol t)) -> case M.lookup sym acc of
-            Just _ -> acc
-            Nothing -> withSymbolSupported tsym $ M.insert sym (defaultValueDynamic (Proxy @t)) acc
+        ( \acc
+           sym@(SomeTypedSymbol (SupportedTypedSymbol :: TypedAnySymbol t)) ->
+              case M.lookup sym acc of
+                Just _ -> acc
+                Nothing -> M.insert sym (defaultValueDynamic (Proxy @t)) acc
         )
         m
         s
-  insertValue sym (v :: t) (Model m) =
-    withSymbolSupported sym $
-      Model $
-        M.insert (someTypedSymbol sym) (toModelValue v) m
+  insertValue sym@SupportedTypedSymbol (v :: t) (Model m) =
+    Model $ M.insert (someTypedSymbol sym) (toModelValue v) m
 
 -- | Evaluate a term in the given model.
 evalTerm ::
@@ -403,15 +402,14 @@
   Term a
 evalTerm fillDefault (Model ma) =
   generalSubstSomeTerm
-    ( \(sym :: TypedSymbol 'AnyKind a) ->
-        withSymbolSupported sym $
-          case (M.lookup (someTypedSymbol sym) ma) of
-            Nothing ->
-              if fillDefault
-                then conTerm (defaultValue @a)
-                else symTerm sym
-            Just dy ->
-              conTerm (unsafeFromModelValue @a dy)
+    ( \(sym@SupportedTypedSymbol :: TypedSymbol 'AnyKind a) ->
+        case (M.lookup (someTypedSymbol sym) ma) of
+          Nothing ->
+            if fillDefault
+              then conTerm (defaultValue @a)
+              else symTerm sym
+          Just dy ->
+            conTerm (unsafeFromModelValue @a dy)
     )
 
 -- |
diff --git a/src/Grisette/Internal/SymPrim/Prim/Pattern.hs b/src/Grisette/Internal/SymPrim/Prim/Pattern.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/SymPrim/Prim/Pattern.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- |
+-- Module      :   Grisette.Internal.SymPrim.Prim.Pattern
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.SymPrim.Prim.Pattern
+  ( pattern SubTerms,
+  )
+where
+
+import Data.Foldable (Foldable (toList))
+import Grisette.Internal.SymPrim.Prim.Internal.Term
+  ( Term,
+    pattern AbsNumTerm,
+    pattern AddNumTerm,
+    pattern AndBitsTerm,
+    pattern AndTerm,
+    pattern ApplyTerm,
+    pattern BVConcatTerm,
+    pattern BVExtendTerm,
+    pattern BVSelectTerm,
+    pattern BitCastOrTerm,
+    pattern BitCastTerm,
+    pattern ComplementBitsTerm,
+    pattern ConTerm,
+    pattern DistinctTerm,
+    pattern DivIntegralTerm,
+    pattern EqTerm,
+    pattern ExistsTerm,
+    pattern FPBinaryTerm,
+    pattern FPFMATerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPTraitTerm,
+    pattern FPUnaryTerm,
+    pattern FdivTerm,
+    pattern FloatingUnaryTerm,
+    pattern ForallTerm,
+    pattern FromFPOrTerm,
+    pattern FromIntegralTerm,
+    pattern ITETerm,
+    pattern LeOrdTerm,
+    pattern LtOrdTerm,
+    pattern ModIntegralTerm,
+    pattern MulNumTerm,
+    pattern NegNumTerm,
+    pattern NotTerm,
+    pattern OrBitsTerm,
+    pattern OrTerm,
+    pattern PowerTerm,
+    pattern QuotIntegralTerm,
+    pattern RecipTerm,
+    pattern RemIntegralTerm,
+    pattern RotateLeftTerm,
+    pattern RotateRightTerm,
+    pattern ShiftLeftTerm,
+    pattern ShiftRightTerm,
+    pattern SignumNumTerm,
+    pattern SymTerm,
+    pattern ToFPTerm,
+    pattern XorBitsTerm,
+  )
+import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm))
+
+subTermsViewPattern :: Term a -> Maybe [SomeTerm]
+subTermsViewPattern (ConTerm _) = return []
+subTermsViewPattern (SymTerm _) = return []
+subTermsViewPattern (ForallTerm _ t) = return [SomeTerm t]
+subTermsViewPattern (ExistsTerm _ t) = return [SomeTerm t]
+subTermsViewPattern (NotTerm t) = return [SomeTerm t]
+subTermsViewPattern (OrTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (AndTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (EqTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (DistinctTerm t) = return (SomeTerm <$> toList t)
+subTermsViewPattern (ITETerm t1 t2 t3) =
+  return [SomeTerm t1, SomeTerm t2, SomeTerm t3]
+subTermsViewPattern (AddNumTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (NegNumTerm t) = return [SomeTerm t]
+subTermsViewPattern (MulNumTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (AbsNumTerm t) = return [SomeTerm t]
+subTermsViewPattern (SignumNumTerm t) = return [SomeTerm t]
+subTermsViewPattern (LtOrdTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (LeOrdTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (AndBitsTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (OrBitsTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (XorBitsTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (ComplementBitsTerm t) = return [SomeTerm t]
+subTermsViewPattern (ShiftLeftTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (ShiftRightTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (RotateLeftTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (RotateRightTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (BitCastTerm t1) = return [SomeTerm t1]
+subTermsViewPattern (BitCastOrTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (BVConcatTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (BVSelectTerm _ _ t1) = return [SomeTerm t1]
+subTermsViewPattern (BVExtendTerm _ _ t1) = return [SomeTerm t1]
+subTermsViewPattern (ApplyTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (DivIntegralTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (ModIntegralTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (QuotIntegralTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (RemIntegralTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (FPTraitTerm _ t1) = return [SomeTerm t1]
+subTermsViewPattern (FdivTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (RecipTerm t) = return [SomeTerm t]
+subTermsViewPattern (FloatingUnaryTerm _ t) = return [SomeTerm t]
+subTermsViewPattern (PowerTerm t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (FPUnaryTerm _ t) = return [SomeTerm t]
+subTermsViewPattern (FPBinaryTerm _ t1 t2) = return [SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (FPRoundingUnaryTerm _ rd t) = return [SomeTerm rd, SomeTerm t]
+subTermsViewPattern (FPRoundingBinaryTerm _ rd t1 t2) = return [SomeTerm rd, SomeTerm t1, SomeTerm t2]
+subTermsViewPattern (FPFMATerm rd t1 t2 t3) =
+  return [SomeTerm rd, SomeTerm t1, SomeTerm t2, SomeTerm t3]
+subTermsViewPattern (FromIntegralTerm t) = return [SomeTerm t]
+subTermsViewPattern (FromFPOrTerm t1 rd t2) = return [SomeTerm t1, SomeTerm rd, SomeTerm t2]
+subTermsViewPattern (ToFPTerm rd t1 _ _) = return [SomeTerm rd, SomeTerm t1]
+
+-- | Extract all the subterms of a term.
+pattern SubTerms :: [SomeTerm] -> Term a
+pattern SubTerms ts <- (subTermsViewPattern -> Just ts)
+
+#if MIN_VERSION_base(4, 16, 4)
+{-# COMPLETE SubTerms #-}
+{-# INLINE SubTerms #-}
+#endif
diff --git a/src/Grisette/Internal/SymPrim/Prim/SomeTerm.hs b/src/Grisette/Internal/SymPrim/Prim/SomeTerm.hs
--- a/src/Grisette/Internal/SymPrim/Prim/SomeTerm.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/SomeTerm.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -25,9 +26,8 @@
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( SupportedPrim (primTypeRep),
     Term,
-    introSupportedPrimConstraint,
     termId,
-    withSupportedPrimTypeable,
+    pattern SupportedTerm,
   )
 
 -- | Existential wrapper for symbolic Grisette terms.
@@ -36,11 +36,9 @@
 
 instance Eq SomeTerm where
   (SomeTerm (t1 :: Term a)) == (SomeTerm (t2 :: Term b)) =
-    withSupportedPrimTypeable @a $
-      withSupportedPrimTypeable @b $
-        case eqT @a @b of
-          Just Refl -> t1 == t2
-          Nothing -> False
+    case eqT @a @b of
+      Just Refl -> t1 == t2
+      Nothing -> False
 
 instance Hashable SomeTerm where
   hashWithSalt s (SomeTerm t) = hashWithSalt s t
@@ -51,7 +49,7 @@
 
 -- | Wrap a symbolic term into t'SomeTerm'.
 someTerm :: Term a -> SomeTerm
-someTerm v = introSupportedPrimConstraint v $ SomeTerm v
+someTerm v@SupportedTerm = SomeTerm v
 {-# INLINE someTerm #-}
 
 -- | Get the unique identifier of a symbolic term.
diff --git a/src/Grisette/Internal/SymPrim/Prim/Term.hs b/src/Grisette/Internal/SymPrim/Prim/Term.hs
--- a/src/Grisette/Internal/SymPrim/Prim/Term.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/Term.hs
@@ -10,29 +10,24 @@
 -- Portability :   GHC only
 module Grisette.Internal.SymPrim.Prim.Term
   ( module Grisette.Internal.SymPrim.Prim.Internal.Term,
-    module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP,
     module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalShiftTerm,
     module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalRotateTerm,
-    module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalNumTerm,
     module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalOrdTerm,
     module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalDivModIntegralTerm,
     module Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalIEEEFPConvertibleTerm,
   )
 where
 
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.BVPEval ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitCastTerm ()
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalBitwiseTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalDivModIntegralTerm
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
+import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFloatingTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFractionalTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFromIntegralTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalIEEEFPConvertibleTerm
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalNumTerm
+import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalNumTerm ()
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalOrdTerm
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalRotateTerm
 import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalShiftTerm
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.SupportedPrim ()
 import Grisette.Internal.SymPrim.Prim.Internal.Serialize ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
diff --git a/src/Grisette/Internal/SymPrim/Prim/TermUtils.hs b/src/Grisette/Internal/SymPrim/Prim/TermUtils.hs
--- a/src/Grisette/Internal/SymPrim/Prim/TermUtils.hs
+++ b/src/Grisette/Internal/SymPrim/Prim/TermUtils.hs
@@ -33,7 +33,7 @@
     modify',
   )
 import Data.Data (cast)
-import Data.Foldable (Foldable (toList), traverse_)
+import Data.Foldable (traverse_)
 import qualified Data.HashSet as HS
 import Grisette.Internal.Core.Data.MemoUtils (htmemo)
 import Grisette.Internal.SymPrim.GeneralFun (type (-->) (GeneralFun))
@@ -42,60 +42,16 @@
     SomeTypedConstantSymbol,
     SomeTypedSymbol (SomeTypedSymbol),
     SupportedPrim (castTypedSymbol, primTypeRep),
-    Term
-      ( AbsNumTerm,
-        AddNumTerm,
-        AndBitsTerm,
-        AndTerm,
-        ApplyTerm,
-        BVConcatTerm,
-        BVExtendTerm,
-        BVSelectTerm,
-        BitCastOrTerm,
-        BitCastTerm,
-        ComplementBitsTerm,
-        ConTerm,
-        DistinctTerm,
-        DivIntegralTerm,
-        EqTerm,
-        ExistsTerm,
-        FPBinaryTerm,
-        FPFMATerm,
-        FPRoundingBinaryTerm,
-        FPRoundingUnaryTerm,
-        FPTraitTerm,
-        FPUnaryTerm,
-        FdivTerm,
-        FloatingUnaryTerm,
-        ForallTerm,
-        FromFPOrTerm,
-        FromIntegralTerm,
-        ITETerm,
-        LeOrdTerm,
-        LtOrdTerm,
-        ModIntegralTerm,
-        MulNumTerm,
-        NegNumTerm,
-        NotTerm,
-        OrBitsTerm,
-        OrTerm,
-        PowerTerm,
-        QuotIntegralTerm,
-        RecipTerm,
-        RemIntegralTerm,
-        RotateLeftTerm,
-        RotateRightTerm,
-        ShiftLeftTerm,
-        ShiftRightTerm,
-        SignumNumTerm,
-        SymTerm,
-        ToFPTerm,
-        XorBitsTerm
-      ),
+    Term,
     TypedAnySymbol,
-    introSupportedPrimConstraint,
     someTypedSymbol,
+    pattern ConTerm,
+    pattern ExistsTerm,
+    pattern ForallTerm,
+    pattern SupportedTerm,
+    pattern SymTerm,
   )
+import Grisette.Internal.SymPrim.Prim.Pattern (pattern SubTerms)
 import Grisette.Internal.SymPrim.Prim.SomeTerm
   ( SomeTerm (SomeTerm),
     someTerm,
@@ -124,8 +80,7 @@
       ) ->
       Term a ->
       Maybe (HS.HashSet (SomeTypedSymbol knd))
-    gotyped memo a =
-      introSupportedPrimConstraint a $ memo (SomeTerm a)
+    gotyped memo a = memo (someTerm a)
     initialMemo ::
       SomeTerm ->
       Maybe (HS.HashSet (SomeTypedSymbol knd))
@@ -139,13 +94,13 @@
       HS.HashSet (SomeTypedConstantSymbol) ->
       SomeTerm ->
       Maybe (HS.HashSet (SomeTypedSymbol knd))
-    go _ bs (SomeTerm (SymTerm _ _ _ _ (sym :: TypedAnySymbol a))) =
+    go _ bs (SomeTerm (SymTerm (sym :: TypedAnySymbol a))) =
       case (castTypedSymbol sym, castTypedSymbol sym) of
         (Just sym', _) | HS.member (someTypedSymbol sym') bs -> return HS.empty
         (_, Just sym') ->
           return $ HS.singleton $ SomeTypedSymbol sym'
         _ -> Nothing
-    go _ bs (SomeTerm (ConTerm _ _ _ _ cv :: Term v)) =
+    go _ bs (SomeTerm (ConTerm cv :: Term v)) =
       case (primTypeRep :: TypeRep v) of
         App (App gf _) _ ->
           case eqTypeRep (typeRep @(-->)) gf of
@@ -157,100 +112,17 @@
                  in gotyped newmemo tm
             Nothing -> return HS.empty
         _ -> return HS.empty
-    go _ bs (SomeTerm (ForallTerm _ _ _ _ sym arg)) =
+    go _ bs (SomeTerm (ForallTerm sym arg)) =
       let newBounded = HS.insert (someTypedSymbol sym) bs
           newmemo = htmemo (go newmemo newBounded)
           {-# NOINLINE newmemo #-}
-       in goUnary newmemo arg
-    go _ bs (SomeTerm (ExistsTerm _ _ _ _ sym arg)) =
+       in gotyped newmemo arg
+    go _ bs (SomeTerm (ExistsTerm sym arg)) =
       let newBounded = HS.insert (someTypedSymbol sym) bs
           newmemo = htmemo (go newmemo newBounded)
           {-# NOINLINE newmemo #-}
-       in goUnary newmemo arg
-    go memo _ (SomeTerm (NotTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (OrTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (AndTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (EqTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (DistinctTerm _ _ _ _ args)) =
-      combineAllSets $ map (gotyped memo) $ toList args
-    go memo _ (SomeTerm (ITETerm _ _ _ _ cond arg1 arg2)) =
-      goTernary memo cond arg1 arg2
-    go memo _ (SomeTerm (AddNumTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (NegNumTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (MulNumTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (AbsNumTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (SignumNumTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (LtOrdTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (LeOrdTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (AndBitsTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (OrBitsTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (XorBitsTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (ComplementBitsTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (ShiftLeftTerm _ _ _ _ arg n1)) = goBinary memo arg n1
-    go memo _ (SomeTerm (ShiftRightTerm _ _ _ _ arg n1)) = goBinary memo arg n1
-    go memo _ (SomeTerm (RotateLeftTerm _ _ _ _ arg n1)) = goBinary memo arg n1
-    go memo _ (SomeTerm (RotateRightTerm _ _ _ _ arg n1)) = goBinary memo arg n1
-    go memo _ (SomeTerm (BitCastTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (BitCastOrTerm _ _ _ _ d arg)) = goBinary memo d arg
-    go memo _ (SomeTerm (BVConcatTerm _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (BVSelectTerm _ _ _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (BVExtendTerm _ _ _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (ApplyTerm _ _ _ _ func arg)) = goBinary memo func arg
-    go memo _ (SomeTerm (DivIntegralTerm _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (ModIntegralTerm _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (QuotIntegralTerm _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (RemIntegralTerm _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (FPTraitTerm _ _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (FdivTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (RecipTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (FloatingUnaryTerm _ _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (PowerTerm _ _ _ _ arg1 arg2)) = goBinary memo arg1 arg2
-    go memo _ (SomeTerm (FPUnaryTerm _ _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (FPBinaryTerm _ _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (FPRoundingUnaryTerm _ _ _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (FPRoundingBinaryTerm _ _ _ _ _ _ arg1 arg2)) =
-      goBinary memo arg1 arg2
-    go memo _ (SomeTerm (FPFMATerm _ _ _ _ mode arg1 arg2 arg3)) =
-      combineAllSets
-        [ gotyped memo mode,
-          gotyped memo arg1,
-          gotyped memo arg2,
-          gotyped memo arg3
-        ]
-    go memo _ (SomeTerm (FromIntegralTerm _ _ _ _ arg)) = goUnary memo arg
-    go memo _ (SomeTerm (FromFPOrTerm _ _ _ _ d mode arg)) =
-      goTernary memo d mode arg
-    go memo _ (SomeTerm (ToFPTerm _ _ _ _ mode arg _ _)) = goBinary memo mode arg
-    goUnary ::
-      (SomeTerm -> Maybe (HS.HashSet (SomeTypedSymbol knd))) ->
-      Term a ->
-      Maybe (HS.HashSet (SomeTypedSymbol knd))
-    goUnary = gotyped
-    goBinary ::
-      (SomeTerm -> Maybe (HS.HashSet (SomeTypedSymbol knd))) ->
-      Term a ->
-      Term b ->
-      Maybe (HS.HashSet (SomeTypedSymbol knd))
-    goBinary memo arg1 arg2 =
-      combineSet (gotyped memo arg1) (gotyped memo arg2)
-    goTernary ::
-      (SomeTerm -> Maybe (HS.HashSet (SomeTypedSymbol knd))) ->
-      Term a ->
-      Term b ->
-      Term c ->
-      Maybe (HS.HashSet (SomeTypedSymbol knd))
-    goTernary memo arg1 arg2 arg3 =
-      combineAllSets
-        [ gotyped memo arg1,
-          gotyped memo arg2,
-          gotyped memo arg3
-        ]
+       in gotyped newmemo arg
+    go memo _ (SomeTerm (SubTerms ts)) = combineAllSets $ map memo ts
     combineSet (Just a) (Just b) = Just $ HS.union a b
     combineSet _ _ = Nothing
     combineAllSets = foldl1 combineSet
@@ -267,7 +139,7 @@
 
 -- | Cast a term to another type.
 castTerm :: forall a b. (Typeable b) => Term a -> Maybe (Term b)
-castTerm t = introSupportedPrimConstraint t $ cast t
+castTerm t@SupportedTerm = cast t
 {-# INLINE castTerm #-}
 
 -- | Compute the size of a list of terms. Do not count the same term twice.
@@ -281,97 +153,13 @@
     go :: forall b. Term b -> State (HS.HashSet SomeTerm) ()
     go t@ConTerm {} = add t
     go t@SymTerm {} = add t
-    go t@(ForallTerm _ _ _ _ _ arg) = goUnary t arg
-    go t@(ExistsTerm _ _ _ _ _ arg) = goUnary t arg
-    go t@(NotTerm _ _ _ _ arg) = goUnary t arg
-    go t@(OrTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(AndTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(EqTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(DistinctTerm _ _ _ _ args) = do
-      b <- exists t
-      if b
-        then return ()
-        else do
-          add t
-          traverse_ go args
-    go t@(ITETerm _ _ _ _ cond arg1 arg2) = goTernary t cond arg1 arg2
-    go t@(AddNumTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(NegNumTerm _ _ _ _ arg) = goUnary t arg
-    go t@(MulNumTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(AbsNumTerm _ _ _ _ arg) = goUnary t arg
-    go t@(SignumNumTerm _ _ _ _ arg) = goUnary t arg
-    go t@(LtOrdTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(LeOrdTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(AndBitsTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    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@(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@(BitCastTerm _ _ _ _ arg) = goUnary t arg
-    go t@(BitCastOrTerm _ _ _ _ d arg) = goBinary t d arg
-    go t@(BVConcatTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(BVSelectTerm _ _ _ _ _ _ arg) = goUnary t arg
-    go t@(BVExtendTerm _ _ _ _ _ _ arg) = goUnary t arg
-    go t@(ApplyTerm _ _ _ _ func arg) = goBinary t func arg
-    go t@(DivIntegralTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(ModIntegralTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(QuotIntegralTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(RemIntegralTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(FPTraitTerm _ _ _ _ _ arg) = goUnary t arg
-    go t@(FdivTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(RecipTerm _ _ _ _ arg) = goUnary t arg
-    go t@(FloatingUnaryTerm _ _ _ _ _ arg) = goUnary t arg
-    go t@(PowerTerm _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(FPUnaryTerm _ _ _ _ _ arg) = goUnary t arg
-    go t@(FPBinaryTerm _ _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(FPRoundingUnaryTerm _ _ _ _ _ _ arg) = goUnary t arg
-    go t@(FPRoundingBinaryTerm _ _ _ _ _ _ arg1 arg2) = goBinary t arg1 arg2
-    go t@(FPFMATerm _ _ _ _ _ arg1 arg2 arg3) = goTernary t arg1 arg2 arg3
-    go t@(FromIntegralTerm _ _ _ _ arg) = goUnary t arg
-    go t@(FromFPOrTerm _ _ _ _ d mode arg) =
-      goTernary t d mode arg
-    go t@(ToFPTerm _ _ _ _ mode arg _ _) = goBinary t mode arg
-    goUnary :: forall a b. (SupportedPrim a) => Term a -> Term b -> State (HS.HashSet SomeTerm) ()
-    goUnary t arg = do
-      b <- exists t
-      if b
-        then return ()
-        else do
-          add t
-          go arg
-    goBinary ::
-      forall a b c.
-      Term a ->
-      Term b ->
-      Term c ->
-      State (HS.HashSet SomeTerm) ()
-    goBinary t arg1 arg2 = do
-      b <- exists t
-      if b
-        then return ()
-        else do
-          add t
-          go arg1
-          go arg2
-    goTernary ::
-      forall a b c d.
-      Term a ->
-      Term b ->
-      Term c ->
-      Term d ->
-      State (HS.HashSet SomeTerm) ()
-    goTernary t arg1 arg2 arg3 = do
+    go t@(SubTerms ts) = do
       b <- exists t
       if b
         then return ()
         else do
           add t
-          go arg1
-          go arg2
-          go arg3
+          traverse_ goSome ts
 {-# INLINEABLE someTermsSize #-}
 
 -- | Compute the size of a list of terms. Do not count the same term twice.
@@ -381,9 +169,7 @@
 
 -- | Compute the size of a list of terms. Do not count the same term twice.
 termsSize :: [Term a] -> Int
-termsSize terms =
-  someTermsSize $
-    (\x -> introSupportedPrimConstraint x $ SomeTerm x) <$> terms
+termsSize terms = someTermsSize $ someTerm <$> terms
 {-# INLINEABLE termsSize #-}
 
 -- | Compute the size of a term.
diff --git a/src/Grisette/Internal/SymPrim/SomeBV.hs b/src/Grisette/Internal/SymPrim/SomeBV.hs
--- a/src/Grisette/Internal/SymPrim/SomeBV.hs
+++ b/src/Grisette/Internal/SymPrim/SomeBV.hs
@@ -801,8 +801,13 @@
   bvSelect ix w (SomeBV (a :: bv n))
     | ix + w > n =
         error $
-          "bvSelect: trying to select a bitvector outside the bounds of the "
-            <> "inserialize"
+          "bvSelect: trying to select a bitvector outside the bounds, "
+            <> "ix = "
+            <> show ix
+            <> ", w = "
+            <> show w
+            <> ", n = "
+            <> show n
     | w == 0 = error "bvSelect: trying to select a bitvector of size 0"
     | otherwise = res (Proxy @n) (Proxy @n)
     where
diff --git a/src/Grisette/Internal/SymPrim/SymAlgReal.hs b/src/Grisette/Internal/SymPrim/SymAlgReal.hs
--- a/src/Grisette/Internal/SymPrim/SymAlgReal.hs
+++ b/src/Grisette/Internal/SymPrim/SymAlgReal.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -61,10 +62,11 @@
     LinkedRep (underlyingTerm, wrapTerm),
     PEvalNumTerm (pevalAddNumTerm),
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     conTerm,
     pformatTerm,
     symTerm,
+    pattern ConTerm,
   )
 import Language.Haskell.TH.Syntax (Lift)
 
@@ -99,7 +101,7 @@
 instance Solvable AlgReal SymAlgReal where
   con = SymAlgReal . conTerm
   sym = SymAlgReal . symTerm . typedConstantSymbol
-  conView (SymAlgReal (ConTerm _ _ _ _ t)) = Just t
+  conView (SymAlgReal (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance Show SymAlgReal where
diff --git a/src/Grisette/Internal/SymPrim/SymBV.hs b/src/Grisette/Internal/SymPrim/SymBV.hs
--- a/src/Grisette/Internal/SymPrim/SymBV.hs
+++ b/src/Grisette/Internal/SymPrim/SymBV.hs
@@ -132,7 +132,7 @@
     PEvalShiftTerm (pevalShiftLeftTerm, pevalShiftRightTerm),
     SupportedPrim (pevalITETerm),
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     conTerm,
     pevalEqTerm,
     pevalGeOrdTerm,
@@ -142,6 +142,7 @@
     pformatTerm,
     symTerm,
     typedConstantSymbol,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.SymBool (SymBool (SymBool))
 import Grisette.Internal.Utils.Parameterized
@@ -253,7 +254,7 @@
 instance (KnownNat n, 1 <= n) => Solvable (contype n) (symtype n) where \
   con = symtype . conTerm; \
   sym = symtype . symTerm . typedConstantSymbol; \
-  conView (symtype (ConTerm _ _ _ _ t)) = Just t; \
+  conView (symtype (ConTerm  t)) = Just t; \
   conView _ = Nothing
 
 #if 1
diff --git a/src/Grisette/Internal/SymPrim/SymBool.hs b/src/Grisette/Internal/SymPrim/SymBool.hs
--- a/src/Grisette/Internal/SymPrim/SymBool.hs
+++ b/src/Grisette/Internal/SymPrim/SymBool.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -33,11 +34,12 @@
   ( ConRep (ConType),
     LinkedRep (underlyingTerm, wrapTerm),
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     conTerm,
     pformatTerm,
     symTerm,
     typedConstantSymbol,
+    pattern ConTerm,
   )
 import Language.Haskell.TH.Syntax (Lift)
 
@@ -82,7 +84,7 @@
 instance Solvable Bool SymBool where
   con = SymBool . conTerm
   sym = SymBool . symTerm . typedConstantSymbol
-  conView (SymBool (ConTerm _ _ _ _ t)) = Just t
+  conView (SymBool (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance IsString SymBool where
diff --git a/src/Grisette/Internal/SymPrim/SymFP.hs b/src/Grisette/Internal/SymPrim/SymFP.hs
--- a/src/Grisette/Internal/SymPrim/SymFP.hs
+++ b/src/Grisette/Internal/SymPrim/SymFP.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -107,14 +108,7 @@
     ValidFP,
     withValidFPProofs,
   )
-import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP
-  ( pevalFPBinaryTerm,
-    pevalFPFMATerm,
-    pevalFPRoundingBinaryTerm,
-    pevalFPRoundingUnaryTerm,
-    pevalFPTraitTerm,
-    pevalFPUnaryTerm,
-  )
+import Grisette.Internal.SymPrim.Prim.Internal.Instances.PEvalFP ()
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( ConRep (ConType),
     FPBinaryOp (FPMaximum, FPMaximumNumber, FPMinimum, FPMinimumNumber, FPRem),
@@ -139,6 +133,14 @@
     LinkedRep (underlyingTerm, wrapTerm),
     PEvalBitCastOrTerm (pevalBitCastOrTerm),
     PEvalBitCastTerm (pevalBitCastTerm),
+    PEvalFPTerm
+      ( pevalFPBinaryTerm,
+        pevalFPFMATerm,
+        pevalFPRoundingBinaryTerm,
+        pevalFPRoundingUnaryTerm,
+        pevalFPTraitTerm,
+        pevalFPUnaryTerm
+      ),
     PEvalFloatingTerm (pevalFloatingUnaryTerm),
     PEvalFractionalTerm (pevalFdivTerm, pevalRecipTerm),
     PEvalIEEEFPConvertibleTerm (pevalFromFPOrTerm, pevalToFPTerm),
@@ -150,12 +152,13 @@
         pevalSignumNumTerm
       ),
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     conTerm,
     pevalSubNumTerm,
     pformatTerm,
     symTerm,
     typedConstantSymbol,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.SymAlgReal (SymAlgReal (SymAlgReal))
 import Grisette.Internal.SymPrim.SymBV (SymIntN (SymIntN), SymWordN (SymWordN))
@@ -218,7 +221,7 @@
 instance (ValidFP eb sb) => Solvable (FP eb sb) (SymFP eb sb) where
   con = SymFP . conTerm
   sym = SymFP . symTerm . typedConstantSymbol
-  conView (SymFP (ConTerm _ _ _ _ t)) = Just t
+  conView (SymFP (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance (ValidFP eb sb) => Show (SymFP eb sb) where
@@ -290,7 +293,7 @@
 instance Solvable FPRoundingMode SymFPRoundingMode where
   con = SymFPRoundingMode . conTerm
   sym = SymFPRoundingMode . symTerm . typedConstantSymbol
-  conView (SymFPRoundingMode (ConTerm _ _ _ _ t)) = Just t
+  conView (SymFPRoundingMode (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance Show SymFPRoundingMode where
diff --git a/src/Grisette/Internal/SymPrim/SymGeneralFun.hs b/src/Grisette/Internal/SymPrim/SymGeneralFun.hs
--- a/src/Grisette/Internal/SymPrim/SymGeneralFun.hs
+++ b/src/Grisette/Internal/SymPrim/SymGeneralFun.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -53,12 +54,13 @@
     SupportedNonFuncPrim,
     SupportedPrim,
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     TypedConstantSymbol,
     conTerm,
     pformatTerm,
     symTerm,
     typedAnySymbol,
+    pattern ConTerm,
   )
 import Language.Haskell.TH.Syntax (Lift (liftTyped))
 
@@ -177,7 +179,7 @@
   where
   con = SymGeneralFun . conTerm
   sym = SymGeneralFun . symTerm . typedAnySymbol
-  conView (SymGeneralFun (ConTerm _ _ _ _ t)) = Just t
+  conView (SymGeneralFun (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance
diff --git a/src/Grisette/Internal/SymPrim/SymInteger.hs b/src/Grisette/Internal/SymPrim/SymInteger.hs
--- a/src/Grisette/Internal/SymPrim/SymInteger.hs
+++ b/src/Grisette/Internal/SymPrim/SymInteger.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -40,12 +41,13 @@
         pevalSignumNumTerm
       ),
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     conTerm,
     pevalSubNumTerm,
     pformatTerm,
     symTerm,
     typedConstantSymbol,
+    pattern ConTerm,
   )
 import Language.Haskell.TH.Syntax (Lift)
 
@@ -97,7 +99,7 @@
 instance Solvable Integer SymInteger where
   con = SymInteger . conTerm
   sym = SymInteger . symTerm . typedConstantSymbol
-  conView (SymInteger (ConTerm _ _ _ _ t)) = Just t
+  conView (SymInteger (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance IsString SymInteger where
diff --git a/src/Grisette/Internal/SymPrim/SymPrim.hs b/src/Grisette/Internal/SymPrim/SymPrim.hs
--- a/src/Grisette/Internal/SymPrim/SymPrim.hs
+++ b/src/Grisette/Internal/SymPrim/SymPrim.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- |
 -- Module      :   Grisette.Internal.SymPrim.SymPrim
@@ -19,7 +21,7 @@
 import Data.Serialize (Serialize)
 import Grisette.Internal.Core.Data.Class.EvalSym (EvalSym)
 import Grisette.Internal.Core.Data.Class.ExtractSym (ExtractSym)
-import Grisette.Internal.Core.Data.Class.Function (Apply)
+import Grisette.Internal.Core.Data.Class.Function (Apply (FunType))
 import Grisette.Internal.Core.Data.Class.GenSym (GenSymSimple)
 import Grisette.Internal.Core.Data.Class.ITEOp (ITEOp)
 import Grisette.Internal.Core.Data.Class.Mergeable (Mergeable)
@@ -35,6 +37,7 @@
 import Grisette.Internal.SymPrim.Prim.Internal.Term
   ( ConRep (ConType),
     LinkedRep,
+    SupportedNonFuncPrim,
   )
 import Language.Haskell.TH.Syntax (Lift)
 import Type.Reflection (Typeable)
@@ -78,10 +81,12 @@
   ( SymPrim a,
     SimpleMergeable a,
     GenSymSimple () a,
-    Apply a,
     Solvable (ConType a) a,
     ConRep a,
     LinkedRep (ConType a) a,
     ToCon a (ConType a),
-    ToSym (ConType a) a
+    ToSym (ConType a) a,
+    Apply a,
+    a ~ FunType a,
+    SupportedNonFuncPrim (ConType a)
   )
diff --git a/src/Grisette/Internal/SymPrim/SymTabularFun.hs b/src/Grisette/Internal/SymPrim/SymTabularFun.hs
--- a/src/Grisette/Internal/SymPrim/SymTabularFun.hs
+++ b/src/Grisette/Internal/SymPrim/SymTabularFun.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -47,11 +48,12 @@
     SupportedNonFuncPrim,
     SupportedPrim,
     SymRep (SymType),
-    Term (ConTerm),
+    Term,
     conTerm,
     pformatTerm,
     symTerm,
     typedAnySymbol,
+    pattern ConTerm,
   )
 import Grisette.Internal.SymPrim.TabularFun (type (=->))
 import Language.Haskell.TH.Syntax (Lift (liftTyped))
@@ -131,7 +133,7 @@
   where
   con = SymTabularFun . conTerm
   sym = SymTabularFun . symTerm . typedAnySymbol
-  conView (SymTabularFun (ConTerm _ _ _ _ t)) = Just t
+  conView (SymTabularFun (ConTerm t)) = Just t
   conView _ = Nothing
 
 instance
diff --git a/src/Grisette/Internal/SymPrim/TabularFun.hs b/src/Grisette/Internal/SymPrim/TabularFun.hs
--- a/src/Grisette/Internal/SymPrim/TabularFun.hs
+++ b/src/Grisette/Internal/SymPrim/TabularFun.hs
@@ -6,6 +6,7 @@
 {-# HLINT ignore "Eta reduce" #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -59,12 +60,14 @@
         withPrim
       ),
     SupportedPrimConstraint (PrimConstraint),
-    Term (ConTerm),
+    Term,
     applyTerm,
     conTerm,
     partitionCVArg,
     pevalEqTerm,
     pevalITEBasicTerm,
+    pattern ConTerm,
+    pattern ITETerm,
   )
 import Language.Haskell.TH.Syntax (Lift)
 
@@ -131,12 +134,14 @@
         Term (a =-> b) ->
         Term a ->
         Maybe (Term b)
-      doPevalApplyTerm (ConTerm _ _ _ _ f) (ConTerm _ _ _ _ a) = Just $ conTerm $ f # a
-      doPevalApplyTerm (ConTerm _ _ _ _ (TabularFun f d)) a = Just $ go f
+      doPevalApplyTerm (ConTerm f) (ConTerm a) = Just $ conTerm $ f # a
+      doPevalApplyTerm (ConTerm (TabularFun f d)) a = Just $ go f
         where
           go [] = conTerm d
           go ((x, y) : xs) =
             pevalITETerm (pevalEqTerm a (conTerm x)) (conTerm y) (go xs)
+      doPevalApplyTerm (ITETerm cond t f) v =
+        Just $ pevalITETerm cond (pevalApplyTerm t v) (pevalApplyTerm f v)
       doPevalApplyTerm _ _ = Nothing
   sbvApplyTerm f a =
     withPrim @(a =-> b) $ withNonFuncPrim @a $ f a
diff --git a/src/Grisette/Internal/TH/Ctor/UnifiedConstructor.hs b/src/Grisette/Internal/TH/Ctor/UnifiedConstructor.hs
--- a/src/Grisette/Internal/TH/Ctor/UnifiedConstructor.hs
+++ b/src/Grisette/Internal/TH/Ctor/UnifiedConstructor.hs
@@ -24,7 +24,7 @@
     prefixTransformer,
     withNameTransformer,
   )
-import Grisette.Internal.TH.GADT.Common (ctxForVar)
+import Grisette.Internal.TH.Derivation.Common (ctxForVar)
 import Grisette.Internal.TH.Util (constructorInfoToType, putHaddock, tvIsMode)
 import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
 import Grisette.Internal.Unified.UnifiedData
diff --git a/src/Grisette/Internal/TH/Derivation/BinaryOpCommon.hs b/src/Grisette/Internal/TH/Derivation/BinaryOpCommon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/BinaryOpCommon.hs
@@ -0,0 +1,389 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.BinaryOpCommon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.BinaryOpCommon
+  ( BinaryOpClassConfig (..),
+    BinaryOpFieldConfig (..),
+    FieldFunExp,
+    defaultFieldFunExp,
+    genBinaryOpClause,
+    genBinaryOpClass,
+  )
+where
+
+import Control.Monad (replicateM, unless, when, zipWithM)
+import Control.Monad.Identity (IdentityT)
+import qualified Data.List as List
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, mapMaybe)
+import Data.Proxy (Proxy (Proxy))
+import qualified Data.Set as S
+import Grisette.Internal.TH.Derivation.Common
+  ( CheckArgsResult
+      ( argVars,
+        constructors,
+        keptVars
+      ),
+    DeriveConfig (unconstrainedPositions),
+    checkArgs,
+    ctxForVar,
+    evalModeSpecializeList,
+    extraConstraint,
+    freshenCheckArgsResult,
+    isVarUsedInFields,
+    specializeResult,
+  )
+import Language.Haskell.TH
+  ( Clause,
+    Dec (FunD, InstanceD),
+    Exp (VarE),
+    Kind,
+    Name,
+    Pat (VarP, WildP),
+    Q,
+    Type (AppT, ConT, VarT),
+    clause,
+    conP,
+    funD,
+    nameBase,
+    newName,
+    normalB,
+    recP,
+    sigP,
+    varE,
+    varP,
+    varT,
+    wildP,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorInfo (constructorFields, constructorName, constructorVars),
+    TypeSubstitution (freeVariables),
+    resolveTypeSynonyms,
+    tvName,
+  )
+import Type.Reflection
+  ( TypeRep,
+    eqTypeRep,
+    someTypeRep,
+    typeRep,
+    type (:~~:) (HRefl),
+  )
+
+-- | Type of field function expression generator.
+type FieldFunExp = M.Map Name Name -> Type -> Q Exp
+
+-- | Default field function expression generator.
+defaultFieldFunExp :: [Name] -> FieldFunExp
+defaultFieldFunExp binaryOpFunNames argToFunPat = go
+  where
+    go ty = do
+      let allArgNames = M.keysSet argToFunPat
+      let typeHasNoArg ty =
+            S.fromList (freeVariables [ty])
+              `S.intersection` allArgNames
+              == S.empty
+      let fun0 = varE $ head binaryOpFunNames
+          fun1 b = [|$(varE $ binaryOpFunNames !! 1) $(go b)|]
+          fun2 b c = [|$(varE $ binaryOpFunNames !! 2) $(go b) $(go c)|]
+          fun3 b c d =
+            [|$(varE $ binaryOpFunNames !! 3) $(go b) $(go c) $(go d)|]
+      case ty of
+        AppT (AppT (AppT (VarT _) b) c) d -> fun3 b c d
+        AppT (AppT (VarT _) b) c -> fun2 b c
+        AppT (VarT _) b -> fun1 b
+        _ | typeHasNoArg ty -> fun0
+        AppT a b | typeHasNoArg a -> fun1 b
+        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
+        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3 b c d
+        VarT nm -> case M.lookup nm argToFunPat of
+          Just pname -> varE pname
+          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+
+funPatAndExps ::
+  FieldFunExp ->
+  [(Type, Kind)] ->
+  [Type] ->
+  Q ([Pat], [Exp])
+funPatAndExps fieldFunExpGen argTypes fields = do
+  let usedArgs = S.fromList $ freeVariables fields
+  args <-
+    traverse
+      ( \(ty, _) ->
+          case ty of
+            VarT nm ->
+              if S.member nm usedArgs
+                then do
+                  pname <- newName "p"
+                  return (nm, Just pname)
+                else return ('undefined, Nothing)
+            _ -> return ('undefined, Nothing)
+      )
+      argTypes
+  let argToFunPat =
+        M.fromList $ mapMaybe (\(ty, mpat) -> fmap (ty,) mpat) args
+  let funPats = fmap (maybe WildP VarP . snd) args
+  defaultFieldFunExps <- traverse (fieldFunExpGen argToFunPat) fields
+  return (funPats, defaultFieldFunExps)
+
+-- | Configuration for a binary operation field generation on a GADT.
+data BinaryOpFieldConfig = BinaryOpFieldConfig
+  { extraPatNames :: [String],
+    fieldResFun :: [Exp] -> (Exp, Exp) -> Exp -> Q (Exp, [Bool]),
+    fieldCombineFun :: Name -> [Exp] -> Q (Exp, [Bool]),
+    fieldDifferentExistentialFun :: Exp -> Q Exp,
+    fieldLMatchResult :: Q Exp,
+    fieldRMatchResult :: Q Exp,
+    fieldFunExp :: FieldFunExp,
+    fieldFunNames :: [Name]
+  }
+
+-- | Generate a clause for a binary operation on a GADT.
+genBinaryOpClause ::
+  BinaryOpFieldConfig ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  Bool ->
+  ConstructorInfo ->
+  ConstructorInfo ->
+  Q [Clause]
+genBinaryOpClause
+  (BinaryOpFieldConfig {..})
+  lhsArgNewVars
+  _rhsArgNewVars
+  isLast
+  lhsConstructors
+  rhsConstructors =
+    do
+      lhsFields <- mapM resolveTypeSynonyms $ constructorFields lhsConstructors
+      rhsFields <- mapM resolveTypeSynonyms $ constructorFields rhsConstructors
+      (funPats, defaultFieldFunExps) <-
+        funPatAndExps fieldFunExp lhsArgNewVars lhsFields
+      unless (null extraPatNames) $
+        unless isLast $
+          fail "Should not happen"
+      extraPatNames <- traverse newName extraPatNames
+      let extraPats = fmap VarP extraPatNames
+      let extraPatExps = fmap VarE extraPatNames
+      lhsFieldsPatNames <- replicateM (length lhsFields) $ newName "lhsField"
+      rhsFieldsPatNames <- replicateM (length rhsFields) $ newName "rhsField"
+      let lhsFieldPats =
+            conP
+              (constructorName lhsConstructors)
+              ( zipWith
+                  (\nm field -> sigP (varP nm) (return field))
+                  lhsFieldsPatNames
+                  lhsFields
+              )
+      let rhsFieldPats =
+            conP
+              (constructorName rhsConstructors)
+              ( zipWith
+                  (\nm field -> sigP (varP nm) (return field))
+                  rhsFieldsPatNames
+                  rhsFields
+              )
+      let singleMatchPat =
+            if null lhsFields
+              then conP (constructorName lhsConstructors) []
+              else recP (constructorName rhsConstructors) []
+      let lhsFieldPatExps = fmap VarE lhsFieldsPatNames
+      let rhsFieldPatExps = fmap VarE rhsFieldsPatNames
+
+      fieldResExpsAndArgsUsed <-
+        zipWithM
+          (fieldResFun extraPatExps)
+          (zip lhsFieldPatExps rhsFieldPatExps)
+          defaultFieldFunExps
+      let fieldResExps = fst <$> fieldResExpsAndArgsUsed
+      let extraArgsUsedByFields = snd <$> fieldResExpsAndArgsUsed
+      (resExp, extraArgsUsedByResult) <-
+        fieldCombineFun
+          (constructorName lhsConstructors)
+          fieldResExps
+
+      let eqt l r =
+            [|
+              eqTypeRep
+                (typeRep :: TypeRep $(varT $ tvName l))
+                (typeRep :: TypeRep $(varT $ tvName r))
+              |]
+      let eqx trueCont l r = do
+            cmp <-
+              [|
+                compare
+                  (someTypeRep (Proxy :: Proxy $(varT $ tvName l)))
+                  (someTypeRep (Proxy :: Proxy $(varT $ tvName r)))
+                |]
+            [|
+              case $(eqt l r) of
+                Just HRefl -> $(trueCont)
+                _ ->
+                  $(fieldDifferentExistentialFun cmp)
+              |]
+      let construct [] = return resExp
+          construct ((l, r) : xs) = [|$(eqx (construct xs) l r)|]
+
+      let extraArgsUsed =
+            fmap or $
+              List.transpose $
+                extraArgsUsedByResult : extraArgsUsedByFields
+      let extraArgsPats =
+            zipWith
+              (\pat used -> if used then pat else WildP)
+              extraPats
+              extraArgsUsed
+      bothMatched <-
+        clause
+          ((return <$> funPats ++ extraArgsPats) ++ [lhsFieldPats, rhsFieldPats])
+          ( normalB
+              [|
+                $( construct $
+                     zip
+                       (constructorVars lhsConstructors)
+                       (constructorVars rhsConstructors)
+                 )
+                |]
+          )
+          []
+      lhsMatched <-
+        clause
+          ((wildP <$ funPats) ++ [singleMatchPat, wildP])
+          (normalB [|$(fieldLMatchResult)|])
+          []
+      rhsMatched <-
+        clause
+          ((wildP <$ funPats) ++ [wildP, singleMatchPat])
+          (normalB [|$(fieldRMatchResult)|])
+          []
+      if isLast
+        then return [bothMatched]
+        else return [bothMatched, lhsMatched, rhsMatched]
+
+-- | Configuration for a binary operation type class generation on a GADT.
+data BinaryOpClassConfig = BinaryOpClassConfig
+  { binaryOpFieldConfigs :: [BinaryOpFieldConfig],
+    binaryOpInstanceNames :: [Name],
+    binaryOpAllowSumType :: Bool,
+    binaryOpAllowExistential :: Bool
+  }
+
+-- | Generate a function for a binary operation on a GADT.
+genBinaryOpFun ::
+  BinaryOpFieldConfig ->
+  Int ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [ConstructorInfo] ->
+  [ConstructorInfo] ->
+  Q Dec
+genBinaryOpFun config n _ _ [] [] =
+  funD
+    (fieldFunNames config !! n)
+    [clause [] (normalB [|error "impossible"|]) []]
+genBinaryOpFun
+  config
+  n
+  lhsArgNewVars
+  rhsArgNewVars
+  lhsConstructors
+  rhsConstructors = do
+    clauses <-
+      zipWithM
+        (genBinaryOpClause config lhsArgNewVars rhsArgNewVars False)
+        (init lhsConstructors)
+        (init rhsConstructors)
+    lastClause <-
+      genBinaryOpClause
+        config
+        lhsArgNewVars
+        rhsArgNewVars
+        True
+        (last lhsConstructors)
+        (last rhsConstructors)
+    let instanceFunName = (fieldFunNames config) !! n
+    return $ FunD instanceFunName (concat clauses ++ lastClause)
+
+-- | Generate a type class instance for a binary operation on a GADT.
+genBinaryOpClass ::
+  DeriveConfig -> BinaryOpClassConfig -> Int -> Name -> Q [Dec]
+genBinaryOpClass deriveConfig (BinaryOpClassConfig {..}) n typName = do
+  lhsResult <-
+    specializeResult (evalModeSpecializeList deriveConfig)
+      =<< freshenCheckArgsResult True
+      =<< checkArgs
+        (nameBase $ head binaryOpInstanceNames)
+        (length binaryOpInstanceNames - 1)
+        typName
+        (n == 0 && binaryOpAllowExistential)
+        n
+  when (not binaryOpAllowSumType && length (constructors lhsResult) > 1) $
+    fail $
+      "Cannot derive "
+        <> nameBase (binaryOpInstanceNames !! n)
+        <> " for sum type"
+  rhsResult <-
+    specializeResult (evalModeSpecializeList deriveConfig)
+      =<< checkArgs
+        (nameBase $ head binaryOpInstanceNames)
+        (length binaryOpInstanceNames - 1)
+        typName
+        (n == 0)
+        n
+  let keptVars' = keptVars lhsResult
+  when (typName == ''IdentityT) $
+    fail $
+      show keptVars'
+  let isTypeUsedInFields' (VarT nm) = isVarUsedInFields lhsResult nm
+      isTypeUsedInFields' _ = False
+  ctxs <-
+    traverse (uncurry $ ctxForVar (fmap ConT binaryOpInstanceNames)) $
+      filter (isTypeUsedInFields' . fst) $
+        fmap snd $
+          filter (not . (`elem` unconstrainedPositions deriveConfig) . fst) $
+            zip [0 ..] keptVars'
+  let keptType = foldl AppT (ConT typName) $ fmap fst keptVars'
+  instanceFuns <-
+    traverse
+      ( \config ->
+          genBinaryOpFun
+            config
+            n
+            (argVars lhsResult)
+            (argVars rhsResult)
+            (constructors lhsResult)
+            (constructors rhsResult)
+      )
+      binaryOpFieldConfigs
+  let instanceName = binaryOpInstanceNames !! n
+  let instanceType = AppT (ConT instanceName) keptType
+  extraPreds <-
+    extraConstraint
+      deriveConfig
+      typName
+      instanceName
+      []
+      keptVars'
+      (constructors lhsResult)
+  return
+    [ InstanceD
+        Nothing
+        ( extraPreds
+            ++ if null (constructors lhsResult)
+              then []
+              else catMaybes ctxs
+        )
+        instanceType
+        instanceFuns
+    ]
diff --git a/src/Grisette/Internal/TH/Derivation/Common.hs b/src/Grisette/Internal/TH/Derivation/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/Common.hs
@@ -0,0 +1,465 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.Common
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.Common
+  ( CheckArgsResult (..),
+    checkArgs,
+    ctxForVar,
+    EvalModeConfig (..),
+    DeriveConfig (..),
+    extraEvalModeConstraint,
+    extraBitSizeConstraint,
+    extraFpBitSizeConstraint,
+    extraExtraMergeableConstraint,
+    extraConstraint,
+    specializeResult,
+    evalModeSpecializeList,
+    isVarUsedInFields,
+    freshenCheckArgsResult,
+  )
+where
+
+import Control.Monad (foldM, unless, when, zipWithM)
+import Data.Bifunctor (first)
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, mapMaybe)
+import qualified Data.Set as S
+import GHC.TypeLits (KnownNat, Nat, type (<=))
+import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
+  ( Mergeable,
+    Mergeable1,
+    Mergeable2,
+  )
+import Grisette.Internal.SymPrim.FP (ValidFP)
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C, S))
+import Grisette.Internal.Unified.Util (DecideEvalMode)
+import Language.Haskell.TH
+  ( Kind,
+    Name,
+    Pred,
+    Q,
+    Type (AppT, ArrowT, ConT, PromotedT, StarT, VarT),
+    conT,
+    nameBase,
+    newName,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorInfo (constructorFields, constructorName, constructorVars),
+    DatatypeInfo (datatypeCons, datatypeVars),
+    TypeSubstitution (applySubstitution, freeVariables),
+    reifyDatatype,
+    tvName,
+  )
+import Language.Haskell.TH.Datatype.TyVarBndr (mapTVName, tvKind)
+
+-- | Result of 'checkArgs' for a data type.
+data CheckArgsResult = CheckArgsResult
+  { constructors :: [ConstructorInfo],
+    keptVars :: [(Type, Kind)],
+    argVars :: [(Type, Kind)]
+  }
+
+-- | Specialize the evaluation mode tags for the t'CheckArgsResult'.
+specializeResult :: [(Int, EvalModeTag)] -> CheckArgsResult -> Q CheckArgsResult
+specializeResult evalModeConfigs result = do
+  let modeToName C = 'C
+      modeToName S = 'S
+  map <-
+    foldM
+      ( \lst (n, tag) -> do
+          let (_, knd) = lst !! n
+          return $
+            take n lst
+              ++ [(PromotedT $ modeToName tag, knd)]
+              ++ drop (n + 1) lst
+      )
+      (keptVars result)
+      evalModeConfigs
+  return $ result {keptVars = map}
+
+freshenConstructorInfo :: ConstructorInfo -> Q ConstructorInfo
+freshenConstructorInfo conInfo = do
+  let vars = constructorVars conInfo
+  newNames <- traverse (newName . nameBase . tvName) vars
+  let newVars = zipWith (mapTVName . const) newNames vars
+  let substMap = M.fromList $ zip (tvName <$> vars) $ VarT <$> newNames
+  return $ applySubstitution substMap conInfo {constructorVars = newVars}
+
+-- | Freshen the type variables in the t'CheckArgsResult'.
+freshenCheckArgsResult :: Bool -> CheckArgsResult -> Q CheckArgsResult
+freshenCheckArgsResult freshenNats result = do
+  let genNewName :: (Type, Kind) -> Q (Maybe Name)
+      genNewName (VarT _, knd) =
+        if not freshenNats && knd == ConT ''Nat
+          then return Nothing
+          else Just <$> newName "a"
+      genNewName _ = return Nothing
+  keptNewNames <- traverse genNewName (keptVars result)
+  argNewNames <- traverse genNewName (argVars result)
+
+  let substMap =
+        M.fromList
+          $ mapMaybe
+            ( \(newName, oldVar) ->
+                case (newName, oldVar) of
+                  (Just newName, (VarT oldName, _)) ->
+                    Just (oldName, VarT newName)
+                  _ -> Nothing
+            )
+          $ zip
+            (keptNewNames ++ argNewNames)
+            (keptVars result ++ argVars result)
+  constructors <-
+    mapM freshenConstructorInfo $
+      applySubstitution substMap $
+        constructors result
+  let newKeptVars = first (applySubstitution substMap) <$> (keptVars result)
+  let newArgVars = first (applySubstitution substMap) <$> (argVars result)
+  return $
+    result
+      { constructors = constructors,
+        keptVars = newKeptVars,
+        argVars = newArgVars
+      }
+
+-- | Check if the number of type parameters is valid for a data type, and return
+-- new names for the type variables, split into kept and arg parts.
+checkArgs ::
+  String ->
+  Int ->
+  Name ->
+  Bool ->
+  Int ->
+  Q CheckArgsResult
+checkArgs clsName maxArgNum typName allowExistential n = do
+  when (n < 0) $
+    fail $
+      unlines
+        [ "Cannot derive "
+            ++ clsName
+            ++ " instance with negative type parameters",
+          "\tRequested: " ++ show n,
+          "\tHint: Use a non-negative number of type parameters"
+        ]
+  when (n > maxArgNum) $
+    fail $
+      unlines
+        [ "Cannot derive "
+            <> clsName
+            <> " instance with more than "
+            <> show maxArgNum
+            <> " type parameters",
+          "\tRequested: " <> show n
+        ]
+  d <- reifyDatatype typName
+  let dvars = datatypeVars d
+  when (length dvars < n) $
+    fail $
+      unlines
+        [ "Cannot derive "
+            <> clsName
+            <> show n
+            <> " instance for the type "
+            <> show typName,
+          "\tReason: The type "
+            <> show typName
+            <> " has only "
+            <> show (length dvars)
+            <> " type variables."
+        ]
+  let keptVars =
+        (\bndr -> (VarT $ tvName bndr, tvKind bndr))
+          <$> take (length dvars - n) dvars
+  let argVars =
+        (\bndr -> (VarT $ tvName bndr, tvKind bndr))
+          <$> drop (length dvars - n) dvars
+  let constructors = datatypeCons d
+  unless allowExistential $
+    mapM_
+      ( \c ->
+          when (constructorVars c /= []) $
+            fail $
+              unlines
+                [ "Cannot derive "
+                    <> clsName
+                    <> show n
+                    <> " instance for the type "
+                    <> show typName,
+                  "\tReason: The constructor "
+                    <> nameBase (constructorName c)
+                    <> " has existential variables"
+                ]
+      )
+      constructors
+  mapM_
+    ( \c -> do
+        let fields = constructorFields c
+        let existentialVars = tvName <$> constructorVars c
+        let fieldReferencedVars = freeVariables fields
+        let notReferencedVars =
+              S.fromList existentialVars S.\\ S.fromList fieldReferencedVars
+        unless (null notReferencedVars) $
+          fail $
+            unlines
+              [ "Cannot derive "
+                  <> clsName
+                  <> show n
+                  <> " instance for the type "
+                  <> show typName,
+                "Reason: Ambiguous existential variable in the constructor: "
+                  <> nameBase (constructorName c)
+                  <> ", this is not supported. Please consider binding the "
+                  <> "existential variable to a field. You can use Proxy type to "
+                  <> "do this."
+              ]
+    )
+    constructors
+  return $ CheckArgsResult {..}
+
+isVarUsedInConstructorFields :: [ConstructorInfo] -> Name -> Bool
+isVarUsedInConstructorFields constructors var =
+  let allFields = concatMap constructorFields constructors
+      allFieldsFreeVars = S.fromList $ freeVariables allFields
+   in S.member var allFieldsFreeVars
+
+-- | Check if a variable is used in the fields of a constructor.
+isVarUsedInFields :: CheckArgsResult -> Name -> Bool
+isVarUsedInFields CheckArgsResult {..} =
+  isVarUsedInConstructorFields constructors
+
+-- | Generate a context for a variable in a GADT.
+ctxForVar :: [Type] -> Type -> Kind -> Q (Maybe Pred)
+ctxForVar instanceExps ty knd = case knd of
+  StarT ->
+    Just
+      <$> [t|$(return $ head instanceExps) $(return ty)|]
+  AppT (AppT ArrowT StarT) StarT ->
+    Just
+      <$> [t|$(return $ instanceExps !! 1) $(return ty)|]
+  AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
+    Just
+      <$> [t|$(return $ instanceExps !! 2) $(return ty)|]
+  AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) StarT ->
+    Just
+      <$> [t|$(return $ instanceExps !! 3) $(return ty)|]
+  AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) _ ->
+    fail $ "Unsupported kind: " <> show knd
+  _ -> return Nothing
+
+-- | Configuration for constraints for evaluation modes tag.
+--
+-- * 'EvalModeConstraints' specifies a list of constraints for the tag, for
+--   example, we may use 'Grisette.Unified.EvalModeBase' and
+--   'Grisette.Unified.EvalModeBV' to specify that the evaluation mode must
+--   support both base (boolean and data types) and bit vectors. This should be
+--   used when the data type uses bit vectors.
+--
+-- * 'EvalModeSpecified' specifies a that an evaluation mode tag should be
+--   specialized to a specific tag for all the instances.
+data EvalModeConfig
+  = EvalModeConstraints [Name]
+  | EvalModeSpecified EvalModeTag
+
+-- | Configuration for deriving instances for a data type.
+data DeriveConfig = DeriveConfig
+  { evalModeConfig :: [(Int, EvalModeConfig)],
+    bitSizePositions :: [Int],
+    fpBitSizePositions :: [(Int, Int)],
+    unconstrainedPositions :: [Int],
+    needExtraMergeableUnderEvalMode :: Bool,
+    needExtraMergeableWithConcretizedEvalMode :: Bool,
+    useNoStrategy :: Bool,
+    useSerialForCerealAndBinary :: Bool
+  }
+
+-- | Get all the evaluation modes to specialize in the t'DeriveConfig'.
+evalModeSpecializeList :: DeriveConfig -> [(Int, EvalModeTag)]
+evalModeSpecializeList DeriveConfig {..} =
+  mapMaybe
+    ( \(n, cfg) ->
+        case cfg of
+          EvalModeConstraints _ -> Nothing
+          EvalModeSpecified tag -> Just (n, tag)
+    )
+    evalModeConfig
+
+instance Semigroup DeriveConfig where
+  l <> r =
+    DeriveConfig
+      { evalModeConfig = evalModeConfig l <> evalModeConfig r,
+        bitSizePositions = bitSizePositions l <> bitSizePositions r,
+        fpBitSizePositions = fpBitSizePositions l <> fpBitSizePositions r,
+        unconstrainedPositions = unconstrainedPositions l <> unconstrainedPositions r,
+        needExtraMergeableUnderEvalMode =
+          needExtraMergeableUnderEvalMode l
+            || needExtraMergeableUnderEvalMode r,
+        needExtraMergeableWithConcretizedEvalMode =
+          needExtraMergeableWithConcretizedEvalMode l
+            || needExtraMergeableWithConcretizedEvalMode r,
+        useNoStrategy = useNoStrategy l || useNoStrategy r,
+        useSerialForCerealAndBinary =
+          useSerialForCerealAndBinary l && useSerialForCerealAndBinary r
+      }
+
+instance Monoid DeriveConfig where
+  mempty = DeriveConfig [] [] [] [] False False False True
+  mappend = (<>)
+
+-- | Generate extra constraints for evaluation modes.
+extraEvalModeConstraint ::
+  Name -> Name -> [(Type, Kind)] -> (Int, EvalModeConfig) -> Q [Pred]
+extraEvalModeConstraint
+  tyName
+  instanceName
+  args
+  (n, EvalModeConstraints names)
+    | n >= length args = return []
+    | otherwise = do
+        let (arg, argKind) = args !! n
+        when (argKind /= ConT ''EvalModeTag) $
+          fail $
+            "Cannot introduce EvalMode constraint for the "
+              <> show n
+              <> "th argument of "
+              <> show tyName
+              <> " when deriving the "
+              <> show instanceName
+              <> " instance because it is not an EvalModeTag."
+        traverse (\nm -> [t|$(conT nm) $(return arg)|]) names
+extraEvalModeConstraint _ _ _ (_, EvalModeSpecified _) = return []
+
+-- | Generate extra constraints for bit vectors.
+extraBitSizeConstraint :: Name -> Name -> [(Type, Kind)] -> Int -> Q [Pred]
+extraBitSizeConstraint tyName instanceName args n
+  | n >= length args = return []
+  | otherwise = do
+      let (arg, argKind) = args !! n
+      when (argKind /= ConT ''Nat) $
+        fail $
+          "Cannot introduce BitSize constraint for the "
+            <> show n
+            <> "th argument of "
+            <> show tyName
+            <> " when deriving the "
+            <> show instanceName
+            <> " instance because it is not a Nat."
+      predKnown <- [t|KnownNat $(return arg)|]
+      predPositive <- [t|1 <= $(return arg)|]
+      return [predKnown, predPositive]
+
+-- | Generate extra constraints for floating point exponents and significands.
+extraFpBitSizeConstraint ::
+  Name -> Name -> [(Type, Kind)] -> (Int, Int) -> Q [Pred]
+extraFpBitSizeConstraint tyName instanceName args (eb, sb)
+  | eb >= length args || sb >= length args = return []
+  | otherwise = do
+      let (argEb, argEbKind) = args !! eb
+      let (argSb, argSbKind) = args !! sb
+      when (argEbKind /= ConT ''Nat || argSbKind /= ConT ''Nat) $
+        fail $
+          "Cannot introduce ValidFP constraint for the "
+            <> show eb
+            <> "th and "
+            <> show sb
+            <> "th arguments of "
+            <> show tyName
+            <> " when deriving the "
+            <> show instanceName
+            <> " instance because they are not Nats."
+      pred <- [t|ValidFP $(return argEb) $(return argSb)|]
+      return [pred]
+
+-- | Generate extra constraints for 'Mergeable' instances.
+extraExtraMergeableConstraint ::
+  DeriveConfig -> [ConstructorInfo] -> [(Type, Kind)] -> Q [Pred]
+extraExtraMergeableConstraint deriveConfig constructors args = do
+  let isTypeUsedInFields' (VarT nm) =
+        isVarUsedInConstructorFields constructors nm
+      isTypeUsedInFields' _ = False
+  catMaybes
+    <$> zipWithM
+      ( \position (arg, knd) ->
+          if isTypeUsedInFields' arg
+            && notElem position (unconstrainedPositions deriveConfig)
+            then
+              ctxForVar
+                [ ConT ''Mergeable,
+                  ConT ''Mergeable1,
+                  ConT ''Mergeable2
+                ]
+                arg
+                knd
+            else return Nothing
+      )
+      [0 ..]
+      args
+
+-- | Generate extra constraints for a data type.
+extraConstraint ::
+  DeriveConfig ->
+  Name ->
+  Name ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [ConstructorInfo] ->
+  Q [Pred]
+extraConstraint
+  deriveConfig@DeriveConfig {..}
+  tyName
+  instanceName
+  extraArgs
+  keptArgs
+  constructors = do
+    evalModePreds <-
+      traverse
+        (extraEvalModeConstraint tyName instanceName keptArgs)
+        evalModeConfig
+    extraArgEvalModePreds <-
+      if null evalModeConfig
+        then
+          traverse
+            ( \(arg, kind) ->
+                if kind == ConT ''EvalModeTag
+                  then (: []) <$> [t|DecideEvalMode $(return arg)|]
+                  else return []
+            )
+            extraArgs
+        else return []
+    bitSizePreds <-
+      traverse
+        (extraBitSizeConstraint tyName instanceName keptArgs)
+        bitSizePositions
+    fpBitSizePreds <-
+      traverse
+        (extraFpBitSizeConstraint tyName instanceName keptArgs)
+        fpBitSizePositions
+    extraMergeablePreds <-
+      if needExtraMergeableUnderEvalMode
+        && ( any
+               ( \case
+                   (_, EvalModeConstraints _) -> True
+                   (_, EvalModeSpecified _) -> False
+               )
+               evalModeConfig
+               || needExtraMergeableWithConcretizedEvalMode
+           )
+        then extraExtraMergeableConstraint deriveConfig constructors keptArgs
+        else return []
+    return $
+      concat (extraArgEvalModePreds ++ evalModePreds)
+        ++ if null constructors
+          then []
+          else extraMergeablePreds ++ concat (bitSizePreds ++ fpBitSizePreds)
diff --git a/src/Grisette/Internal/TH/Derivation/ConvertOpCommon.hs b/src/Grisette/Internal/TH/Derivation/ConvertOpCommon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/ConvertOpCommon.hs
@@ -0,0 +1,453 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.ConvertOpCommon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.ConvertOpCommon
+  ( genConvertOpClass,
+    ConvertOpClassConfig (..),
+    defaultFieldFunExp,
+  )
+where
+
+import Control.Monad (foldM, replicateM, zipWithM)
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, mapMaybe)
+import qualified Data.Set as S
+import Grisette.Internal.Core.Data.Class.PlainUnion (unionToCon)
+import Grisette.Internal.Internal.Decl.Core.Control.Monad.Union (Union)
+import Grisette.Internal.Internal.Decl.Core.Data.Class.TryMerge (toUnionSym)
+import Grisette.Internal.TH.Derivation.Common
+  ( CheckArgsResult (argVars, constructors, keptVars),
+    DeriveConfig
+      ( DeriveConfig,
+        bitSizePositions,
+        evalModeConfig,
+        fpBitSizePositions,
+        needExtraMergeableUnderEvalMode,
+        needExtraMergeableWithConcretizedEvalMode,
+        unconstrainedPositions
+      ),
+    EvalModeConfig (EvalModeConstraints, EvalModeSpecified),
+    checkArgs,
+    extraBitSizeConstraint,
+    extraEvalModeConstraint,
+    extraExtraMergeableConstraint,
+    extraFpBitSizeConstraint,
+    freshenCheckArgsResult,
+    isVarUsedInFields,
+  )
+import Grisette.Internal.TH.Util (allUsedNames)
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C, S))
+import Grisette.Internal.Unified.Util
+  ( EvalModeConvertible (withModeConvertible'),
+  )
+import Language.Haskell.TH
+  ( Body (NormalB),
+    Clause (Clause),
+    Dec (FunD, InstanceD),
+    Exp (VarE),
+    Kind,
+    Name,
+    Overlap (Incoherent),
+    Pat (VarP, WildP),
+    Pred,
+    Q,
+    Type (AppT, ArrowT, ConT, StarT, VarT),
+    clause,
+    conP,
+    funD,
+    nameBase,
+    newName,
+    normalB,
+    varE,
+    varP,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorInfo (constructorFields, constructorName),
+    TypeSubstitution (freeVariables),
+    resolveTypeSynonyms,
+  )
+
+type FieldFunExp = M.Map Name Name -> Type -> Q Exp
+
+-- | Default field transformation function.
+defaultFieldFunExp :: [Name] -> FieldFunExp
+defaultFieldFunExp binaryOpFunNames argToFunPat = go
+  where
+    go ty = do
+      let allArgNames = M.keysSet argToFunPat
+      let typeHasNoArg ty =
+            S.fromList (freeVariables [ty])
+              `S.intersection` allArgNames
+              == S.empty
+      let fun0 = varE $ head binaryOpFunNames
+          fun1 b = [|$(varE $ binaryOpFunNames !! 1) $(go b)|]
+          fun2 b c = [|$(varE $ binaryOpFunNames !! 2) $(go b) $(go c)|]
+          fun3 b c d =
+            [|$(varE $ binaryOpFunNames !! 3) $(go b) $(go c) $(go d)|]
+      case ty of
+        AppT (AppT (AppT (VarT _) b) c) d -> fun3 b c d
+        AppT (AppT (VarT _) b) c -> fun2 b c
+        AppT (VarT _) b -> fun1 b
+        _ | typeHasNoArg ty -> fun0
+        AppT a b | typeHasNoArg a -> fun1 b
+        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
+        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3 b c d
+        VarT nm -> case M.lookup nm argToFunPat of
+          Just pname -> varE pname
+          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+
+funPatAndExps ::
+  FieldFunExp ->
+  [(Type, Kind)] ->
+  [Type] ->
+  Q ([Pat], [Exp])
+funPatAndExps fieldFunExpGen argTypes fields = do
+  let usedArgs = S.fromList $ freeVariables fields
+  args <-
+    traverse
+      ( \(ty, _) ->
+          case ty of
+            VarT nm ->
+              if S.member nm usedArgs
+                then do
+                  pname <- newName "p"
+                  return (nm, Just pname)
+                else return ('undefined, Nothing)
+            _ -> return ('undefined, Nothing)
+      )
+      argTypes
+  let argToFunPat =
+        M.fromList $ mapMaybe (\(ty, mpat) -> fmap (ty,) mpat) args
+  let funPats = fmap (maybe WildP VarP . snd) args
+  defaultFieldFunExps <- traverse (fieldFunExpGen argToFunPat) fields
+  return (funPats, defaultFieldFunExps)
+
+tagPair ::
+  DeriveConfig ->
+  EvalModeTag ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [(Type, Type)]
+tagPair deriveConfig convertOpTarget lhsKeptVars rhsKeptVars =
+  let conKeptVars =
+        if convertOpTarget == S then lhsKeptVars else rhsKeptVars
+      symKeptVars =
+        if convertOpTarget == S then rhsKeptVars else lhsKeptVars
+   in mapMaybe
+        ( \case
+            (n, EvalModeConstraints _)
+              | n < length conKeptVars && n >= 0 ->
+                  Just (fst $ conKeptVars !! n, fst $ symKeptVars !! n)
+            _ -> Nothing
+        )
+        (evalModeConfig deriveConfig)
+
+caseSplitTagPairs ::
+  DeriveConfig ->
+  EvalModeTag ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  Exp ->
+  Q Exp
+caseSplitTagPairs deriveConfig convertOpTarget lhsKeptVars rhsKeptVars exp = do
+  let tags = tagPair deriveConfig convertOpTarget lhsKeptVars rhsKeptVars
+  foldM
+    ( \exp (lty, rty) ->
+        [|
+          withModeConvertible'
+            @($(return lty))
+            @($(return rty))
+            $(return exp)
+            $(return exp)
+            $(return exp)
+          |]
+    )
+    exp
+    tags
+
+genConvertOpFieldClause ::
+  DeriveConfig ->
+  ConvertOpClassConfig ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  ConstructorInfo ->
+  Q Clause
+genConvertOpFieldClause
+  deriveConfig@DeriveConfig {..}
+  ConvertOpClassConfig {..}
+  lhsKeptTypes
+  rhsKeptTypes
+  lhsArgTypes
+  _rhsArgTypes
+  lhsConInfo = do
+    fields <- mapM resolveTypeSynonyms $ constructorFields lhsConInfo
+    (funPats, defaultFieldFunExps) <- funPatAndExps convertFieldFunExp lhsArgTypes fields
+    fieldsPatNames <- replicateM (length fields) $ newName "field"
+    fieldPats <- conP (constructorName lhsConInfo) (fmap varP fieldsPatNames)
+    let fieldPatExps = fmap VarE fieldsPatNames
+    fieldResExps <- zipWithM convertFieldResFun fieldPatExps defaultFieldFunExps
+    resExp <- convertFieldCombineFun (constructorName lhsConInfo) fieldResExps
+    let resUsedNames = allUsedNames resExp
+    let transformPat (VarP nm) =
+          if S.member nm resUsedNames then VarP nm else WildP
+        transformPat p = p
+    resExpWithTags <-
+      caseSplitTagPairs
+        deriveConfig
+        convertOpTarget
+        lhsKeptTypes
+        rhsKeptTypes
+        resExp
+    return $
+      Clause
+        (fmap transformPat $ funPats ++ [fieldPats])
+        (NormalB resExpWithTags)
+        []
+
+genConvertOpFun ::
+  DeriveConfig ->
+  ConvertOpClassConfig ->
+  Int ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [ConstructorInfo] ->
+  Q Dec
+genConvertOpFun _ convertOpClassConfig n _ _ _ _ [] = do
+  let instanceFunName = (convertOpFunNames convertOpClassConfig) !! n
+  funD instanceFunName [clause [] (normalB [|error "impossible"|]) []]
+genConvertOpFun
+  deriveConfig
+  convertOpClassConfig
+  n
+  lhsKeptTypes
+  rhsKeptTypes
+  lhsArgTypes
+  rhsArgTypes
+  lhsConstructors = do
+    clauses <-
+      traverse
+        ( genConvertOpFieldClause
+            deriveConfig
+            convertOpClassConfig
+            lhsKeptTypes
+            rhsKeptTypes
+            lhsArgTypes
+            rhsArgTypes
+        )
+        lhsConstructors
+    let instanceFunName = (convertOpFunNames convertOpClassConfig) !! n
+    return $ FunD instanceFunName clauses
+
+-- | Configuration for a convert operation class.
+data ConvertOpClassConfig = ConvertOpClassConfig
+  { convertOpTarget :: EvalModeTag,
+    convertOpInstanceNames :: [Name],
+    convertOpFunNames :: [Name],
+    convertFieldResFun :: Exp -> Exp -> Q Exp,
+    convertFieldCombineFun :: Name -> [Exp] -> Q Exp,
+    convertFieldFunExp :: FieldFunExp
+  }
+
+convertCtxForVar :: [Type] -> Type -> Type -> Kind -> Q (Maybe Pred)
+convertCtxForVar instanceExps lty rty knd = case knd of
+  StarT ->
+    Just
+      <$> [t|$(return $ head instanceExps) $(return lty) $(return rty)|]
+  AppT (AppT ArrowT StarT) StarT ->
+    Just
+      <$> [t|$(return $ instanceExps !! 1) $(return lty) $(return rty)|]
+  AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
+    Just
+      <$> [t|$(return $ instanceExps !! 2) $(return lty) $(return rty)|]
+  AppT (AppT (AppT StarT StarT) StarT) _ ->
+    fail $ "Unsupported kind: " <> show knd
+  _ -> return Nothing
+
+-- | Generate extra constraints for a data type.
+extraConstraintConvert ::
+  DeriveConfig ->
+  EvalModeTag ->
+  Name ->
+  Name ->
+  [(Type, Kind)] ->
+  [(Type, Kind)] ->
+  [ConstructorInfo] ->
+  Q [Pred]
+extraConstraintConvert
+  deriveConfig@DeriveConfig {..}
+  convertOpTarget
+  tyName
+  instanceName
+  lhsKeptArgs
+  rhsKeptArgs
+  rhsConstructors = do
+    let conKeptVars = if convertOpTarget == S then lhsKeptArgs else rhsKeptArgs
+    let symKeptVars = if convertOpTarget == S then rhsKeptArgs else lhsKeptArgs
+
+    rhsEvalModePreds <-
+      if convertOpTarget == S && needExtraMergeableWithConcretizedEvalMode
+        then
+          traverse
+            (extraEvalModeConstraint tyName instanceName rhsKeptArgs)
+            evalModeConfig
+        else return []
+    extraArgEvalModePreds <-
+      traverse
+        ( \case
+            (n, EvalModeConstraints _)
+              | n < length lhsKeptArgs && n >= 0 ->
+                  (: [])
+                    <$> [t|
+                      EvalModeConvertible
+                        $(return $ fst $ conKeptVars !! n)
+                        $(return $ fst $ symKeptVars !! n)
+                      |]
+            _ -> return []
+        )
+        evalModeConfig
+    bitSizePreds <-
+      traverse
+        (extraBitSizeConstraint tyName instanceName lhsKeptArgs)
+        bitSizePositions
+    fpBitSizePreds <-
+      traverse
+        (extraFpBitSizeConstraint tyName instanceName lhsKeptArgs)
+        fpBitSizePositions
+    extraMergeablePreds <-
+      if convertOpTarget == S
+        && ( any
+               ( \case
+                   (_, EvalModeConstraints _) -> True
+                   (_, EvalModeSpecified _) -> False
+               )
+               evalModeConfig
+               || needExtraMergeableWithConcretizedEvalMode
+           )
+        then extraExtraMergeableConstraint deriveConfig rhsConstructors rhsKeptArgs
+        else return []
+    return $
+      concat
+        ( rhsEvalModePreds
+            ++ extraArgEvalModePreds
+            ++ bitSizePreds
+            ++ fpBitSizePreds
+            ++ [extraMergeablePreds]
+        )
+
+-- | Generate a convert operation class instance.
+genConvertOpClass ::
+  DeriveConfig -> ConvertOpClassConfig -> Int -> Name -> Q [Dec]
+genConvertOpClass deriveConfig (ConvertOpClassConfig {..}) n typName = do
+  oldLhsResult <-
+    freshenCheckArgsResult True
+      =<< checkArgs
+        (nameBase $ head convertOpInstanceNames)
+        (length convertOpInstanceNames - 1)
+        typName
+        False
+        n
+  oldRhsResult <- freshenCheckArgsResult False oldLhsResult
+  let lResult = oldLhsResult
+  let rResult = oldRhsResult
+  let instanceName = convertOpInstanceNames !! n
+  let lKeptVars = keptVars lResult
+  let rKeptVars = keptVars rResult
+  let lConstructors = constructors lResult
+  let rConstructors = constructors rResult
+  let lKeptType = foldl AppT (ConT typName) $ fmap fst lKeptVars
+  let rKeptType = foldl AppT (ConT typName) $ fmap fst rKeptVars
+  extraPreds <-
+    extraConstraintConvert
+      deriveConfig
+      convertOpTarget
+      typName
+      instanceName
+      lKeptVars
+      rKeptVars
+      rConstructors
+  unionExtraPreds <-
+    extraConstraintConvert
+      deriveConfig {needExtraMergeableWithConcretizedEvalMode = True}
+      convertOpTarget
+      typName
+      instanceName
+      lKeptVars
+      rKeptVars
+      rConstructors
+
+  let instanceType = AppT (AppT (ConT instanceName) lKeptType) rKeptType
+  let isTypeUsedInFields (VarT nm) = isVarUsedInFields lResult nm
+      isTypeUsedInFields _ = False
+  ctxs <-
+    traverse
+      ( \(position, ((lty, knd), (rty, _))) ->
+          if position `elem` unconstrainedPositions deriveConfig
+            then return Nothing
+            else convertCtxForVar (ConT <$> convertOpInstanceNames) lty rty knd
+      )
+      $ filter (isTypeUsedInFields . fst . fst . snd)
+      $ zip [0 ..]
+      $ zip lKeptVars rKeptVars
+
+  instanceFun <-
+    genConvertOpFun
+      deriveConfig
+      (ConvertOpClassConfig {..})
+      n
+      (keptVars lResult)
+      (keptVars rResult)
+      (argVars lResult)
+      (argVars rResult)
+      lConstructors
+
+  let instanceUnionType =
+        case convertOpTarget of
+          S ->
+            AppT
+              (AppT (ConT instanceName) lKeptType)
+              (AppT (ConT ''Union) rKeptType)
+          C ->
+            AppT
+              (AppT (ConT instanceName) (AppT (ConT ''Union) lKeptType))
+              rKeptType
+  instanceUnionFun <- do
+    resExp <-
+      if convertOpTarget == S
+        then varE 'toUnionSym
+        else varE 'unionToCon
+    funD (head convertOpFunNames) [clause [] (normalB $ return resExp) []]
+
+  return $
+    InstanceD
+      (Just Incoherent)
+      (extraPreds ++ if null (constructors lResult) then [] else catMaybes ctxs)
+      instanceType
+      [instanceFun]
+      : ( [ InstanceD
+              (Just Incoherent)
+              ( unionExtraPreds
+                  ++ if null (constructors lResult)
+                    then []
+                    else catMaybes ctxs
+              )
+              instanceUnionType
+              [instanceUnionFun]
+          | n == 0
+          ]
+        )
diff --git a/src/Grisette/Internal/TH/Derivation/Derive.hs b/src/Grisette/Internal/TH/Derivation/Derive.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/Derive.hs
@@ -0,0 +1,968 @@
+{-# LANGUAGE LambdaCase #-}
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.Derive
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.Derive
+  ( derive,
+    deriveWith,
+    allClasses0,
+    allClasses01,
+    allClasses012,
+    basicClasses0,
+    noExistentialClasses0,
+    concreteOrdClasses0,
+    basicClasses1,
+    noExistentialClasses1,
+    concreteOrdClasses1,
+    basicClasses2,
+    noExistentialClasses2,
+    concreteOrdClasses2,
+    showClasses,
+    pprintClasses,
+    evalSymClasses,
+    extractSymClasses,
+    substSymClasses,
+    allSymsClasses,
+    eqClasses,
+    ordClasses,
+    symOrdClasses,
+    symEqClasses,
+    unifiedSymOrdClasses,
+    unifiedSymEqClasses,
+    mergeableClasses,
+    nfDataClasses,
+    hashableClasses,
+    toSymClasses,
+    toConClasses,
+    serialClasses,
+    simpleMergeableClasses,
+    unifiedSimpleMergeableClasses,
+    filterExactNumArgs,
+    filterLeqNumArgs,
+  )
+where
+
+import Control.Arrow (Arrow (second))
+import Control.DeepSeq (NFData, NFData1, NFData2)
+import Data.Binary (Binary)
+import Data.Bytes.Serial (Serial, Serial1, Serial2)
+import Data.Functor.Classes (Eq1, Eq2, Ord1, Ord2, Show1, Show2)
+import Data.Hashable (Hashable)
+import Data.Hashable.Lifted (Hashable1, Hashable2)
+import qualified Data.Map as M
+import Data.Serialize (Serialize)
+import qualified Data.Set as S
+import Grisette.Internal.Internal.Decl.Core.Data.Class.EvalSym
+  ( EvalSym,
+    EvalSym1,
+    EvalSym2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.ExtractSym
+  ( ExtractSym,
+    ExtractSym1,
+    ExtractSym2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
+  ( Mergeable,
+    Mergeable1,
+    Mergeable2,
+    Mergeable3,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.PPrint
+  ( PPrint,
+    PPrint1,
+    PPrint2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SimpleMergeable
+  ( SimpleMergeable,
+    SimpleMergeable1,
+    SimpleMergeable2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SubstSym
+  ( SubstSym,
+    SubstSym1,
+    SubstSym2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SymEq
+  ( SymEq,
+    SymEq1,
+    SymEq2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SymOrd
+  ( SymOrd,
+    SymOrd1,
+    SymOrd2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.ToCon
+  ( ToCon,
+    ToCon1,
+    ToCon2,
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.ToSym
+  ( ToSym,
+    ToSym1,
+    ToSym2,
+  )
+import Grisette.Internal.Internal.Decl.SymPrim.AllSyms
+  ( AllSyms,
+    AllSyms1,
+    AllSyms2,
+  )
+import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSimpleMergeable
+  ( UnifiedSimpleMergeable,
+    UnifiedSimpleMergeable1,
+    UnifiedSimpleMergeable2,
+  )
+import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymEq
+  ( UnifiedSymEq,
+    UnifiedSymEq1,
+    UnifiedSymEq2,
+  )
+import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymOrd
+  ( UnifiedSymOrd,
+    UnifiedSymOrd1,
+    UnifiedSymOrd2,
+  )
+import Grisette.Internal.TH.Derivation.Common
+  ( DeriveConfig
+      ( evalModeConfig,
+        needExtraMergeableUnderEvalMode,
+        needExtraMergeableWithConcretizedEvalMode
+      ),
+    EvalModeConfig (EvalModeConstraints, EvalModeSpecified),
+  )
+import Grisette.Internal.TH.Derivation.DeriveAllSyms
+  ( deriveAllSyms,
+    deriveAllSyms1,
+    deriveAllSyms2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveBinary (deriveBinary)
+import Grisette.Internal.TH.Derivation.DeriveCereal (deriveCereal)
+import Grisette.Internal.TH.Derivation.DeriveEq
+  ( deriveEq,
+    deriveEq1,
+    deriveEq2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveEvalSym
+  ( deriveEvalSym,
+    deriveEvalSym1,
+    deriveEvalSym2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveExtractSym
+  ( deriveExtractSym,
+    deriveExtractSym1,
+    deriveExtractSym2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveHashable
+  ( deriveHashable,
+    deriveHashable1,
+    deriveHashable2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveMergeable (genMergeableList)
+import Grisette.Internal.TH.Derivation.DeriveNFData
+  ( deriveNFData,
+    deriveNFData1,
+    deriveNFData2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveOrd
+  ( deriveOrd,
+    deriveOrd1,
+    deriveOrd2,
+  )
+import Grisette.Internal.TH.Derivation.DerivePPrint
+  ( derivePPrint,
+    derivePPrint1,
+    derivePPrint2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveSerial
+  ( deriveSerial,
+    deriveSerial1,
+    deriveSerial2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveShow
+  ( deriveShow,
+    deriveShow1,
+    deriveShow2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveSimpleMergeable
+  ( deriveSimpleMergeable,
+    deriveSimpleMergeable1,
+    deriveSimpleMergeable2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveSubstSym
+  ( deriveSubstSym,
+    deriveSubstSym1,
+    deriveSubstSym2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveSymEq
+  ( deriveSymEq,
+    deriveSymEq1,
+    deriveSymEq2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveSymOrd
+  ( deriveSymOrd,
+    deriveSymOrd1,
+    deriveSymOrd2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveToCon
+  ( deriveToCon,
+    deriveToCon1,
+    deriveToCon2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveToSym
+  ( deriveToSym,
+    deriveToSym1,
+    deriveToSym2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveUnifiedSimpleMergeable
+  ( deriveUnifiedSimpleMergeable,
+    deriveUnifiedSimpleMergeable1,
+    deriveUnifiedSimpleMergeable2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveUnifiedSymEq
+  ( deriveUnifiedSymEq,
+    deriveUnifiedSymEq1,
+    deriveUnifiedSymEq2,
+  )
+import Grisette.Internal.TH.Derivation.DeriveUnifiedSymOrd
+  ( deriveUnifiedSymOrd,
+    deriveUnifiedSymOrd1,
+    deriveUnifiedSymOrd2,
+  )
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C, S))
+import Language.Haskell.TH (Dec, Name, Q)
+
+deriveProcedureMap :: M.Map Name (DeriveConfig -> Name -> Q [Dec])
+deriveProcedureMap =
+  M.fromList
+    [ (''EvalSym, deriveEvalSym),
+      (''EvalSym1, deriveEvalSym1),
+      (''EvalSym2, deriveEvalSym2),
+      (''ExtractSym, deriveExtractSym),
+      (''ExtractSym1, deriveExtractSym1),
+      (''ExtractSym2, deriveExtractSym2),
+      (''SubstSym, deriveSubstSym),
+      (''SubstSym1, deriveSubstSym1),
+      (''SubstSym2, deriveSubstSym2),
+      (''NFData, deriveNFData),
+      (''NFData1, deriveNFData1),
+      (''NFData2, deriveNFData2),
+      (''Hashable, deriveHashable),
+      (''Hashable1, deriveHashable1),
+      (''Hashable2, deriveHashable2),
+      (''Show, deriveShow),
+      (''Show1, deriveShow1),
+      (''Show2, deriveShow2),
+      (''PPrint, derivePPrint),
+      (''PPrint1, derivePPrint1),
+      (''PPrint2, derivePPrint2),
+      (''AllSyms, deriveAllSyms),
+      (''AllSyms1, deriveAllSyms1),
+      (''AllSyms2, deriveAllSyms2),
+      (''Eq, deriveEq),
+      (''Eq1, deriveEq1),
+      (''Eq2, deriveEq2),
+      (''Ord, deriveOrd),
+      (''Ord1, deriveOrd1),
+      (''Ord2, deriveOrd2),
+      (''SymOrd, deriveSymOrd),
+      (''SymOrd1, deriveSymOrd1),
+      (''SymOrd2, deriveSymOrd2),
+      (''SymEq, deriveSymEq),
+      (''SymEq1, deriveSymEq1),
+      (''SymEq2, deriveSymEq2),
+      (''UnifiedSymEq, deriveUnifiedSymEq),
+      (''UnifiedSymEq1, deriveUnifiedSymEq1),
+      (''UnifiedSymEq2, deriveUnifiedSymEq2),
+      (''UnifiedSymOrd, deriveUnifiedSymOrd),
+      (''UnifiedSymOrd1, deriveUnifiedSymOrd1),
+      (''UnifiedSymOrd2, deriveUnifiedSymOrd2),
+      (''ToSym, deriveToSym),
+      (''ToSym1, deriveToSym1),
+      (''ToSym2, deriveToSym2),
+      (''ToCon, deriveToCon),
+      (''ToCon1, deriveToCon1),
+      (''ToCon2, deriveToCon2),
+      (''Serial, deriveSerial),
+      (''Serial1, deriveSerial1),
+      (''Serial2, deriveSerial2),
+      (''SimpleMergeable, deriveSimpleMergeable),
+      (''SimpleMergeable1, deriveSimpleMergeable1),
+      (''SimpleMergeable2, deriveSimpleMergeable2),
+      (''UnifiedSimpleMergeable, deriveUnifiedSimpleMergeable),
+      (''UnifiedSimpleMergeable1, deriveUnifiedSimpleMergeable1),
+      (''UnifiedSimpleMergeable2, deriveUnifiedSimpleMergeable2),
+      (''Binary, deriveBinary),
+      (''Serialize, deriveCereal)
+    ]
+
+deriveSingle :: DeriveConfig -> Name -> Name -> Q [Dec]
+deriveSingle deriveConfig typName className = do
+  let newExtra
+        | className
+            `elem` [ ''Eq,
+                     ''Eq1,
+                     ''Eq2,
+                     ''SymEq,
+                     ''SymEq1,
+                     ''SymEq2,
+                     ''SymOrd,
+                     ''SymOrd1,
+                     ''SymOrd2,
+                     ''UnifiedSymEq,
+                     ''UnifiedSymEq1,
+                     ''UnifiedSymEq2,
+                     ''UnifiedSymOrd,
+                     ''UnifiedSymOrd1,
+                     ''UnifiedSymOrd2,
+                     ''UnifiedSimpleMergeable,
+                     ''UnifiedSimpleMergeable1,
+                     ''UnifiedSimpleMergeable2
+                   ] =
+            deriveConfig
+              { needExtraMergeableUnderEvalMode = False,
+                needExtraMergeableWithConcretizedEvalMode = False
+              }
+        | className
+            `elem` [''SimpleMergeable, ''SimpleMergeable1, ''SimpleMergeable2] =
+            deriveConfig
+              { evalModeConfig =
+                  second
+                    ( \case
+                        EvalModeConstraints _ -> EvalModeSpecified S
+                        EvalModeSpecified tag -> EvalModeSpecified tag
+                    )
+                    <$> evalModeConfig deriveConfig,
+                needExtraMergeableUnderEvalMode = False,
+                needExtraMergeableWithConcretizedEvalMode = False
+              }
+        | className `elem` [''Ord, ''Ord1, ''Ord2] =
+            deriveConfig
+              { evalModeConfig =
+                  second
+                    ( \case
+                        EvalModeConstraints _ -> EvalModeSpecified C
+                        EvalModeSpecified tag -> EvalModeSpecified tag
+                    )
+                    <$> evalModeConfig deriveConfig,
+                needExtraMergeableUnderEvalMode = False,
+                needExtraMergeableWithConcretizedEvalMode = False
+              }
+        | otherwise = deriveConfig
+  case M.lookup className deriveProcedureMap of
+    Just procedure -> procedure newExtra typName
+    Nothing ->
+      fail $ "No derivation available for class " ++ show className
+
+deriveWith' :: DeriveConfig -> Name -> [Name] -> Q [Dec]
+deriveWith' deriveConfig typName classNameList = do
+  let classNames = S.fromList classNameList
+  let (ns, ms) = splitMergeable $ S.toList classNames
+  decs <- mapM (deriveSingle deriveConfig typName) ns
+  decMergeables <- deriveMergeables ms
+  return $ concat decs ++ decMergeables
+  where
+    configWithOutExtraMergeable :: DeriveConfig
+    configWithOutExtraMergeable =
+      deriveConfig {needExtraMergeableUnderEvalMode = False}
+    deriveMergeables :: [Int] -> Q [Dec]
+    deriveMergeables = genMergeableList configWithOutExtraMergeable typName
+    splitMergeable :: [Name] -> ([Name], [Int])
+    splitMergeable [] = ([], [])
+    splitMergeable (x : xs) =
+      let (ns, is) = splitMergeable xs
+       in if
+            | x == ''Mergeable -> (ns, 0 : is)
+            | x == ''Mergeable1 -> (ns, 1 : is)
+            | x == ''Mergeable2 -> (ns, 2 : is)
+            | x == ''Mergeable3 -> (ns, 3 : is)
+            | otherwise -> (x : ns, is)
+
+-- | Derive the specified classes for a data type with the given name.
+--
+-- Support the following classes for both vanilla data types and GADTs.
+--
+-- * 'Mergeable'
+-- * 'Mergeable1'
+-- * 'Mergeable2'
+-- * 'Mergeable3'
+-- * 'EvalSym'
+-- * 'EvalSym1'
+-- * 'EvalSym2'
+-- * 'ExtractSym'
+-- * 'ExtractSym1'
+-- * 'ExtractSym2'
+-- * 'SubstSym'
+-- * 'SubstSym1'
+-- * 'SubstSym2'
+-- * 'NFData'
+-- * 'NFData1'
+-- * 'NFData2'
+-- * 'Hashable'
+-- * 'Hashable1'
+-- * 'Hashable2'
+-- * 'Show'
+-- * 'Show1'
+-- * 'Show2'
+-- * 'PPrint'
+-- * 'PPrint1'
+-- * 'PPrint2'
+-- * 'AllSyms'
+-- * 'AllSyms1'
+-- * 'AllSyms2'
+-- * 'Eq'
+-- * 'Eq1'
+-- * 'Eq2'
+-- * 'Ord'
+-- * 'Ord1'
+-- * 'Ord2'
+-- * 'SymOrd'
+-- * 'SymOrd1'
+-- * 'SymOrd2'
+-- * 'SymEq'
+-- * 'SymEq1'
+-- * 'SymEq2'
+-- * 'UnifiedSymEq'
+-- * 'UnifiedSymEq1'
+-- * 'UnifiedSymEq2'
+-- * 'UnifiedSymOrd'
+-- * 'UnifiedSymOrd1'
+-- * 'UnifiedSymOrd2'
+-- * 'ToSym'
+-- * 'ToSym1'
+-- * 'ToSym2'
+-- * 'ToCon'
+-- * 'ToCon1'
+-- * 'ToCon2'
+-- * 'Serial'
+-- * 'Serial1'
+-- * 'Serial2'
+-- * 'SimpleMergeable'
+-- * 'SimpleMergeable1'
+-- * 'SimpleMergeable2'
+-- * 'Binary'
+-- * 'Serialize'
+--
+-- Note that the following type classes cannot be derived for GADTs with
+-- existential type variables.
+--
+-- * 'ToCon'
+-- * 'ToCon1'
+-- * 'ToCon2'
+-- * 'ToSym'
+-- * 'ToSym1'
+-- * 'ToSym2'
+-- * 'Serial'
+-- * 'Serial1'
+-- * 'Serial2'
+-- * 'Binary'
+-- * 'Serialize'
+deriveWith :: DeriveConfig -> [Name] -> [Name] -> Q [Dec]
+deriveWith deriveConfig typeNameList classNameList = do
+  let typeNames = S.toList $ S.fromList typeNameList
+  concat
+    <$> traverse
+      (\typeName -> deriveWith' deriveConfig typeName classNameList)
+      typeNames
+
+-- | Derive the specified classes for a data type with the given name.
+--
+-- See 'deriveWith' for more details.
+derive :: [Name] -> [Name] -> Q [Dec]
+derive = deriveWith mempty
+
+-- | All the classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Mergeable'
+-- * 'EvalSym'
+-- * 'ExtractSym'
+-- * 'SubstSym'
+-- * 'NFData'
+-- * 'Hashable'
+-- * 'Show'
+-- * 'PPrint'
+-- * 'AllSyms'
+-- * 'Eq'
+-- * 'SymEq'
+-- * 'SymOrd'
+-- * 'UnifiedSymEq'
+-- * 'Ord'
+-- * 'UnifiedSymOrd'
+-- * 'Serial'
+-- * 'ToCon'
+-- * 'ToSym'
+allClasses0 :: [Name]
+allClasses0 = basicClasses0 ++ concreteOrdClasses0 ++ noExistentialClasses0
+
+-- | All the @*1@ classes that can be derived for GADT functors.
+--
+-- This includes:
+--
+-- * 'Mergeable1'
+-- * 'EvalSym1'
+-- * 'ExtractSym1'
+-- * 'SubstSym1'
+-- * 'NFData1'
+-- * 'Hashable1'
+-- * 'Show1'
+-- * 'PPrint1'
+-- * 'AllSyms1'
+-- * 'Eq1'
+-- * 'SymEq1'
+-- * 'SymOrd1'
+-- * 'UnifiedSymEq1'
+-- * 'Ord1'
+-- * 'UnifiedSymOrd1'
+-- * 'Serial1'
+-- * 'ToCon1'
+-- * 'ToSym1'
+allClasses1 :: [Name]
+allClasses1 = basicClasses1 ++ concreteOrdClasses1 ++ noExistentialClasses1
+
+-- | All the classes that can be derived for GADT functors.
+--
+-- This includes all the classes in 'allClasses0' and 'allClasses1'.
+allClasses01 :: [Name]
+allClasses01 = allClasses0 ++ allClasses1
+
+-- | All the @*2@ classes that can be derived for GADT functors.
+--
+-- This includes:
+--
+-- * 'Mergeable2'
+-- * 'EvalSym2'
+-- * 'ExtractSym2'
+-- * 'SubstSym2'
+-- * 'NFData2'
+-- * 'Hashable2'
+-- * 'Show2'
+-- * 'PPrint2'
+-- * 'AllSyms2'
+-- * 'Eq2'
+-- * 'SymEq2'
+-- * 'SymOrd2'
+-- * 'UnifiedSymEq2'
+-- * 'Ord2'
+-- * 'UnifiedSymOrd2'
+-- * 'Serial2'
+-- * 'ToCon2'
+-- * 'ToSym2'
+allClasses2 :: [Name]
+allClasses2 = basicClasses2 ++ concreteOrdClasses2 ++ noExistentialClasses2
+
+-- | All the classes that can be derived for GADT functors.
+--
+-- This includes all the classes in 'allClasses0', 'allClasses1',
+-- and 'allClasses2'.
+allClasses012 :: [Name]
+allClasses012 = allClasses0 ++ allClasses1 ++ allClasses2
+
+-- | Basic classes for GADTs.
+--
+-- This includes:
+--
+-- * 'Mergeable'
+-- * 'EvalSym'
+-- * 'ExtractSym'
+-- * 'SubstSym'
+-- * 'NFData'
+-- * 'Hashable'
+-- * 'Show'
+-- * 'PPrint'
+-- * 'AllSyms'
+-- * 'Eq'
+-- * 'SymEq'
+-- * 'SymOrd'
+-- * 'UnifiedSymEq'
+--
+-- These classes can be derived for most GADTs.
+basicClasses0 :: [Name]
+basicClasses0 =
+  [ ''Mergeable,
+    ''EvalSym,
+    ''ExtractSym,
+    ''SubstSym,
+    ''NFData,
+    ''Hashable,
+    ''Show,
+    ''PPrint,
+    ''AllSyms,
+    ''Eq,
+    ''SymEq,
+    ''SymOrd,
+    ''UnifiedSymEq
+  ]
+
+-- | Classes that can only be derived for GADTs without existential type
+-- variables.
+--
+-- This includes:
+--
+-- * 'Serial'
+-- * 'Serialize'
+-- * 'Binary'
+-- * 'ToCon'
+-- * 'ToSym'
+noExistentialClasses0 :: [Name]
+noExistentialClasses0 = [''Serial, ''ToCon, ''ToSym, ''Serialize, ''Binary]
+
+-- | Concrete ordered classes that can be derived for GADTs that
+--
+-- * uses unified evaluation mode, or
+-- * does not contain any symbolic variables.
+--
+-- This includes:
+--
+-- * 'Ord'
+-- * 'UnifiedSymOrd'
+concreteOrdClasses0 :: [Name]
+concreteOrdClasses0 = [''Ord, ''UnifiedSymOrd]
+
+-- | Basic classes for GADT functors.
+--
+-- This includes:
+--
+-- * 'Mergeable1'
+-- * 'EvalSym1'
+-- * 'ExtractSym1'
+-- * 'SubstSym1'
+-- * 'NFData1'
+-- * 'Hashable1'
+-- * 'Show1'
+-- * 'PPrint1'
+-- * 'AllSyms1'
+-- * 'Eq1'
+-- * 'SymEq1'
+-- * 'SymOrd1'
+-- * 'UnifiedSymEq1'
+basicClasses1 :: [Name]
+basicClasses1 =
+  [ ''Mergeable1,
+    ''EvalSym1,
+    ''ExtractSym1,
+    ''SubstSym1,
+    ''NFData1,
+    ''Hashable1,
+    ''Show1,
+    ''PPrint1,
+    ''AllSyms1,
+    ''Eq1,
+    ''SymEq1,
+    ''SymOrd1,
+    ''UnifiedSymEq1
+  ]
+
+-- | @*1@ classes that can only be derived for GADT functors without existential
+-- type variables.
+--
+-- This includes:
+--
+-- * 'Serial1'
+-- * 'ToCon1'
+-- * 'ToSym1'
+noExistentialClasses1 :: [Name]
+noExistentialClasses1 = [''Serial1, ''ToCon1, ''ToSym1]
+
+-- | @*1@ concrete ordered classes that can be derived for GADT functors that
+--
+-- * uses unified evaluation mode, or
+-- * does not contain any symbolic variables.
+--
+-- This includes:
+--
+-- * 'Ord1'
+-- * 'UnifiedSymOrd1'
+concreteOrdClasses1 :: [Name]
+concreteOrdClasses1 = [''Ord1, ''UnifiedSymOrd1]
+
+-- | Basic classes for GADT functors.
+--
+-- This includes:
+--
+-- * 'Mergeable2'
+-- * 'EvalSym2'
+-- * 'ExtractSym2'
+-- * 'SubstSym2'
+-- * 'NFData2'
+-- * 'Hashable2'
+-- * 'Show2'
+-- * 'PPrint2'
+-- * 'AllSyms2'
+-- * 'Eq2'
+-- * 'SymEq2'
+-- * 'SymOrd2'
+-- * 'UnifiedSymEq2'
+basicClasses2 :: [Name]
+basicClasses2 =
+  [ ''Mergeable2,
+    ''EvalSym2,
+    ''ExtractSym2,
+    ''SubstSym2,
+    ''NFData2,
+    ''Hashable2,
+    ''Show2,
+    ''PPrint2,
+    ''AllSyms2,
+    ''Eq2,
+    ''SymEq2,
+    ''SymOrd2,
+    ''UnifiedSymEq2
+  ]
+
+-- | @*2@ classes that can only be derived for GADT functors without existential
+-- type variables.
+--
+-- This includes:
+--
+-- * 'Serial2'
+-- * 'ToCon2'
+-- * 'ToSym2'
+noExistentialClasses2 :: [Name]
+noExistentialClasses2 = [''Serial2, ''ToCon2, ''ToSym2]
+
+-- | @*2@ concrete ordered classes that can be derived for GADT functors that
+--
+-- * uses unified evaluation mode, or
+-- * does not contain any symbolic variables.
+--
+-- This includes:
+--
+-- * 'Ord2'
+-- * 'UnifiedSymOrd2'
+concreteOrdClasses2 :: [Name]
+concreteOrdClasses2 = [''Ord2, ''UnifiedSymOrd2]
+
+-- | 'Show' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Show'
+-- * 'Show1'
+-- * 'Show2'
+showClasses :: [Name]
+showClasses = [''Show, ''Show1, ''Show2]
+
+-- | 'PPrint' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'PPrint'
+-- * 'PPrint1'
+-- * 'PPrint2'
+pprintClasses :: [Name]
+pprintClasses = [''PPrint, ''PPrint1, ''PPrint2]
+
+-- | 'EvalSym' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'EvalSym'
+-- * 'EvalSym1'
+-- * 'EvalSym2'
+evalSymClasses :: [Name]
+evalSymClasses = [''EvalSym, ''EvalSym1, ''EvalSym2]
+
+-- | 'ExtractSym' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'ExtractSym'
+-- * 'ExtractSym1'
+-- * 'ExtractSym2'
+extractSymClasses :: [Name]
+extractSymClasses = [''ExtractSym, ''ExtractSym1, ''ExtractSym2]
+
+-- | 'SubstSym' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'SubstSym'
+-- * 'SubstSym1'
+-- * 'SubstSym2'
+substSymClasses :: [Name]
+substSymClasses = [''SubstSym, ''SubstSym1, ''SubstSym2]
+
+-- | 'AllSyms' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'AllSyms'
+-- * 'AllSyms1'
+-- * 'AllSyms2'
+allSymsClasses :: [Name]
+allSymsClasses = [''AllSyms, ''AllSyms1, ''AllSyms2]
+
+-- | 'Eq' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Eq'
+-- * 'Eq1'
+-- * 'Eq2'
+eqClasses :: [Name]
+eqClasses = [''Eq, ''Eq1, ''Eq2]
+
+-- | 'SymEq' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'SymEq'
+-- * 'SymEq1'
+-- * 'SymEq2'
+symEqClasses :: [Name]
+symEqClasses = [''SymEq, ''SymEq1, ''SymEq2]
+
+-- | 'UnifiedSymEq' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'UnifiedSymEq'
+-- * 'UnifiedSymEq1'
+-- * 'UnifiedSymEq2'
+unifiedSymEqClasses :: [Name]
+unifiedSymEqClasses = [''UnifiedSymEq, ''UnifiedSymEq1, ''UnifiedSymEq2]
+
+-- | 'Ord' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Ord'
+-- * 'Ord1'
+-- * 'Ord2'
+ordClasses :: [Name]
+ordClasses = [''Ord, ''Ord1, ''Ord2]
+
+-- | 'SymOrd' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'SymOrd'
+-- * 'SymOrd1'
+-- * 'SymOrd2'
+symOrdClasses :: [Name]
+symOrdClasses = [''SymOrd, ''SymOrd1, ''SymOrd2]
+
+-- | 'UnifiedSymOrd' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'UnifiedSymOrd'
+-- * 'UnifiedSymOrd1'
+-- * 'UnifiedSymOrd2'
+unifiedSymOrdClasses :: [Name]
+unifiedSymOrdClasses = [''UnifiedSymOrd, ''UnifiedSymOrd1, ''UnifiedSymOrd2]
+
+-- | 'Mergeable' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Mergeable'
+-- * 'Mergeable1'
+-- * 'Mergeable2'
+-- * 'Mergeable3'
+mergeableClasses :: [Name]
+mergeableClasses = [''Mergeable, ''Mergeable1, ''Mergeable2, ''Mergeable3]
+
+-- | 'NFData' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'NFData'
+-- * 'NFData1'
+-- * 'NFData2'
+nfDataClasses :: [Name]
+nfDataClasses = [''NFData, ''NFData1, ''NFData2]
+
+-- | 'Hashable' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Hashable'
+-- * 'Hashable1'
+-- * 'Hashable2'
+hashableClasses :: [Name]
+hashableClasses = [''Hashable, ''Hashable1, ''Hashable2]
+
+-- | 'ToSym' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'ToSym'
+-- * 'ToSym1'
+-- * 'ToSym2'
+toSymClasses :: [Name]
+toSymClasses = [''ToSym, ''ToSym1, ''ToSym2]
+
+-- | 'ToCon' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'ToCon'
+-- * 'ToCon1'
+-- * 'ToCon2'
+toConClasses :: [Name]
+toConClasses = [''ToCon, ''ToCon1, ''ToCon2]
+
+-- | 'Serial' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'Serial'
+-- * 'Serial1'
+-- * 'Serial2'
+serialClasses :: [Name]
+serialClasses = [''Serial, ''Serial1, ''Serial2]
+
+-- | 'SimpleMergeable' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'SimpleMergeable'
+-- * 'SimpleMergeable1'
+-- * 'SimpleMergeable2'
+simpleMergeableClasses :: [Name]
+simpleMergeableClasses =
+  [''SimpleMergeable, ''SimpleMergeable1, ''SimpleMergeable2]
+
+-- | 'UnifiedSimpleMergeable' classes that can be derived for GADTs.
+--
+-- This includes:
+--
+-- * 'UnifiedSimpleMergeable'
+-- * 'UnifiedSimpleMergeable1'
+-- * 'UnifiedSimpleMergeable2'
+unifiedSimpleMergeableClasses :: [Name]
+unifiedSimpleMergeableClasses =
+  [ ''UnifiedSimpleMergeable,
+    ''UnifiedSimpleMergeable1,
+    ''UnifiedSimpleMergeable2
+  ]
+
+clsArgNumArgs :: Name -> Int
+clsArgNumArgs cls =
+  if
+    | cls `elem` allClasses0 -> 0
+    | cls `elem` allClasses1 -> 1
+    | cls `elem` allClasses2 -> 2
+    | cls == ''Mergeable3 -> 3
+    | otherwise -> error $ "clsArgNumArgs: unknown class: " ++ show cls
+
+-- | Filter classes that accepts type constructors with exactly @n@ arguments.
+filterExactNumArgs :: Int -> [Name] -> [Name]
+filterExactNumArgs n = filter (\cls -> clsArgNumArgs cls == n)
+
+-- | Filter classes that accepts type constructors with at most @n@ arguments.
+filterLeqNumArgs :: Int -> [Name] -> [Name]
+filterLeqNumArgs n = filter (\cls -> clsArgNumArgs cls <= n)
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveAllSyms.hs b/src/Grisette/Internal/TH/Derivation/DeriveAllSyms.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveAllSyms.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveAllSyms
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveAllSyms
+  ( deriveAllSyms,
+    deriveAllSyms1,
+    deriveAllSyms2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.SymPrim.AllSyms
+  ( AllSyms (allSymsS),
+    AllSyms1 (liftAllSymsS),
+    AllSyms2 (liftAllSymsS2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultFieldFunExp,
+    defaultFieldResFun,
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Exp (AppE, ListE, VarE), Name, Q)
+
+allSymsConfig :: UnaryOpClassConfig
+allSymsConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = [],
+                extraLiftedPatNames = const [],
+                fieldResFun = defaultFieldResFun,
+                fieldCombineFun = \_ _ _ _ _ exp ->
+                  return (AppE (VarE 'mconcat) $ ListE exp, False <$ exp),
+                fieldFunExp =
+                  defaultFieldFunExp
+                    [ 'allSymsS,
+                      'liftAllSymsS,
+                      'liftAllSymsS2
+                    ]
+              }
+            ['allSymsS, 'liftAllSymsS, 'liftAllSymsS2]
+        ],
+      unaryOpInstanceNames = [''AllSyms, ''AllSyms1, ''AllSyms2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'AllSyms' instance for a data type.
+deriveAllSyms :: DeriveConfig -> Name -> Q [Dec]
+deriveAllSyms deriveConfig = genUnaryOpClass deriveConfig allSymsConfig 0
+
+-- | Derive 'AllSyms1' instance for a data type.
+deriveAllSyms1 :: DeriveConfig -> Name -> Q [Dec]
+deriveAllSyms1 deriveConfig = genUnaryOpClass deriveConfig allSymsConfig 1
+
+-- | Derive 'AllSyms2' instance for a data type.
+deriveAllSyms2 :: DeriveConfig -> Name -> Q [Dec]
+deriveAllSyms2 deriveConfig = genUnaryOpClass deriveConfig allSymsConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveBinary.hs b/src/Grisette/Internal/TH/Derivation/DeriveBinary.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveBinary.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveBinary
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveBinary (deriveBinary) where
+
+import Data.Binary (Binary (get, put))
+import Grisette.Internal.TH.Derivation.Common
+  ( DeriveConfig (useSerialForCerealAndBinary),
+  )
+import Grisette.Internal.TH.Derivation.SerializeCommon
+  ( serializeConfig,
+    serializeWithSerialConfig,
+  )
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Name, Q)
+
+binaryConfig :: UnaryOpClassConfig
+binaryConfig = serializeConfig [''Binary] ['put] ['get]
+
+binaryWithSerialConfig :: UnaryOpClassConfig
+binaryWithSerialConfig =
+  serializeWithSerialConfig [''Binary] ['put] ['get]
+
+-- | Derive 'Binary' instance for a data type.
+deriveBinary :: DeriveConfig -> Name -> Q [Dec]
+deriveBinary deriveConfig =
+  genUnaryOpClass
+    deriveConfig
+    ( if useSerialForCerealAndBinary deriveConfig
+        then binaryWithSerialConfig
+        else binaryConfig
+    )
+    0
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveCereal.hs b/src/Grisette/Internal/TH/Derivation/DeriveCereal.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveCereal.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveCereal
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveCereal (deriveCereal) where
+
+import Data.Serialize (Serialize (get, put))
+import Grisette.Internal.TH.Derivation.Common
+  ( DeriveConfig (useSerialForCerealAndBinary),
+  )
+import Grisette.Internal.TH.Derivation.SerializeCommon
+  ( serializeConfig,
+    serializeWithSerialConfig,
+  )
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Name, Q)
+
+cerealConfig :: UnaryOpClassConfig
+cerealConfig = serializeConfig [''Serialize] ['put] ['get]
+
+cerealWithSerialConfig :: UnaryOpClassConfig
+cerealWithSerialConfig =
+  serializeWithSerialConfig [''Serialize] ['put] ['get]
+
+-- | Derive 'Serialize' instance for a data type.
+deriveCereal :: DeriveConfig -> Name -> Q [Dec]
+deriveCereal deriveConfig =
+  genUnaryOpClass
+    deriveConfig
+    ( if useSerialForCerealAndBinary deriveConfig
+        then cerealWithSerialConfig
+        else cerealConfig
+    )
+    0
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveEq.hs b/src/Grisette/Internal/TH/Derivation/DeriveEq.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveEq.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveEq
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveEq
+  ( deriveEq,
+    deriveEq1,
+    deriveEq2,
+  )
+where
+
+import Data.Functor.Classes (Eq1 (liftEq), Eq2 (liftEq2))
+import Grisette.Internal.TH.Derivation.BinaryOpCommon
+  ( BinaryOpClassConfig
+      ( BinaryOpClassConfig,
+        binaryOpAllowSumType,
+        binaryOpFieldConfigs,
+        binaryOpInstanceNames
+      ),
+    BinaryOpFieldConfig
+      ( BinaryOpFieldConfig,
+        extraPatNames,
+        fieldCombineFun,
+        fieldDifferentExistentialFun,
+        fieldFunExp,
+        fieldFunNames,
+        fieldLMatchResult,
+        fieldRMatchResult,
+        fieldResFun
+      ),
+    binaryOpAllowExistential,
+    defaultFieldFunExp,
+    genBinaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Language.Haskell.TH (Dec, Exp (ListE), Q)
+import Language.Haskell.TH.Syntax (Name)
+
+eqConfig :: BinaryOpClassConfig
+eqConfig =
+  BinaryOpClassConfig
+    { binaryOpFieldConfigs =
+        [ BinaryOpFieldConfig
+            { extraPatNames = [],
+              fieldResFun = \_ (lhs, rhs) f ->
+                (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
+              fieldCombineFun = \_ lst ->
+                (,[]) <$> [|and $(return $ ListE lst)|],
+              fieldDifferentExistentialFun = const [|False|],
+              fieldFunExp = defaultFieldFunExp ['(==), 'liftEq, 'liftEq2],
+              fieldFunNames = ['(==), 'liftEq, 'liftEq2],
+              fieldLMatchResult = [|False|],
+              fieldRMatchResult = [|False|]
+            }
+        ],
+      binaryOpInstanceNames = [''Eq, ''Eq1, ''Eq2],
+      binaryOpAllowSumType = True,
+      binaryOpAllowExistential = True
+    }
+
+-- | Derive 'Eq' instance for a data type.
+deriveEq :: DeriveConfig -> Name -> Q [Dec]
+deriveEq deriveConfig = genBinaryOpClass deriveConfig eqConfig 0
+
+-- | Derive 'Eq1' instance for a data type.
+deriveEq1 :: DeriveConfig -> Name -> Q [Dec]
+deriveEq1 deriveConfig = genBinaryOpClass deriveConfig eqConfig 1
+
+-- | Derive 'Eq2' instance for a data type.
+deriveEq2 :: DeriveConfig -> Name -> Q [Dec]
+deriveEq2 deriveConfig = genBinaryOpClass deriveConfig eqConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveEvalSym.hs b/src/Grisette/Internal/TH/Derivation/DeriveEvalSym.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveEvalSym.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveEvalSym
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveEvalSym
+  ( deriveEvalSym,
+    deriveEvalSym1,
+    deriveEvalSym2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.EvalSym
+  ( EvalSym (evalSym),
+    EvalSym1 (liftEvalSym),
+    EvalSym2 (liftEvalSym2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultFieldFunExp,
+    defaultFieldResFun,
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH
+  ( Dec,
+    Exp (AppE, ConE),
+    Name,
+    Q,
+  )
+
+evalSymConfig :: UnaryOpClassConfig
+evalSymConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = ["fillDefault", "model"],
+                extraLiftedPatNames = const [],
+                fieldResFun = defaultFieldResFun,
+                fieldCombineFun = \_ _ _ con extraPat exp -> do
+                  return (foldl AppE (ConE con) exp, False <$ extraPat),
+                fieldFunExp =
+                  defaultFieldFunExp ['evalSym, 'liftEvalSym, 'liftEvalSym2]
+              }
+            ['evalSym, 'liftEvalSym, 'liftEvalSym2]
+        ],
+      unaryOpInstanceNames =
+        [''EvalSym, ''EvalSym1, ''EvalSym2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'EvalSym' instance for a data type.
+deriveEvalSym :: DeriveConfig -> Name -> Q [Dec]
+deriveEvalSym deriveConfig = genUnaryOpClass deriveConfig evalSymConfig 0
+
+-- | Derive 'EvalSym1' instance for a data type.
+deriveEvalSym1 :: DeriveConfig -> Name -> Q [Dec]
+deriveEvalSym1 deriveConfig = genUnaryOpClass deriveConfig evalSymConfig 1
+
+-- | Derive 'EvalSym2' instance for a data type.
+deriveEvalSym2 :: DeriveConfig -> Name -> Q [Dec]
+deriveEvalSym2 deriveConfig = genUnaryOpClass deriveConfig evalSymConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveExtractSym.hs b/src/Grisette/Internal/TH/Derivation/DeriveExtractSym.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveExtractSym.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveExtractSym
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveExtractSym
+  ( deriveExtractSym,
+    deriveExtractSym1,
+    deriveExtractSym2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.ExtractSym
+  ( ExtractSym (extractSymMaybe),
+    ExtractSym1 (liftExtractSymMaybe),
+    ExtractSym2 (liftExtractSymMaybe2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultFieldFunExp,
+    defaultFieldResFun,
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH
+  ( Dec,
+    Exp (AppE, ListE, VarE),
+    Name,
+    Q,
+  )
+
+extractSymConfig :: UnaryOpClassConfig
+extractSymConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = [],
+                extraLiftedPatNames = const [],
+                fieldResFun = defaultFieldResFun,
+                fieldCombineFun = \_ _ _ _ _ exp ->
+                  if null exp
+                    then (,[]) <$> [|return mempty|]
+                    else return (AppE (VarE 'mconcat) $ ListE exp, False <$ exp),
+                fieldFunExp =
+                  defaultFieldFunExp
+                    [ 'extractSymMaybe,
+                      'liftExtractSymMaybe,
+                      'liftExtractSymMaybe2
+                    ]
+              }
+            [ 'extractSymMaybe,
+              'liftExtractSymMaybe,
+              'liftExtractSymMaybe2
+            ]
+        ],
+      unaryOpInstanceNames =
+        [''ExtractSym, ''ExtractSym1, ''ExtractSym2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'ExtractSym' instance for a data type.
+deriveExtractSym :: DeriveConfig -> Name -> Q [Dec]
+deriveExtractSym deriveConfig = genUnaryOpClass deriveConfig extractSymConfig 0
+
+-- | Derive 'ExtractSym1' instance for a data type.
+deriveExtractSym1 :: DeriveConfig -> Name -> Q [Dec]
+deriveExtractSym1 deriveConfig = genUnaryOpClass deriveConfig extractSymConfig 1
+
+-- | Derive 'ExtractSym2' instance for a data type.
+deriveExtractSym2 :: DeriveConfig -> Name -> Q [Dec]
+deriveExtractSym2 deriveConfig = genUnaryOpClass deriveConfig extractSymConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveHashable.hs b/src/Grisette/Internal/TH/Derivation/DeriveHashable.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveHashable.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveHashable
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveHashable
+  ( deriveHashable,
+    deriveHashable1,
+    deriveHashable2,
+  )
+where
+
+import Data.Hashable (Hashable (hashWithSalt))
+import Data.Hashable.Lifted
+  ( Hashable1 (liftHashWithSalt),
+    Hashable2 (liftHashWithSalt2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultFieldFunExp,
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Name, Q)
+
+hashableConfig :: UnaryOpClassConfig
+hashableConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = ["salt"],
+                extraLiftedPatNames = const [],
+                fieldCombineFun =
+                  \_ _ _ _ [salt] exp -> do
+                    r <-
+                      foldl
+                        (\salt exp -> [|$(return exp) $salt|])
+                        (return salt)
+                        exp
+                    return (r, [True]),
+                fieldResFun = \_ _ _ _ fieldPat fieldFun -> do
+                  r <- [|\salt -> $(return fieldFun) salt $(return fieldPat)|]
+                  return (r, [False]),
+                fieldFunExp =
+                  defaultFieldFunExp
+                    ['hashWithSalt, 'liftHashWithSalt, 'liftHashWithSalt2]
+              }
+            ['hashWithSalt, 'liftHashWithSalt, 'liftHashWithSalt2]
+        ],
+      unaryOpInstanceNames =
+        [''Hashable, ''Hashable1, ''Hashable2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'Hashable' instance for a data type.
+deriveHashable :: DeriveConfig -> Name -> Q [Dec]
+deriveHashable deriveConfig = genUnaryOpClass deriveConfig hashableConfig 0
+
+-- | Derive 'Hashable1' instance for a data type.
+deriveHashable1 :: DeriveConfig -> Name -> Q [Dec]
+deriveHashable1 deriveConfig = genUnaryOpClass deriveConfig hashableConfig 1
+
+-- | Derive 'Hashable2' instance for a data type.
+deriveHashable2 :: DeriveConfig -> Name -> Q [Dec]
+deriveHashable2 deriveConfig = genUnaryOpClass deriveConfig hashableConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveMergeable.hs b/src/Grisette/Internal/TH/Derivation/DeriveMergeable.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveMergeable.hs
@@ -0,0 +1,857 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveMergeable
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveMergeable
+  ( deriveMergeable,
+    deriveMergeable1,
+    deriveMergeable2,
+    deriveMergeable3,
+    genMergeableAndGetMergingInfoResult,
+    genMergeable,
+    genMergeable',
+    genMergeableNoExistential,
+    genMergeableNoStrategy,
+    genMergeableList,
+  )
+where
+
+import Control.Monad (foldM, replicateM, zipWithM)
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, isJust, mapMaybe)
+import qualified Data.Set as S
+import Data.Word (Word16, Word32, Word64, Word8)
+import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
+  ( Mergeable (rootStrategy),
+    Mergeable1 (liftRootStrategy),
+    Mergeable2 (liftRootStrategy2),
+    Mergeable3 (liftRootStrategy3),
+    MergingStrategy (NoStrategy, SimpleStrategy, SortedStrategy),
+    product2Strategy,
+    wrapStrategy,
+  )
+import Grisette.Internal.TH.Derivation.Common
+  ( CheckArgsResult
+      ( CheckArgsResult,
+        argVars,
+        constructors,
+        keptVars
+      ),
+    DeriveConfig (unconstrainedPositions, useNoStrategy),
+    checkArgs,
+    evalModeSpecializeList,
+    extraConstraint,
+    isVarUsedInFields,
+    specializeResult,
+  )
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( FieldFunExp,
+    UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFunConfig (genUnaryOpFun),
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Grisette.Internal.TH.Util (dataTypeHasExistential, integerE, mangleName)
+import Language.Haskell.TH
+  ( Bang (Bang),
+    Body (NormalB),
+    Clause (Clause),
+    Con (ForallC, GadtC),
+    Dec (DataD, FunD, InstanceD, PragmaD, SigD),
+    Exp (AppE, ConE, VarE),
+    Inline (Inline),
+    Kind,
+    Name,
+    Pat (SigP, VarP, WildP),
+    Phases (AllPhases),
+    Pragma (InlineP),
+    Pred,
+    Q,
+    RuleMatch (FunLike),
+    SourceStrictness (NoSourceStrictness),
+    SourceUnpackedness (NoSourceUnpackedness),
+    Type (AppT, ArrowT, ConT, ForallT, StarT, VarT),
+    appE,
+    caseE,
+    conE,
+    conT,
+    integerL,
+    lamE,
+    litP,
+    lookupTypeName,
+    mkName,
+    nameBase,
+    newName,
+    normalB,
+    recP,
+    sigP,
+    tupP,
+    varE,
+    varP,
+    varT,
+    wildP,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorInfo
+      ( constructorContext,
+        constructorFields,
+        constructorName,
+        constructorVars
+      ),
+    DatatypeInfo (datatypeCons, datatypeName, datatypeVars),
+    TypeSubstitution (applySubstitution, freeVariables),
+    reifyDatatype,
+    resolveTypeSynonyms,
+    tvName,
+  )
+import Language.Haskell.TH.Datatype.TyVarBndr
+  ( TyVarBndrUnit,
+    kindedTVSpecified,
+    plainTVFlag,
+    specifiedSpec,
+  )
+import Language.Haskell.TH.Lib (clause, conP, litE, match, stringL)
+import Type.Reflection (SomeTypeRep (SomeTypeRep), TypeRep, typeRep)
+import Unsafe.Coerce (unsafeCoerce)
+
+genMergingInfoCon ::
+  [TyVarBndrUnit] ->
+  Name ->
+  Bool ->
+  ConstructorInfo ->
+  Q (Con, Name, [Clause], [Clause], [Clause])
+genMergingInfoCon dataTypeVars tyName isLast con = do
+  let conName = mangleName $ constructorName con
+  let newConName = mkName $ conName <> "MergingInfo"
+  let oriVars = dataTypeVars ++ constructorVars con
+  newDataTypeVars <- traverse (newName . nameBase . tvName) dataTypeVars
+  newConstructorVars <-
+    traverse (newName . nameBase . tvName) $ constructorVars con
+  let newNames = newDataTypeVars ++ newConstructorVars
+  -- newNames <- traverse (newName . nameBase . tvName) oriVars
+  let newVars = fmap VarT newNames
+  let substMap = M.fromList $ zip (tvName <$> oriVars) newVars
+  let fields =
+        zip [0 ..] $
+          applySubstitution substMap $
+            constructorFields con
+  let tyFields =
+        AppT (ConT ''TypeRep)
+          <$> applySubstitution
+            substMap
+            ((VarT . tvName) <$> constructorVars con)
+  let strategyFields = fmap (AppT (ConT ''MergingStrategy) . snd) fields
+  tyFieldNamesL <- traverse (const $ newName "p") tyFields
+  tyFieldNamesR <- traverse (const $ newName "p") tyFields
+  let tyFieldPatsL = fmap varP tyFieldNamesL
+  let tyFieldPatsR = fmap varP tyFieldNamesR
+  let tyFieldVarsL = fmap varE tyFieldNamesL
+  let tyFieldVarsR = fmap varE tyFieldNamesR
+  let strategyFieldPats = replicate (length strategyFields) wildP
+  let patsL = tyFieldPatsL ++ strategyFieldPats
+  let patsR = tyFieldPatsR ++ strategyFieldPats
+  let allWildcards = fmap (const wildP) $ tyFieldPatsL ++ strategyFieldPats
+  let eqCont l r cont =
+        [|
+          SomeTypeRep $l == SomeTypeRep $r
+            && $cont
+          |]
+  let eqExp =
+        foldl (\cont (l, r) -> eqCont l r cont) (conE 'True) $
+          zip tyFieldVarsL tyFieldVarsR
+  eqClause <-
+    clause
+      [conP newConName patsL, conP newConName patsR]
+      (normalB eqExp)
+      []
+  let cmpCont l r cont =
+        [|
+          case SomeTypeRep $l `compare` SomeTypeRep $r of
+            EQ -> $cont
+            x -> x
+          |]
+  let cmpExp =
+        foldl (\cont (l, r) -> cmpCont l r cont) (conE 'EQ) $
+          zip tyFieldVarsL tyFieldVarsR
+  cmpClause0 <-
+    clause
+      [conP newConName patsL, conP newConName patsR]
+      (normalB cmpExp)
+      []
+  cmpClause1 <-
+    clause
+      [conP newConName allWildcards, wildP]
+      (normalB $ conE 'LT)
+      []
+  cmpClause2 <-
+    clause
+      [wildP, conP newConName allWildcards]
+      (normalB $ conE 'GT)
+      []
+  let cmpClauses =
+        if isLast
+          then [cmpClause0]
+          else [cmpClause0, cmpClause1, cmpClause2]
+  let showCont t cont =
+        [|$cont <> " " <> show $t|]
+  let showExp = foldl (flip showCont) (litE $ stringL conName) tyFieldVarsL
+  showClause <-
+    clause
+      [conP newConName patsL]
+      (normalB showExp)
+      []
+  let ctx = applySubstitution substMap $ constructorContext con
+  let ctxAndGadtUsedVars =
+        S.fromList (freeVariables ctx)
+          <> S.fromList (freeVariables tyFields)
+          <> S.fromList (freeVariables strategyFields)
+  let isCtxAndGadtUsedVar nm = S.member nm ctxAndGadtUsedVars
+  return
+    ( ForallC
+        ( (`plainTVFlag` specifiedSpec)
+            <$> filter isCtxAndGadtUsedVar newDataTypeVars ++ newConstructorVars
+        )
+        ctx
+        $ GadtC
+          [newConName]
+          ( (Bang NoSourceUnpackedness NoSourceStrictness,)
+              <$> tyFields ++ strategyFields
+          )
+          (ConT tyName),
+      newConName,
+      [eqClause],
+      cmpClauses,
+      [showClause]
+    )
+
+data MergingInfoResult = MergingInfoResult
+  { _infoName :: Name,
+    _conInfoNames :: [Name]
+  }
+
+genMergingInfo :: Name -> Q (MergingInfoResult, [Dec])
+genMergingInfo typName = do
+  d <- reifyDatatype typName
+  let originalName = mangleName $ datatypeName d
+  let newName = originalName <> "MergingInfo"
+  found <- lookupTypeName newName
+  let constructors = datatypeCons d
+  let name = mkName newName
+  r <-
+    if null constructors
+      then return []
+      else do
+        cons0 <-
+          traverse (genMergingInfoCon (datatypeVars d) name False) $
+            init constructors
+        consLast <-
+          genMergingInfoCon (datatypeVars d) name True $
+            last constructors
+        return $ cons0 ++ [consLast]
+  let cons = fmap (\(a, _, _, _, _) -> a) r
+  let eqClauses =
+        concatMap (\(_, _, a, _, _) -> a) r
+          ++ [ Clause [WildP, WildP] (NormalB $ ConE 'False) []
+             | length constructors > 1
+             ]
+  let cmpClauses = concatMap (\(_, _, _, a, _) -> a) r
+  let showClauses = concatMap (\(_, _, _, _, a) -> a) r
+  return
+    ( MergingInfoResult
+        name
+        (fmap (\(_, a, _, _, _) -> a) r),
+      if isJust found
+        then []
+        else
+          [ DataD [] name [] Nothing cons [],
+            InstanceD
+              Nothing
+              []
+              (ConT ''Eq `AppT` ConT name)
+              [FunD '(==) eqClauses],
+            InstanceD
+              Nothing
+              []
+              (ConT ''Ord `AppT` ConT name)
+              [FunD 'compare cmpClauses],
+            InstanceD
+              Nothing
+              []
+              (ConT ''Show `AppT` ConT name)
+              [FunD 'show showClauses]
+          ]
+    )
+
+-- | Generate 'Mergeable' instance and merging information for a data type.
+genMergeableAndGetMergingInfoResult ::
+  DeriveConfig -> Name -> Int -> Q (MergingInfoResult, [Dec])
+genMergeableAndGetMergingInfoResult deriveConfig typName n = do
+  (infoResult, infoDec) <- genMergingInfo typName
+  (_, decs) <- genMergeable' deriveConfig infoResult typName n
+  return (infoResult, infoDec ++ decs)
+
+constructMergingStrategyExp :: ConstructorInfo -> [Exp] -> Q Exp
+constructMergingStrategyExp _ [] = [|SimpleStrategy $ \_ t _ -> t|]
+constructMergingStrategyExp conInfo [x] = do
+  upname <- newName "a"
+  let unwrapPat = conP (constructorName conInfo) [varP upname]
+  let unwrapFun = lamE [unwrapPat] $ appE (varE 'unsafeCoerce) (varE upname)
+  [|
+    wrapStrategy
+      $(return x)
+      (unsafeCoerce . $(conE $ constructorName conInfo))
+      $unwrapFun
+    |]
+constructMergingStrategyExp conInfo l = do
+  let takeHalf l = take (length l `div` 2) l
+  let dropHalf l = drop (length l `div` 2) l
+  let num = length l
+  upnames <- replicateM num $ newName "a"
+  let wrapPat1 [] = error "Should not happen"
+      wrapPat1 [x] = varP x
+      wrapPat1 l = tupP [wrapPat1 (takeHalf l), wrapPat1 (dropHalf l)]
+  let wrapped = foldl AppE (ConE $ constructorName conInfo) $ fmap VarE upnames
+  let wrapFun =
+        lamE
+          [wrapPat1 (takeHalf upnames), wrapPat1 (dropHalf upnames)]
+          [|unsafeCoerce ($(return wrapped))|]
+  let unwrapPat = conP (constructorName conInfo) $ fmap varP upnames
+  let unwrapExp1 [] = error "Should not happen"
+      unwrapExp1 [x] = [|(unsafeCoerce $(varE x))|]
+      unwrapExp1 l = [|($(unwrapExp1 (takeHalf l)), $(unwrapExp1 (dropHalf l)))|]
+  let unwrapFun = lamE [unwrapPat] (unwrapExp1 upnames)
+  let strategyx [] = error "Should not happen"
+      strategyx [x] = return x
+      strategyx l =
+        [|product2Strategy (,) id $(strategyx (takeHalf l)) $(strategyx (dropHalf l))|]
+  [|
+    product2Strategy
+      $wrapFun
+      $unwrapFun
+      $(strategyx $ takeHalf l)
+      $(strategyx $ dropHalf l)
+    |]
+
+genMergeFunClause' :: Name -> ConstructorInfo -> Q Clause
+genMergeFunClause' conInfoName con = do
+  let numExistential = length $ constructorVars con
+  let numFields = length $ constructorFields con
+  let argWildCards = replicate numExistential wildP :: [Q Pat]
+
+  pnames <- replicateM numFields $ newName "s"
+  clause
+    ([conP conInfoName $ argWildCards ++ fmap varP pnames])
+    (normalB (constructMergingStrategyExp con (map VarE pnames)))
+    []
+
+constructVarPats :: ConstructorInfo -> Q Pat
+constructVarPats conInfo = do
+  let fields = constructorFields conInfo
+      capture n = return $ SigP WildP $ fields !! n
+  conP (constructorName conInfo) $ capture <$> [0 .. length fields - 1]
+
+genMergingInfoFunClause' ::
+  [(Type, Kind)] -> Name -> ConstructorInfo -> Q Clause
+genMergingInfoFunClause' argTypes conInfoName con = do
+  let conVars = constructorVars con
+  capturedVarTyReps <-
+    traverse (\bndr -> [|typeRep @($(varT $ tvName bndr))|]) conVars
+  varPat <- constructVarPats con
+  let infoExpWithTypeReps = foldl AppE (ConE conInfoName) capturedVarTyReps
+
+  let fields = constructorFields con
+  let usedArgs = S.fromList $ freeVariables fields
+
+  strategyNames <-
+    traverse
+      ( \(ty, _) ->
+          case ty of
+            VarT nm ->
+              if S.member nm usedArgs
+                then do
+                  pname <- newName "p"
+                  return (nm, Just pname)
+                else return ('undefined, Nothing)
+            _ -> return ('undefined, Nothing)
+      )
+      argTypes
+  let argToStrategyPat =
+        mapMaybe (\(nm, mpat) -> fmap (nm,) mpat) strategyNames
+  let strategyPats = fmap (maybe WildP VarP . snd) strategyNames
+
+  let argNameSet =
+        S.fromList $
+          mapMaybe
+            ( \(ty, _) -> case ty of
+                VarT nm -> Just nm
+                _ -> Nothing
+            )
+            argTypes
+  let containsArg :: Type -> Bool
+      containsArg ty =
+        S.intersection argNameSet (S.fromList (freeVariables [ty])) /= S.empty
+  let typeHasNoArg = not . containsArg
+
+  let fieldStrategyExp ty =
+        if not (containsArg ty)
+          then [|rootStrategy :: MergingStrategy $(return ty)|]
+          else case ty of
+            _
+              | typeHasNoArg ty ->
+                  [|rootStrategy :: MergingStrategy $(return ty)|]
+            AppT a b
+              | typeHasNoArg a ->
+                  [|
+                    liftRootStrategy
+                      $(fieldStrategyExp b) ::
+                      MergingStrategy $(return ty)
+                    |]
+            AppT (AppT a b) c
+              | typeHasNoArg a ->
+                  [|
+                    liftRootStrategy2
+                      $(fieldStrategyExp b)
+                      $(fieldStrategyExp c) ::
+                      MergingStrategy $(return ty)
+                    |]
+            AppT (AppT (AppT a b) c) d
+              | typeHasNoArg a ->
+                  [|
+                    liftRootStrategy3
+                      $(fieldStrategyExp b)
+                      $(fieldStrategyExp c)
+                      $(fieldStrategyExp d) ::
+                      MergingStrategy $(return ty)
+                    |]
+            VarT nm -> do
+              case lookup nm argToStrategyPat of
+                Just pname -> varE pname
+                _ -> fail "BUG: fieldStrategyExp"
+            _ -> fail $ "fieldStrategyExp: unsupported type: " <> show ty
+  fieldStrategyExps <- traverse fieldStrategyExp fields
+  let infoExp = foldl AppE infoExpWithTypeReps fieldStrategyExps
+  -- fail $ show infoExp
+  return $ Clause (strategyPats ++ [varPat]) (NormalB infoExp) []
+
+mergeableFieldFunExp :: [Name] -> FieldFunExp
+mergeableFieldFunExp unaryOpFunNames argToFunPat _ = go
+  where
+    go ty = do
+      let allArgNames = M.keysSet argToFunPat
+      let typeHasNoArg ty =
+            S.fromList (freeVariables [ty])
+              `S.intersection` allArgNames
+              == S.empty
+      let fun0a a = [|$(varE $ head unaryOpFunNames) @($(return a))|]
+          fun1a a b = [|$(varE $ unaryOpFunNames !! 1) @($(return a)) $(go b)|]
+          fun2a a b c =
+            [|
+              $(varE $ unaryOpFunNames !! 2)
+                @($(return a))
+                $(go b)
+                $(go c)
+              |]
+          fun3a a b c d =
+            [|
+              $(varE $ unaryOpFunNames !! 3)
+                @($(return a))
+                $(go b)
+                $(go c)
+                $(go d)
+              |]
+
+      case ty of
+        AppT (AppT (AppT a@(VarT _) b) c) d -> fun3a a b c d
+        AppT (AppT a@(VarT _) b) c -> fun2a a b c
+        AppT a@(VarT _) b -> fun1a a b
+        _ | typeHasNoArg ty -> fun0a ty
+        AppT a b | typeHasNoArg a -> fun1a a b
+        AppT (AppT a b) c | typeHasNoArg a -> fun2a a b c
+        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3a a b c d
+        VarT nm -> case M.lookup nm argToFunPat of
+          Just pname -> varE pname
+          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+
+mergeableInstanceNames :: [Name]
+mergeableInstanceNames =
+  [ ''Mergeable,
+    ''Mergeable1,
+    ''Mergeable2,
+    ''Mergeable3
+  ]
+
+getMergeableInstanceName :: Int -> Name
+getMergeableInstanceName n = mergeableInstanceNames !! n
+
+rootStrategyFunNames :: [Name]
+rootStrategyFunNames =
+  [ 'rootStrategy,
+    'liftRootStrategy,
+    'liftRootStrategy2,
+    'liftRootStrategy3
+  ]
+
+getMergeableFunName :: Int -> Name
+getMergeableFunName n = rootStrategyFunNames !! n
+
+mergeableNoExistentialConfig :: UnaryOpClassConfig
+mergeableNoExistentialConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            MergeableNoExistentialConfig
+              { mergeableNoExistentialFun =
+                  mergeableFieldFunExp rootStrategyFunNames
+              }
+            rootStrategyFunNames
+        ],
+      unaryOpInstanceNames =
+        [''Mergeable, ''Mergeable1, ''Mergeable2, ''Mergeable3],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = False,
+      unaryOpContextNames = Nothing
+    }
+
+newtype MergeableNoExistentialConfig = MergeableNoExistentialConfig
+  { mergeableNoExistentialFun :: FieldFunExp
+  }
+
+instance UnaryOpFunConfig MergeableNoExistentialConfig where
+  genUnaryOpFun
+    _
+    MergeableNoExistentialConfig {..}
+    funNames
+    n
+    _
+    _
+    argTypes
+    _
+    constructors = do
+      allFields <-
+        mapM resolveTypeSynonyms $
+          concatMap constructorFields constructors
+      let usedArgs = S.fromList $ freeVariables allFields
+      args <-
+        traverse
+          ( \(ty, _) -> do
+              case ty of
+                VarT nm ->
+                  if S.member nm usedArgs
+                    then do
+                      pname <- newName "p"
+                      return (nm, Just pname)
+                    else return ('undefined, Nothing)
+                _ -> return ('undefined, Nothing)
+          )
+          argTypes
+      let argToFunPat =
+            M.fromList $ mapMaybe (\(nm, mpat) -> fmap (nm,) mpat) args
+      let funPats = fmap (maybe WildP VarP . snd) args
+      let genAuxFunExp conInfo = do
+            fields <- mapM resolveTypeSynonyms $ constructorFields conInfo
+            defaultFieldFunExps <-
+              traverse
+                (mergeableNoExistentialFun argToFunPat M.empty)
+                fields
+            constructMergingStrategyExp conInfo defaultFieldFunExps
+      auxExps <- mapM genAuxFunExp constructors
+      funExp <- case auxExps of
+        [] -> [|NoStrategy|]
+        [singleExp] -> return singleExp
+        _ -> do
+          p <- newName "p"
+          let numConstructors = length constructors
+          let getIdx i =
+                if numConstructors <= 2
+                  then if i == 0 then [|False|] else [|True|]
+                  else integerE i
+          let getIdxPat i =
+                if numConstructors <= 2
+                  then conP (if i == 0 then 'False else 'True) []
+                  else do
+                    let w8Bound = fromIntegral (maxBound @Word8)
+                    let w16Bound = fromIntegral (maxBound @Word16)
+                    let w32Bound = fromIntegral (maxBound @Word32)
+                    let w64Bound = fromIntegral (maxBound @Word64)
+                    sigP
+                      (litP (integerL i))
+                      ( conT $
+                          if
+                            | numConstructors <= w8Bound + 1 -> ''Word8
+                            | numConstructors <= w16Bound + 1 -> ''Word16
+                            | numConstructors <= w32Bound + 1 -> ''Word32
+                            | numConstructors <= w64Bound + 1 -> ''Word64
+                            | otherwise -> ''Integer
+                      )
+          let idxFun =
+                lamE [varP p] $
+                  caseE
+                    (varE p)
+                    ( zipWith
+                        ( \conIdx conInfo -> do
+                            match
+                              (recP (constructorName conInfo) [])
+                              (normalB (getIdx conIdx))
+                              []
+                        )
+                        [0 ..]
+                        constructors
+                    )
+          let auxFun =
+                lamE [varP p] $
+                  caseE
+                    (varE p)
+                    ( zipWith
+                        ( \conIdx exp -> do
+                            match
+                              (getIdxPat conIdx)
+                              (normalB (return exp))
+                              []
+                        )
+                        [0 ..]
+                        auxExps
+                        ++ [match wildP (normalB [|undefined|]) []]
+                    )
+          [|
+            SortedStrategy $idxFun $auxFun
+            |]
+      let instanceFunName = funNames !! n
+      return $
+        FunD
+          instanceFunName
+          [ Clause
+              funPats
+              (NormalB funExp)
+              []
+          ]
+
+-- | Generate 'Mergeable' instance for a data type, using a given merging info
+-- result.
+genMergeable' ::
+  DeriveConfig -> MergingInfoResult -> Name -> Int -> Q (Name, [Dec])
+genMergeable' deriveConfig (MergingInfoResult infoName conInfoNames) typName n = do
+  result@CheckArgsResult {..} <-
+    specializeResult (evalModeSpecializeList deriveConfig)
+      =<< checkArgs "Mergeable" 3 typName True n
+
+  d <- reifyDatatype typName
+  let ctxForVar :: (Type, Kind) -> Q (Maybe Pred)
+      ctxForVar (ty, kind) = case kind of
+        StarT -> Just <$> [t|Mergeable $(return ty)|]
+        AppT (AppT ArrowT StarT) StarT ->
+          Just <$> [t|Mergeable1 $(return ty)|]
+        AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
+          Just <$> [t|Mergeable2 $(return ty)|]
+        AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) StarT ->
+          Just <$> [t|Mergeable3 $(return ty)|]
+        AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) _ ->
+          fail $ "Unsupported kind: " <> show kind
+        _ -> return Nothing
+  let isTypeUsedInFields (VarT nm) = isVarUsedInFields result nm
+      isTypeUsedInFields _ = False
+  mergeableContexts <-
+    traverse ctxForVar $
+      filter (isTypeUsedInFields . fst) $
+        fmap snd $
+          filter (not . (`elem` unconstrainedPositions deriveConfig) . fst) $
+            zip [0 ..] keptVars
+
+  let instanceName = getMergeableInstanceName n
+  let instanceHead = ConT instanceName
+  extraPreds <-
+    extraConstraint
+      deriveConfig
+      typName
+      instanceName
+      []
+      keptVars
+      constructors
+
+  let targetType =
+        foldl
+          (\ty (var, _) -> AppT ty var)
+          (ConT typName)
+          (keptVars ++ argVars)
+  let infoType = ConT infoName
+  let mergingInfoFunFinalType = AppT (AppT ArrowT targetType) infoType
+
+  let mergingInfoFunTypeWithoutCtx =
+        foldr
+          (((AppT . AppT ArrowT) . AppT (ConT ''MergingStrategy)) . fst)
+          mergingInfoFunFinalType
+          argVars
+
+  let mergingInfoFunType =
+        ForallT
+          ( mapMaybe
+              ( \(ty, knd) -> case ty of
+                  VarT nm -> Just $ kindedTVSpecified nm knd
+                  _ -> Nothing
+              )
+              $ keptVars ++ argVars
+          )
+          (extraPreds ++ catMaybes mergeableContexts)
+          mergingInfoFunTypeWithoutCtx
+  let mangledName = mangleName (datatypeName d)
+  let mergingInfoFunName =
+        mkName $
+          "mergingInfo"
+            <> (if n /= 0 then show n else "")
+            <> mangledName
+  let mergingInfoFunSigD = SigD mergingInfoFunName mergingInfoFunType
+  clauses <-
+    traverse (uncurry (genMergingInfoFunClause' argVars)) $
+      zip conInfoNames constructors
+  let mergingInfoFunDec = FunD mergingInfoFunName clauses
+
+  let mergeFunType =
+        AppT (AppT ArrowT infoType) (AppT (ConT ''MergingStrategy) targetType)
+  let mergeFunName =
+        mkName $
+          "merge"
+            <> (if n /= 0 then show n else "")
+            <> mangledName
+  let mergeFunSigD = SigD mergeFunName mergeFunType
+  mergeFunClauses <- zipWithM genMergeFunClause' conInfoNames constructors
+  let mergeFunDec = FunD mergeFunName mergeFunClauses
+
+  let instanceType =
+        AppT
+          instanceHead
+          (foldl AppT (ConT typName) $ fmap fst keptVars)
+
+  let mergeInstanceFunName = getMergeableFunName n
+  mergeInstanceFunPatNames <- replicateM n $ newName "rootStrategy"
+  let mergeInstanceFunPats = VarP <$> mergeInstanceFunPatNames
+
+  mergeInstanceFunBody <-
+    [|
+      SortedStrategy
+        $( foldM
+             (\exp name -> appE (return exp) $ varE name)
+             (VarE mergingInfoFunName)
+             mergeInstanceFunPatNames
+         )
+        $(varE mergeFunName)
+      |]
+
+  let mergeInstanceFunClause =
+        Clause mergeInstanceFunPats (NormalB mergeInstanceFunBody) []
+
+  return
+    ( mergingInfoFunName,
+      [ PragmaD (InlineP mergingInfoFunName Inline FunLike AllPhases),
+        mergingInfoFunSigD,
+        mergingInfoFunDec,
+        PragmaD (InlineP mergeFunName Inline FunLike AllPhases),
+        mergeFunSigD,
+        mergeFunDec,
+        InstanceD
+          Nothing
+          (extraPreds ++ catMaybes mergeableContexts)
+          instanceType
+          [FunD mergeInstanceFunName [mergeInstanceFunClause]]
+      ]
+    )
+
+-- | Generate 'Mergeable' instance for a data type without existential variables.
+genMergeableNoExistential :: DeriveConfig -> Name -> Int -> Q [Dec]
+genMergeableNoExistential deriveConfig typName n = do
+  genUnaryOpClass deriveConfig mergeableNoExistentialConfig n typName
+
+-- | Generate 'Mergeable' instance for a data type, using 'NoStrategy'.
+genMergeableNoStrategy :: DeriveConfig -> Name -> Int -> Q [Dec]
+genMergeableNoStrategy deriveConfig typName n = do
+  CheckArgsResult {..} <-
+    specializeResult (evalModeSpecializeList deriveConfig)
+      =<< checkArgs "Mergeable" 3 typName True n
+  let instanceName = getMergeableInstanceName n
+  let instanceHead = ConT instanceName
+  let instanceType =
+        AppT
+          instanceHead
+          (foldl AppT (ConT typName) $ fmap fst keptVars)
+  let mergeInstanceFunName = getMergeableFunName n
+
+  let mergeInstanceFunClause =
+        Clause (replicate n WildP) (NormalB (ConE 'NoStrategy)) []
+  return
+    [ InstanceD
+        Nothing
+        []
+        instanceType
+        [FunD mergeInstanceFunName [mergeInstanceFunClause]]
+    ]
+
+-- | Generate 'Mergeable' instance for a data type.
+genMergeable :: DeriveConfig -> Name -> Int -> Q [Dec]
+genMergeable deriveConfig typName n = do
+  hasExistential <- dataTypeHasExistential typName
+  if
+    | useNoStrategy deriveConfig ->
+        genMergeableNoStrategy deriveConfig typName n
+    | hasExistential -> do
+        (infoResult, infoDec) <- genMergingInfo typName
+        (_, decs) <- genMergeable' deriveConfig infoResult typName n
+        return $ infoDec ++ decs
+    | otherwise -> genMergeableNoExistential deriveConfig typName n
+
+-- | Generate multiple 'Mergeable' instances for a data type.
+genMergeableList :: DeriveConfig -> Name -> [Int] -> Q [Dec]
+genMergeableList _ _ [] = return []
+genMergeableList deriveConfig typName [n] = genMergeable deriveConfig typName n
+genMergeableList deriveConfig typName l@(n : ns) = do
+  hasExistential <- dataTypeHasExistential typName
+  if
+    | useNoStrategy deriveConfig ->
+        concat <$> traverse (genMergeableNoStrategy deriveConfig typName) l
+    | hasExistential -> do
+        (info, dn) <-
+          genMergeableAndGetMergingInfoResult
+            deriveConfig
+            typName
+            n
+        dns <-
+          traverse (genMergeable' deriveConfig info typName) ns
+        return $ dn ++ concatMap snd dns
+    | otherwise ->
+        concat <$> traverse (genMergeableNoExistential deriveConfig typName) l
+
+-- | Derive 'Mergeable' instance for GADT.
+deriveMergeable :: DeriveConfig -> Name -> Q [Dec]
+deriveMergeable deriveConfig nm = genMergeable deriveConfig nm 0
+
+-- | Derive 'Mergeable1' instance for GADT.
+deriveMergeable1 :: DeriveConfig -> Name -> Q [Dec]
+deriveMergeable1 deriveConfig nm = genMergeable deriveConfig nm 1
+
+-- | Derive 'Mergeable2' instance for GADT.
+deriveMergeable2 :: DeriveConfig -> Name -> Q [Dec]
+deriveMergeable2 deriveConfig nm = genMergeable deriveConfig nm 2
+
+-- | Derive 'Mergeable3' instance for GADT.
+deriveMergeable3 :: DeriveConfig -> Name -> Q [Dec]
+deriveMergeable3 deriveConfig nm = genMergeable deriveConfig nm 3
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveNFData.hs b/src/Grisette/Internal/TH/Derivation/DeriveNFData.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveNFData.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveNFData
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveNFData
+  ( deriveNFData,
+    deriveNFData1,
+    deriveNFData2,
+  )
+where
+
+import Control.DeepSeq (NFData (rnf), NFData1 (liftRnf), NFData2 (liftRnf2))
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultFieldFunExp,
+    defaultFieldResFun,
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Name)
+import Language.Haskell.TH.Syntax (Q)
+
+nfdataConfig :: UnaryOpClassConfig
+nfdataConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = [],
+                extraLiftedPatNames = const [],
+                fieldCombineFun = \_ _ _ _ _ exps -> do
+                  r <-
+                    foldl
+                      (\acc exp -> [|$acc `seq` $(return exp)|])
+                      ([|()|])
+                      exps
+                  return (r, []),
+                fieldResFun = defaultFieldResFun,
+                fieldFunExp = defaultFieldFunExp ['rnf, 'liftRnf, 'liftRnf2]
+              }
+            ['rnf, 'liftRnf, 'liftRnf2]
+        ],
+      unaryOpInstanceNames = [''NFData, ''NFData1, ''NFData2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'NFData' instance for a data type.
+deriveNFData :: DeriveConfig -> Name -> Q [Dec]
+deriveNFData deriveConfig = genUnaryOpClass deriveConfig nfdataConfig 0
+
+-- | Derive 'NFData1' instance for a data type.
+deriveNFData1 :: DeriveConfig -> Name -> Q [Dec]
+deriveNFData1 deriveConfig = genUnaryOpClass deriveConfig nfdataConfig 1
+
+-- | Derive 'NFData2' instance for a data type.
+deriveNFData2 :: DeriveConfig -> Name -> Q [Dec]
+deriveNFData2 deriveConfig = genUnaryOpClass deriveConfig nfdataConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveOrd.hs b/src/Grisette/Internal/TH/Derivation/DeriveOrd.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveOrd.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveOrd
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveOrd
+  ( deriveOrd,
+    deriveOrd1,
+    deriveOrd2,
+  )
+where
+
+import Data.Functor.Classes (Ord1 (liftCompare), Ord2 (liftCompare2))
+import Grisette.Internal.TH.Derivation.BinaryOpCommon
+  ( BinaryOpClassConfig
+      ( BinaryOpClassConfig,
+        binaryOpAllowSumType,
+        binaryOpFieldConfigs,
+        binaryOpInstanceNames
+      ),
+    BinaryOpFieldConfig
+      ( BinaryOpFieldConfig,
+        extraPatNames,
+        fieldCombineFun,
+        fieldDifferentExistentialFun,
+        fieldFunExp,
+        fieldFunNames,
+        fieldLMatchResult,
+        fieldRMatchResult,
+        fieldResFun
+      ),
+    binaryOpAllowExistential,
+    defaultFieldFunExp,
+    genBinaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Language.Haskell.TH (Dec, Exp (ListE), Name, Q)
+
+ordConfig :: BinaryOpClassConfig
+ordConfig =
+  BinaryOpClassConfig
+    { binaryOpFieldConfigs =
+        [ BinaryOpFieldConfig
+            { extraPatNames = [],
+              fieldResFun = \_ (lhs, rhs) f ->
+                (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
+              fieldCombineFun = \_ lst ->
+                (,[]) <$> [|mconcat $(return $ ListE lst)|],
+              fieldDifferentExistentialFun = return,
+              fieldFunExp =
+                defaultFieldFunExp ['compare, 'liftCompare, 'liftCompare2],
+              fieldFunNames = ['compare, 'liftCompare, 'liftCompare2],
+              fieldLMatchResult = [|LT|],
+              fieldRMatchResult = [|GT|]
+            }
+        ],
+      binaryOpInstanceNames = [''Ord, ''Ord1, ''Ord2],
+      binaryOpAllowSumType = True,
+      binaryOpAllowExistential = True
+    }
+
+-- | Derive 'Ord' instance for a data type.
+deriveOrd :: DeriveConfig -> Name -> Q [Dec]
+deriveOrd deriveConfig = genBinaryOpClass deriveConfig ordConfig 0
+
+-- | Derive 'Ord1' instance for a data type.
+deriveOrd1 :: DeriveConfig -> Name -> Q [Dec]
+deriveOrd1 deriveConfig = genBinaryOpClass deriveConfig ordConfig 1
+
+-- | Derive 'Ord2' instance for a data type.
+deriveOrd2 :: DeriveConfig -> Name -> Q [Dec]
+deriveOrd2 deriveConfig = genBinaryOpClass deriveConfig ordConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DerivePPrint.hs b/src/Grisette/Internal/TH/Derivation/DerivePPrint.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DerivePPrint.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DerivePPrint
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DerivePPrint
+  ( derivePPrint,
+    derivePPrint1,
+    derivePPrint2,
+  )
+where
+
+import Data.Maybe (fromMaybe)
+import Data.String (IsString (fromString))
+import GHC.Show (appPrec1)
+import Grisette.Internal.Internal.Decl.Core.Data.Class.PPrint
+  ( PPrint (pformatList, pformatPrec),
+    PPrint1 (liftPFormatList, liftPFormatPrec),
+    PPrint2 (liftPFormatList2, liftPFormatPrec2),
+    align,
+    condEnclose,
+    flatAlt,
+    group,
+    groupedEnclose,
+    nest,
+    pformatWithConstructorNoAlign,
+    vcat,
+    vsep,
+    (<+>),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.ShowPPrintCommon (showPrintFieldFunExp)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Grisette.Internal.TH.Util (integerE, isNonUnitTuple)
+import Language.Haskell.TH
+  ( Dec,
+    Exp (ListE),
+    Fixity (Fixity),
+    Name,
+    defaultFixity,
+    listE,
+    nameBase,
+    stringE,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorVariant (InfixConstructor, NormalConstructor, RecordConstructor),
+    reifyFixityCompat,
+  )
+import Language.Haskell.TH.Syntax (Q)
+
+pprintConfig :: UnaryOpClassConfig
+pprintConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = ["prec"],
+                extraLiftedPatNames = \i -> (["pl" | i /= 0]),
+                fieldCombineFun = \_ _ variant conName [prec] exps -> do
+                  let initExps =
+                        ( \e ->
+                            [|
+                              $(return e)
+                                <> (fromString ",")
+                                <> flatAlt (fromString "") (fromString " ")
+                              |]
+                        )
+                          <$> init exps
+                      lastExp = [|$(return $ last exps)|]
+                      commaSeped = initExps ++ [lastExp]
+                  case (variant, exps) of
+                    (NormalConstructor, []) -> do
+                      r <- [|fromString $(stringE $ nameBase conName)|]
+                      return (r, [False])
+                    (NormalConstructor, [exp]) -> do
+                      r <-
+                        [|
+                          pformatWithConstructorNoAlign
+                            $(return prec)
+                            (fromString $(stringE $ nameBase conName))
+                            [$(return exp)]
+                          |]
+                      return (r, [True])
+                    (NormalConstructor, _) | isNonUnitTuple conName -> do
+                      r <-
+                        [|
+                          groupedEnclose (fromString "(") (fromString ")") $
+                            vcat $
+                              $(listE commaSeped)
+                          |]
+                      return (r, [False])
+                    (NormalConstructor, _) -> do
+                      r <-
+                        [|
+                          pformatWithConstructorNoAlign
+                            $(return prec)
+                            (fromString $(stringE $ nameBase conName))
+                            [vsep $(return $ ListE exps)]
+                          |]
+                      return (r, [True])
+                    (RecordConstructor _, _) -> do
+                      r <-
+                        [|
+                          pformatWithConstructorNoAlign
+                            $(return prec)
+                            (fromString $(stringE $ nameBase conName))
+                            [ groupedEnclose (fromString "{") (fromString "}") $
+                                vcat $
+                                  $(listE commaSeped)
+                            ]
+                          |]
+                      return (r, [True])
+                    (InfixConstructor, [l, r]) -> do
+                      fi <-
+                        fromMaybe defaultFixity `fmap` reifyFixityCompat conName
+                      let conPrec = case fi of Fixity prec _ -> prec
+                      r <-
+                        [|
+                          group
+                            $ condEnclose
+                              ($(return prec) > $(integerE conPrec))
+                              (fromString "(")
+                              (fromString ")")
+                            $ nest 2
+                            $ vsep
+                              [ align $ $(return l),
+                                fromString $(stringE $ nameBase conName)
+                                  <+> $(return r)
+                              ]
+                          |]
+                      return (r, [True])
+                    _ ->
+                      fail "derivePPrint: unexpected constructor variant",
+                fieldResFun = \variant conName _ pos fieldPat fieldFun -> do
+                  let makePPrintField p =
+                        [|
+                          $(return fieldFun)
+                            $(integerE p)
+                            $(return fieldPat)
+                          |]
+                  let attachUsedInfo = ((,[False]) <$>)
+                  case variant of
+                    NormalConstructor
+                      | isNonUnitTuple conName ->
+                          attachUsedInfo $ makePPrintField 0
+                    NormalConstructor ->
+                      attachUsedInfo $ makePPrintField appPrec1
+                    RecordConstructor names ->
+                      attachUsedInfo
+                        [|
+                          fromString $(stringE $ nameBase (names !! pos) ++ " = ")
+                            <> $(makePPrintField 0)
+                          |]
+                    InfixConstructor -> do
+                      fi <-
+                        fromMaybe defaultFixity `fmap` reifyFixityCompat conName
+                      let conPrec = case fi of Fixity prec _ -> prec
+                      attachUsedInfo $ makePPrintField (conPrec + 1),
+                fieldFunExp =
+                  showPrintFieldFunExp
+                    ['pformatPrec, 'liftPFormatPrec, 'liftPFormatPrec2]
+                    ['pformatList, 'liftPFormatList, 'liftPFormatList2]
+              }
+            ['pformatPrec, 'liftPFormatPrec, 'liftPFormatPrec2]
+        ],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceNames = [''PPrint, ''PPrint1, ''PPrint2],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'PPrint' instance for a data type.
+derivePPrint :: DeriveConfig -> Name -> Q [Dec]
+derivePPrint deriveConfig = genUnaryOpClass deriveConfig pprintConfig 0
+
+-- | Derive 'PPrint1' instance for a data type.
+derivePPrint1 :: DeriveConfig -> Name -> Q [Dec]
+derivePPrint1 deriveConfig = genUnaryOpClass deriveConfig pprintConfig 1
+
+-- | Derive 'PPrint2' instance for a data type.
+derivePPrint2 :: DeriveConfig -> Name -> Q [Dec]
+derivePPrint2 deriveConfig = genUnaryOpClass deriveConfig pprintConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveSerial.hs b/src/Grisette/Internal/TH/Derivation/DeriveSerial.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveSerial.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveSerial
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveSerial
+  ( deriveSerial,
+    deriveSerial1,
+    deriveSerial2,
+  )
+where
+
+import Data.Bytes.Serial
+  ( Serial (deserialize, serialize),
+    Serial1 (deserializeWith, serializeWith),
+    Serial2 (deserializeWith2, serializeWith2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.SerializeCommon (serializeConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Name, Q)
+
+serialConfig :: UnaryOpClassConfig
+serialConfig =
+  serializeConfig
+    [''Serial, ''Serial1, ''Serial2]
+    ['serialize, 'serializeWith, 'serializeWith2]
+    ['deserialize, 'deserializeWith, 'deserializeWith2]
+
+-- | Derive 'Serial' instance for a data type.
+deriveSerial :: DeriveConfig -> Name -> Q [Dec]
+deriveSerial deriveConfig = genUnaryOpClass deriveConfig serialConfig 0
+
+-- | Derive 'Serial1' instance for a data type.
+deriveSerial1 :: DeriveConfig -> Name -> Q [Dec]
+deriveSerial1 deriveConfig = genUnaryOpClass deriveConfig serialConfig 1
+
+-- | Derive 'Serial2' instance for a data type.
+deriveSerial2 :: DeriveConfig -> Name -> Q [Dec]
+deriveSerial2 deriveConfig = genUnaryOpClass deriveConfig serialConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveShow.hs b/src/Grisette/Internal/TH/Derivation/DeriveShow.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveShow.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveShow
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveShow
+  ( deriveShow,
+    deriveShow1,
+    deriveShow2,
+  )
+where
+
+import Data.Functor.Classes
+  ( Show1 (liftShowList, liftShowsPrec),
+    Show2 (liftShowList2, liftShowsPrec2),
+  )
+import qualified Data.List as List
+import Data.Maybe (fromMaybe)
+import GHC.Show (appPrec, appPrec1)
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.ShowPPrintCommon (showPrintFieldFunExp)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Grisette.Internal.TH.Util (integerE, isNonUnitTuple)
+import Language.Haskell.TH
+  ( Dec,
+    Fixity (Fixity),
+    Name,
+    Q,
+    defaultFixity,
+    integerL,
+    listE,
+    litE,
+    nameBase,
+    stringE,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorVariant (InfixConstructor, NormalConstructor, RecordConstructor),
+    reifyFixityCompat,
+  )
+
+showConfig :: UnaryOpClassConfig
+showConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = ["prec"],
+                extraLiftedPatNames = \i -> (["sl" | i /= 0]),
+                fieldCombineFun =
+                  \_ _ variant conName [prec] exps -> do
+                    case (variant, exps) of
+                      (NormalConstructor, []) -> do
+                        r <- [|showString $(stringE $ nameBase conName)|]
+                        return (r, [False])
+                      (NormalConstructor, [exp]) -> do
+                        r <-
+                          [|
+                            showParen
+                              ($(return prec) > $(integerE appPrec))
+                              ( showString $(stringE $ nameBase conName)
+                                  . showChar ' '
+                                  . $(return exp)
+                              )
+                            |]
+                        return (r, [True])
+                      (NormalConstructor, _) | isNonUnitTuple conName -> do
+                        let commaSeped =
+                              List.intersperse [|showChar ','|] $
+                                return <$> exps
+                        r <-
+                          [|
+                            showChar '('
+                              . foldr1 (.) $(listE commaSeped)
+                              . showChar ')'
+                            |]
+                        return (r, [False])
+                      (NormalConstructor, _) -> do
+                        let spaceSeped =
+                              List.intersperse [|showChar ' '|] $
+                                return <$> exps
+                        r <-
+                          [|
+                            showParen
+                              ($(return prec) > $(integerE appPrec))
+                              ( showString $(stringE $ nameBase conName)
+                                  . showChar ' '
+                                  . (foldr1 (.) $(listE spaceSeped))
+                              )
+                            |]
+                        return (r, [True])
+                      (RecordConstructor _, _) -> do
+                        let commaSpaceSeped =
+                              List.intersperse [|showString ", "|] $
+                                return <$> exps
+                        r <-
+                          [|
+                            showString $(stringE $ nameBase conName)
+                              . showString " {"
+                              . foldr1 (.) $(listE commaSpaceSeped)
+                              . showString "}"
+                            |]
+                        return (r, [False])
+                      (InfixConstructor, [l, r]) -> do
+                        fi <-
+                          fromMaybe defaultFixity `fmap` reifyFixityCompat conName
+                        let conPrec = case fi of Fixity prec _ -> prec
+                        r <-
+                          [|
+                            showParen
+                              ($(return prec) > $(integerE conPrec))
+                              ( $(return l)
+                                  . showChar ' '
+                                  . showString $(stringE $ nameBase conName)
+                                  . showChar ' '
+                                  . $(return r)
+                              )
+                            |]
+                        return (r, [True])
+                      _ ->
+                        fail "deriveShow: unexpected constructor variant",
+                fieldResFun = \variant conName _ pos fieldPat fieldFun -> do
+                  let makeShowField p =
+                        [|
+                          $(return fieldFun)
+                            $(litE $ integerL $ fromIntegral p)
+                            $(return fieldPat)
+                          |]
+                  let attachUsedInfo = ((,[False]) <$>)
+                  case variant of
+                    NormalConstructor
+                      | isNonUnitTuple conName ->
+                          attachUsedInfo $ makeShowField 0
+                    NormalConstructor ->
+                      attachUsedInfo $ makeShowField appPrec1
+                    RecordConstructor names ->
+                      attachUsedInfo
+                        [|
+                          showString $(stringE $ nameBase (names !! pos) ++ " = ")
+                            . $(makeShowField 0)
+                          |]
+                    InfixConstructor -> do
+                      fi <-
+                        fromMaybe defaultFixity `fmap` reifyFixityCompat conName
+                      let conPrec = case fi of Fixity prec _ -> prec
+                      attachUsedInfo $ makeShowField (conPrec + 1),
+                fieldFunExp =
+                  showPrintFieldFunExp
+                    ['showsPrec, 'liftShowsPrec, 'liftShowsPrec2]
+                    ['showList, 'liftShowList, 'liftShowList2]
+              }
+            ['showsPrec, 'liftShowsPrec, 'liftShowsPrec2]
+        ],
+      unaryOpInstanceNames = [''Show, ''Show1, ''Show2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'Show' instance for a data type.
+deriveShow :: DeriveConfig -> Name -> Q [Dec]
+deriveShow deriveConfig = genUnaryOpClass deriveConfig showConfig 0
+
+-- | Derive 'Show1' instance for a data type.
+deriveShow1 :: DeriveConfig -> Name -> Q [Dec]
+deriveShow1 deriveConfig = genUnaryOpClass deriveConfig showConfig 1
+
+-- | Derive 'Show2' instance for a data type.
+deriveShow2 :: DeriveConfig -> Name -> Q [Dec]
+deriveShow2 deriveConfig = genUnaryOpClass deriveConfig showConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveSimpleMergeable.hs b/src/Grisette/Internal/TH/Derivation/DeriveSimpleMergeable.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveSimpleMergeable.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveSimpleMergeable
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveSimpleMergeable
+  ( deriveSimpleMergeable,
+    deriveSimpleMergeable1,
+    deriveSimpleMergeable2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SimpleMergeable
+  ( SimpleMergeable (mrgIte),
+    SimpleMergeable1 (liftMrgIte),
+    SimpleMergeable2 (liftMrgIte2),
+  )
+import Grisette.Internal.TH.Derivation.BinaryOpCommon
+  ( BinaryOpClassConfig
+      ( BinaryOpClassConfig,
+        binaryOpAllowSumType,
+        binaryOpFieldConfigs,
+        binaryOpInstanceNames
+      ),
+    BinaryOpFieldConfig
+      ( BinaryOpFieldConfig,
+        extraPatNames,
+        fieldCombineFun,
+        fieldDifferentExistentialFun,
+        fieldFunExp,
+        fieldFunNames,
+        fieldLMatchResult,
+        fieldRMatchResult,
+        fieldResFun
+      ),
+    binaryOpAllowExistential,
+    defaultFieldFunExp,
+    genBinaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Language.Haskell.TH (Dec, Exp (AppE, ConE), Name, Q)
+
+simpleMergeableConfig :: BinaryOpClassConfig
+simpleMergeableConfig =
+  BinaryOpClassConfig
+    { binaryOpFieldConfigs =
+        [ BinaryOpFieldConfig
+            { extraPatNames = ["c"],
+              fieldResFun = \[c] (lhs, rhs) f ->
+                (,[True])
+                  <$> [|$(return f) $(return c) $(return lhs) $(return rhs)|],
+              fieldCombineFun =
+                \con lst -> return (foldl AppE (ConE con) lst, [False]),
+              fieldDifferentExistentialFun = const [|undefined|],
+              fieldFunExp =
+                defaultFieldFunExp ['mrgIte, 'liftMrgIte, 'liftMrgIte2],
+              fieldFunNames = ['mrgIte, 'liftMrgIte, 'liftMrgIte2],
+              fieldLMatchResult = [|undefined|],
+              fieldRMatchResult = [|undefined|]
+            }
+        ],
+      binaryOpInstanceNames =
+        [''SimpleMergeable, ''SimpleMergeable1, ''SimpleMergeable2],
+      binaryOpAllowSumType = False,
+      binaryOpAllowExistential = True
+    }
+
+-- | Derive 'SimpleMergeable' instance for a data type.
+deriveSimpleMergeable :: DeriveConfig -> Name -> Q [Dec]
+deriveSimpleMergeable deriveConfig =
+  genBinaryOpClass deriveConfig simpleMergeableConfig 0
+
+-- | Derive 'SimpleMergeable1' instance for a data type.
+deriveSimpleMergeable1 :: DeriveConfig -> Name -> Q [Dec]
+deriveSimpleMergeable1 deriveConfig =
+  genBinaryOpClass deriveConfig simpleMergeableConfig 1
+
+-- | Derive 'SimpleMergeable2' instance for a data type.
+deriveSimpleMergeable2 :: DeriveConfig -> Name -> Q [Dec]
+deriveSimpleMergeable2 deriveConfig =
+  genBinaryOpClass deriveConfig simpleMergeableConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveSubstSym.hs b/src/Grisette/Internal/TH/Derivation/DeriveSubstSym.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveSubstSym.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveSubstSym
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveSubstSym
+  ( deriveSubstSym,
+    deriveSubstSym1,
+    deriveSubstSym2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SubstSym
+  ( SubstSym (substSym),
+    SubstSym1 (liftSubstSym),
+    SubstSym2 (liftSubstSym2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    defaultFieldFunExp,
+    defaultFieldResFun,
+    defaultUnaryOpInstanceTypeFromConfig,
+    genUnaryOpClass,
+  )
+import Language.Haskell.TH (Dec, Exp (AppE, ConE), Name)
+import Language.Haskell.TH.Syntax (Q)
+
+substSymConfig :: UnaryOpClassConfig
+substSymConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = ["symbol", "newVal"],
+                extraLiftedPatNames = const [],
+                fieldResFun = defaultFieldResFun,
+                fieldCombineFun = \_ _ _ con extraPat exp ->
+                  return (foldl AppE (ConE con) exp, False <$ extraPat),
+                fieldFunExp =
+                  defaultFieldFunExp
+                    ['substSym, 'liftSubstSym, 'liftSubstSym2]
+              }
+            ['substSym, 'liftSubstSym, 'liftSubstSym2]
+        ],
+      unaryOpInstanceNames =
+        [''SubstSym, ''SubstSym1, ''SubstSym2],
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'SubstSym' instance for a data type.
+deriveSubstSym :: DeriveConfig -> Name -> Q [Dec]
+deriveSubstSym deriveConfig = genUnaryOpClass deriveConfig substSymConfig 0
+
+-- | Derive 'SubstSym1' instance for a data type.
+deriveSubstSym1 :: DeriveConfig -> Name -> Q [Dec]
+deriveSubstSym1 deriveConfig = genUnaryOpClass deriveConfig substSymConfig 1
+
+-- | Derive 'SubstSym2' instance for a data type.
+deriveSubstSym2 :: DeriveConfig -> Name -> Q [Dec]
+deriveSubstSym2 deriveConfig = genUnaryOpClass deriveConfig substSymConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveSymEq.hs b/src/Grisette/Internal/TH/Derivation/DeriveSymEq.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveSymEq.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveSymEq
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveSymEq
+  ( deriveSymEq,
+    deriveSymEq1,
+    deriveSymEq2,
+  )
+where
+
+import Grisette.Internal.Core.Data.Class.LogicalOp
+  ( LogicalOp (false, true, (.&&)),
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SymEq
+  ( SymEq ((.==)),
+    SymEq1 (liftSymEq),
+    SymEq2 (liftSymEq2),
+  )
+import Grisette.Internal.TH.Derivation.BinaryOpCommon
+  ( BinaryOpClassConfig
+      ( BinaryOpClassConfig,
+        binaryOpAllowSumType,
+        binaryOpFieldConfigs,
+        binaryOpInstanceNames
+      ),
+    BinaryOpFieldConfig
+      ( BinaryOpFieldConfig,
+        extraPatNames,
+        fieldCombineFun,
+        fieldDifferentExistentialFun,
+        fieldFunExp,
+        fieldFunNames,
+        fieldLMatchResult,
+        fieldRMatchResult,
+        fieldResFun
+      ),
+    binaryOpAllowExistential,
+    defaultFieldFunExp,
+    genBinaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Language.Haskell.TH (Dec, Exp (ListE), Name, Q)
+
+symEqConfig :: BinaryOpClassConfig
+symEqConfig =
+  BinaryOpClassConfig
+    { binaryOpFieldConfigs =
+        [ BinaryOpFieldConfig
+            { extraPatNames = [],
+              fieldResFun = \_ (lhs, rhs) f ->
+                (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
+              fieldCombineFun =
+                \_ lst -> (,[]) <$> [|foldl (.&&) true $(return $ ListE lst)|],
+              fieldDifferentExistentialFun = const [|false|],
+              fieldFunExp =
+                defaultFieldFunExp ['(.==), 'liftSymEq, 'liftSymEq2],
+              fieldFunNames = ['(.==), 'liftSymEq, 'liftSymEq2],
+              fieldLMatchResult = [|false|],
+              fieldRMatchResult = [|false|]
+            }
+        ],
+      binaryOpInstanceNames = [''SymEq, ''SymEq1, ''SymEq2],
+      binaryOpAllowSumType = True,
+      binaryOpAllowExistential = True
+    }
+
+-- | Derive 'SymEq' instance for a data type.
+deriveSymEq :: DeriveConfig -> Name -> Q [Dec]
+deriveSymEq deriveConfig = genBinaryOpClass deriveConfig symEqConfig 0
+
+-- | Derive 'SymEq1' instance for a data type.
+deriveSymEq1 :: DeriveConfig -> Name -> Q [Dec]
+deriveSymEq1 deriveConfig = genBinaryOpClass deriveConfig symEqConfig 1
+
+-- | Derive 'SymEq2' instance for a data type.
+deriveSymEq2 :: DeriveConfig -> Name -> Q [Dec]
+deriveSymEq2 deriveConfig = genBinaryOpClass deriveConfig symEqConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveSymOrd.hs b/src/Grisette/Internal/TH/Derivation/DeriveSymOrd.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveSymOrd.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveSymOrd
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveSymOrd
+  ( deriveSymOrd,
+    deriveSymOrd1,
+    deriveSymOrd2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.SymOrd
+  ( SymOrd (symCompare),
+    SymOrd1 (liftSymCompare),
+    SymOrd2 (liftSymCompare2),
+  )
+import Grisette.Internal.Internal.Decl.Core.Data.Class.TryMerge
+  ( mrgSingle,
+  )
+import Grisette.Internal.TH.Derivation.BinaryOpCommon
+  ( BinaryOpClassConfig
+      ( BinaryOpClassConfig,
+        binaryOpAllowSumType,
+        binaryOpFieldConfigs,
+        binaryOpInstanceNames
+      ),
+    BinaryOpFieldConfig
+      ( BinaryOpFieldConfig,
+        extraPatNames,
+        fieldCombineFun,
+        fieldDifferentExistentialFun,
+        fieldFunExp,
+        fieldFunNames,
+        fieldLMatchResult,
+        fieldRMatchResult,
+        fieldResFun
+      ),
+    binaryOpAllowExistential,
+    defaultFieldFunExp,
+    genBinaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Language.Haskell.TH (Dec, Name, Q)
+
+symOrdConfig :: BinaryOpClassConfig
+symOrdConfig =
+  BinaryOpClassConfig
+    { binaryOpFieldConfigs =
+        [ BinaryOpFieldConfig
+            { extraPatNames = [],
+              fieldResFun =
+                \_ (lhs, rhs) f ->
+                  (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
+              fieldCombineFun =
+                \_ lst -> do
+                  let go [] = [|mrgSingle EQ|]
+                      go [x] = [|$(return x)|]
+                      go (x : xs) =
+                        [|
+                          do
+                            a <- $(return x)
+                            case a of
+                              EQ -> $(go xs)
+                              _ -> mrgSingle a
+                          |]
+                  (,[]) <$> go lst,
+              fieldDifferentExistentialFun =
+                \exp -> [|mrgSingle $(return exp)|],
+              fieldFunExp =
+                defaultFieldFunExp
+                  ['symCompare, 'liftSymCompare, 'liftSymCompare2],
+              fieldFunNames = ['symCompare, 'liftSymCompare, 'liftSymCompare2],
+              fieldLMatchResult = [|mrgSingle LT|],
+              fieldRMatchResult = [|mrgSingle GT|]
+            }
+        ],
+      binaryOpInstanceNames = [''SymOrd, ''SymOrd1, ''SymOrd2],
+      binaryOpAllowSumType = True,
+      binaryOpAllowExistential = True
+    }
+
+-- | Derive 'SymOrd' instance for a data type.
+deriveSymOrd :: DeriveConfig -> Name -> Q [Dec]
+deriveSymOrd deriveConfig = genBinaryOpClass deriveConfig symOrdConfig 0
+
+-- | Derive 'SymOrd1' instance for a data type.
+deriveSymOrd1 :: DeriveConfig -> Name -> Q [Dec]
+deriveSymOrd1 deriveConfig = genBinaryOpClass deriveConfig symOrdConfig 1
+
+-- | Derive 'SymOrd2' instance for a data type.
+deriveSymOrd2 :: DeriveConfig -> Name -> Q [Dec]
+deriveSymOrd2 deriveConfig = genBinaryOpClass deriveConfig symOrdConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveToCon.hs b/src/Grisette/Internal/TH/Derivation/DeriveToCon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveToCon.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveToCon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveToCon
+  ( deriveToCon,
+    deriveToCon1,
+    deriveToCon2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.ToCon
+  ( ToCon (toCon),
+    ToCon1 (liftToCon),
+    ToCon2 (liftToCon2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.ConvertOpCommon
+  ( ConvertOpClassConfig
+      ( ConvertOpClassConfig,
+        convertFieldCombineFun,
+        convertFieldFunExp,
+        convertFieldResFun,
+        convertOpFunNames,
+        convertOpInstanceNames,
+        convertOpTarget
+      ),
+    defaultFieldFunExp,
+    genConvertOpClass,
+  )
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C))
+import Language.Haskell.TH (Dec, Name, Q, conE)
+
+toConClassConfig :: ConvertOpClassConfig
+toConClassConfig =
+  ConvertOpClassConfig
+    { convertFieldResFun = \v f -> [|$(return f) $(return v)|],
+      convertFieldCombineFun = \f args ->
+        foldl
+          (\acc arg -> [|$(acc) <*> $arg|])
+          [|return $(conE f)|]
+          $ fmap return args,
+      convertFieldFunExp = defaultFieldFunExp ['toCon, 'liftToCon, 'liftToCon2],
+      convertOpTarget = C,
+      convertOpInstanceNames = [''ToCon, ''ToCon1, ''ToCon2],
+      convertOpFunNames = ['toCon, 'liftToCon, 'liftToCon2]
+    }
+
+-- | Derive 'ToCon' instance for a data type.
+deriveToCon :: DeriveConfig -> Name -> Q [Dec]
+deriveToCon deriveConfig = genConvertOpClass deriveConfig toConClassConfig 0
+
+-- | Derive 'ToCon1' instance for a data type.
+deriveToCon1 :: DeriveConfig -> Name -> Q [Dec]
+deriveToCon1 deriveConfig =
+  genConvertOpClass deriveConfig toConClassConfig 1
+
+-- | Derive 'ToCon2' instance for a data type.
+deriveToCon2 :: DeriveConfig -> Name -> Q [Dec]
+deriveToCon2 deriveConfig =
+  genConvertOpClass deriveConfig toConClassConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveToSym.hs b/src/Grisette/Internal/TH/Derivation/DeriveToSym.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveToSym.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveToSym
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveToSym
+  ( deriveToSym,
+    deriveToSym1,
+    deriveToSym2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Core.Data.Class.ToSym
+  ( ToSym (toSym),
+    ToSym1 (liftToSym),
+    ToSym2 (liftToSym2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig)
+import Grisette.Internal.TH.Derivation.ConvertOpCommon
+  ( ConvertOpClassConfig
+      ( ConvertOpClassConfig,
+        convertFieldCombineFun,
+        convertFieldFunExp,
+        convertFieldResFun,
+        convertOpInstanceNames,
+        convertOpTarget
+      ),
+    convertOpFunNames,
+    defaultFieldFunExp,
+    genConvertOpClass,
+  )
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (S))
+import Language.Haskell.TH (Dec, Name, Q, appE, conE)
+
+toSymClassConfig :: ConvertOpClassConfig
+toSymClassConfig =
+  ConvertOpClassConfig
+    { convertFieldResFun = \v f -> [|$(return f) $(return v)|],
+      convertFieldCombineFun =
+        \f args -> foldl appE (conE f) $ fmap return args,
+      convertFieldFunExp = defaultFieldFunExp ['toSym, 'liftToSym, 'liftToSym2],
+      convertOpTarget = S,
+      convertOpInstanceNames = [''ToSym, ''ToSym1, ''ToSym2],
+      convertOpFunNames = ['toSym, 'liftToSym, 'liftToSym2]
+    }
+
+-- | Derive 'ToSym' instance for a data type.
+deriveToSym :: DeriveConfig -> Name -> Q [Dec]
+deriveToSym deriveConfig = genConvertOpClass deriveConfig toSymClassConfig 0
+
+-- | Derive 'ToSym1' instance for a data type.
+deriveToSym1 :: DeriveConfig -> Name -> Q [Dec]
+deriveToSym1 deriveConfig =
+  genConvertOpClass deriveConfig toSymClassConfig 1
+
+-- | Derive 'ToSym2' instance for a data type.
+deriveToSym2 :: DeriveConfig -> Name -> Q [Dec]
+deriveToSym2 deriveConfig =
+  genConvertOpClass deriveConfig toSymClassConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSimpleMergeable.hs b/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSimpleMergeable.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSimpleMergeable.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveUnifiedSimpleMergeable
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveUnifiedSimpleMergeable
+  ( deriveUnifiedSimpleMergeable,
+    deriveUnifiedSimpleMergeable1,
+    deriveUnifiedSimpleMergeable2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSimpleMergeable
+  ( UnifiedSimpleMergeable (withBaseSimpleMergeable),
+    UnifiedSimpleMergeable1 (withBaseSimpleMergeable1),
+    UnifiedSimpleMergeable2 (withBaseSimpleMergeable2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig (evalModeConfig))
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    genUnaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.UnifiedOpCommon
+  ( UnaryOpUnifiedConfig (UnaryOpUnifiedConfig, unifiedFun),
+    defaultUnaryOpUnifiedFun,
+  )
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
+import Language.Haskell.TH
+  ( Dec,
+    Name,
+    Q,
+    Type (ConT, VarT),
+    appT,
+    conT,
+    newName,
+  )
+
+unifiedSimpleMergeableConfig :: UnaryOpClassConfig
+unifiedSimpleMergeableConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpUnifiedConfig
+              { unifiedFun =
+                  defaultUnaryOpUnifiedFun
+                    [ 'withBaseSimpleMergeable,
+                      'withBaseSimpleMergeable1,
+                      'withBaseSimpleMergeable2
+                    ]
+              }
+            [ 'withBaseSimpleMergeable,
+              'withBaseSimpleMergeable1,
+              'withBaseSimpleMergeable2
+            ]
+        ],
+      unaryOpInstanceNames =
+        [ ''UnifiedSimpleMergeable,
+          ''UnifiedSimpleMergeable1,
+          ''UnifiedSimpleMergeable2
+        ],
+      unaryOpExtraVars = \config -> do
+        let modeConfigs = evalModeConfig config
+        case modeConfigs of
+          [] -> do
+            nm <- newName "mode"
+            return [(VarT nm, ConT ''EvalModeTag)]
+          [_] -> return []
+          _ -> fail "UnifiedSimpleMergeable does not support multiple evaluation modes",
+      unaryOpInstanceTypeFromConfig =
+        \config newModeVars keptNewVars con -> do
+          let modeConfigs = evalModeConfig config
+          modeVar <- case modeConfigs of
+            [] -> return $ head newModeVars
+            [(i, _)] -> do
+              if i >= length keptNewVars
+                then fail "UnifiedSimpleMergeable reference to a non-existent mode variable"
+                else return $ keptNewVars !! i
+            _ -> fail "UnifiedSimpleMergeable does not support multiple evaluation modes"
+          appT (conT con) (return $ fst modeVar),
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'UnifiedSimpleMergeable' instance for a data type.
+deriveUnifiedSimpleMergeable :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSimpleMergeable deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSimpleMergeableConfig 0
+
+-- | Derive 'UnifiedSimpleMergeable1' instance for a data type.
+deriveUnifiedSimpleMergeable1 :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSimpleMergeable1 deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSimpleMergeableConfig 1
+
+-- | Derive 'UnifiedSimpleMergeable2' instance for a data type.
+deriveUnifiedSimpleMergeable2 :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSimpleMergeable2 deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSimpleMergeableConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSymEq.hs b/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSymEq.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSymEq.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveUnifiedSymEq
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveUnifiedSymEq
+  ( deriveUnifiedSymEq,
+    deriveUnifiedSymEq1,
+    deriveUnifiedSymEq2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymEq
+  ( UnifiedSymEq (withBaseSymEq),
+    UnifiedSymEq1 (withBaseSymEq1),
+    UnifiedSymEq2 (withBaseSymEq2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig (evalModeConfig))
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    genUnaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.UnifiedOpCommon
+  ( UnaryOpUnifiedConfig (UnaryOpUnifiedConfig, unifiedFun),
+    defaultUnaryOpUnifiedFun,
+  )
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
+import Language.Haskell.TH
+  ( Dec,
+    Name,
+    Q,
+    Type (ConT, VarT),
+    appT,
+    conT,
+    newName,
+  )
+
+unifiedSymEqConfig :: UnaryOpClassConfig
+unifiedSymEqConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpUnifiedConfig
+              { unifiedFun =
+                  defaultUnaryOpUnifiedFun
+                    ['withBaseSymEq, 'withBaseSymEq1, 'withBaseSymEq2]
+              }
+            ['withBaseSymEq, 'withBaseSymEq1, 'withBaseSymEq2]
+        ],
+      unaryOpInstanceNames = [''UnifiedSymEq, ''UnifiedSymEq1, ''UnifiedSymEq2],
+      unaryOpExtraVars = \config -> do
+        let modeConfigs = evalModeConfig config
+        case modeConfigs of
+          [] -> do
+            nm <- newName "mode"
+            return [(VarT nm, ConT ''EvalModeTag)]
+          [_] -> return []
+          _ -> fail "UnifiedSymEq does not support multiple evaluation modes",
+      unaryOpInstanceTypeFromConfig =
+        \config newModeVars keptNewVars con -> do
+          let modeConfigs = evalModeConfig config
+          modeVar <- case modeConfigs of
+            [] -> return $ head newModeVars
+            [(i, _)] -> do
+              if i >= length keptNewVars
+                then fail "UnifiedSymEq reference to a non-existent mode variable"
+                else return $ keptNewVars !! i
+            _ -> fail "UnifiedSymEq does not support multiple evaluation modes"
+          appT (conT con) (return $ fst modeVar),
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'UnifiedSymEq' instance for a data type.
+deriveUnifiedSymEq :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSymEq deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSymEqConfig 0
+
+-- | Derive 'UnifiedSymEq1' instance for a data type.
+deriveUnifiedSymEq1 :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSymEq1 deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSymEqConfig 1
+
+-- | Derive 'UnifiedSymEq2' instance for a data type.
+deriveUnifiedSymEq2 :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSymEq2 deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSymEqConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSymOrd.hs b/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSymOrd.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/DeriveUnifiedSymOrd.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Unused LANGUAGE pragma" #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.DeriveUnifiedSymOrd
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.DeriveUnifiedSymOrd
+  ( deriveUnifiedSymOrd,
+    deriveUnifiedSymOrd1,
+    deriveUnifiedSymOrd2,
+  )
+where
+
+import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymOrd
+  ( UnifiedSymOrd (withBaseSymOrd),
+    UnifiedSymOrd1 (withBaseSymOrd1),
+    UnifiedSymOrd2 (withBaseSymOrd2),
+  )
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig (evalModeConfig))
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    genUnaryOpClass,
+  )
+import Grisette.Internal.TH.Derivation.UnifiedOpCommon
+  ( UnaryOpUnifiedConfig (UnaryOpUnifiedConfig, unifiedFun),
+    defaultUnaryOpUnifiedFun,
+  )
+import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
+import Language.Haskell.TH
+  ( Dec,
+    Name,
+    Q,
+    Type (ConT, VarT),
+    appT,
+    conT,
+    newName,
+  )
+
+unifiedSymOrdConfig :: UnaryOpClassConfig
+unifiedSymOrdConfig =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpUnifiedConfig
+              { unifiedFun =
+                  defaultUnaryOpUnifiedFun
+                    ['withBaseSymOrd, 'withBaseSymOrd1, 'withBaseSymOrd2]
+              }
+            ['withBaseSymOrd, 'withBaseSymOrd1, 'withBaseSymOrd2]
+        ],
+      unaryOpInstanceNames = [''UnifiedSymOrd, ''UnifiedSymOrd1, ''UnifiedSymOrd2],
+      unaryOpExtraVars = \config -> do
+        let modeConfigs = evalModeConfig config
+        case modeConfigs of
+          [] -> do
+            nm <- newName "mode"
+            return [(VarT nm, ConT ''EvalModeTag)]
+          [_] -> return []
+          _ -> fail "UnifiedSymOrd does not support multiple evaluation modes",
+      unaryOpInstanceTypeFromConfig =
+        \config newModeVars keptNewVars con -> do
+          let modeConfigs = evalModeConfig config
+          modeVar <- case modeConfigs of
+            [] -> return $ head newModeVars
+            [(i, _)] -> do
+              if i >= length keptNewVars
+                then fail "UnifiedSymOrd reference to a non-existent mode variable"
+                else return $ keptNewVars !! i
+            _ -> fail "UnifiedSymOrd does not support multiple evaluation modes"
+          appT (conT con) (return $ fst modeVar),
+      unaryOpAllowExistential = True,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Derive 'UnifiedSymOrd' instance for a data type.
+deriveUnifiedSymOrd :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSymOrd deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSymOrdConfig 0
+
+-- | Derive 'UnifiedSymOrd1' instance for a data type.
+deriveUnifiedSymOrd1 :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSymOrd1 deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSymOrdConfig 1
+
+-- | Derive 'UnifiedSymOrd2' instance for a data type.
+deriveUnifiedSymOrd2 :: DeriveConfig -> Name -> Q [Dec]
+deriveUnifiedSymOrd2 deriveConfig =
+  genUnaryOpClass deriveConfig unifiedSymOrdConfig 2
diff --git a/src/Grisette/Internal/TH/Derivation/SerializeCommon.hs b/src/Grisette/Internal/TH/Derivation/SerializeCommon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/SerializeCommon.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.SerializeCommon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.SerializeCommon
+  ( serializeConfig,
+    serializeWithSerialConfig,
+  )
+where
+
+import Control.Monad (zipWithM)
+import Data.Bytes.Serial (Serial (deserialize, serialize), Serial1, Serial2)
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe)
+import qualified Data.Set as S
+import GHC.Word (Word16, Word32, Word64, Word8)
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig
+      ( UnaryOpClassConfig,
+        unaryOpAllowExistential,
+        unaryOpConfigs,
+        unaryOpContextNames,
+        unaryOpExtraVars,
+        unaryOpInstanceNames,
+        unaryOpInstanceTypeFromConfig
+      ),
+    UnaryOpConfig (UnaryOpConfig),
+    UnaryOpFieldConfig
+      ( UnaryOpFieldConfig,
+        extraLiftedPatNames,
+        extraPatNames,
+        fieldCombineFun,
+        fieldFunExp,
+        fieldResFun
+      ),
+    UnaryOpFunConfig (genUnaryOpFun),
+    defaultFieldFunExp,
+    defaultUnaryOpInstanceTypeFromConfig,
+  )
+import Grisette.Internal.TH.Util (integerE)
+import Language.Haskell.TH
+  ( Body (NormalB),
+    Clause (Clause),
+    Dec (FunD),
+    Lit (IntegerL),
+    Match (Match),
+    Name,
+    Pat (LitP, VarP, WildP),
+    Type (VarT),
+    bindS,
+    caseE,
+    clause,
+    conE,
+    conT,
+    doE,
+    funD,
+    match,
+    mkName,
+    newName,
+    noBindS,
+    normalB,
+    sigP,
+    varE,
+    varP,
+    wildP,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorInfo (constructorFields, constructorName),
+    TypeSubstitution (freeVariables),
+    resolveTypeSynonyms,
+  )
+
+data UnaryOpSerializeWithSerialConfig = UnaryOpSerializeWithSerialConfig
+
+instance UnaryOpFunConfig UnaryOpSerializeWithSerialConfig where
+  genUnaryOpFun _ UnaryOpSerializeWithSerialConfig funNames n _ _ _ _ _ =
+    funD (funNames !! n) [clause [] (normalB [|serialize|]) []]
+
+data UnaryOpDeserializeWithSerialConfig = UnaryOpDeserializeWithSerialConfig
+
+instance UnaryOpFunConfig UnaryOpDeserializeWithSerialConfig where
+  genUnaryOpFun _ UnaryOpDeserializeWithSerialConfig funNames n _ _ _ _ _ =
+    funD (funNames !! n) [clause [] (normalB [|deserialize|]) []]
+
+-- | Configuration for deserialization function, generate the function from
+-- scratch.
+data UnaryOpDeserializeConfig = UnaryOpDeserializeConfig
+
+getSerializedType :: Int -> Name
+getSerializedType numConstructors =
+  if
+    | numConstructors <= fromIntegral (maxBound @Word8) + 1 -> ''Word8
+    | numConstructors <= fromIntegral (maxBound @Word16) + 1 -> ''Word16
+    | numConstructors <= fromIntegral (maxBound @Word32) + 1 -> ''Word32
+    | numConstructors <= fromIntegral (maxBound @Word64) + 1 -> ''Word64
+    | otherwise -> ''Integer
+
+instance UnaryOpFunConfig UnaryOpDeserializeConfig where
+  genUnaryOpFun _ UnaryOpDeserializeConfig funNames n _ _ _ _ [] = do
+    let instanceFunName = funNames !! n
+    funD
+      instanceFunName
+      [ clause
+          []
+          (normalB [|error "deserializing a type without constructors"|])
+          []
+      ]
+  genUnaryOpFun
+    _
+    UnaryOpDeserializeConfig
+    funNames
+    n
+    _
+    _
+    argTypes
+    _
+    constructors = do
+      allFields <-
+        mapM resolveTypeSynonyms $
+          concatMap constructorFields constructors
+      let usedArgs = S.fromList $ freeVariables allFields
+      args <-
+        traverse
+          ( \(ty, _) -> do
+              case ty of
+                VarT nm ->
+                  if S.member nm usedArgs
+                    then do
+                      pname <- newName "p"
+                      return (nm, Just pname)
+                    else return ('undefined, Nothing)
+                _ -> return ('undefined, Nothing)
+          )
+          argTypes
+      let argToFunPat =
+            M.fromList $ mapMaybe (\(nm, mpat) -> fmap (nm,) mpat) args
+      let funPats = fmap (maybe WildP VarP . snd) args
+      let genAuxFunMatch conIdx conInfo = do
+            fields <- mapM resolveTypeSynonyms $ constructorFields conInfo
+            defaultFieldFunExps <-
+              traverse
+                ( defaultFieldFunExp
+                    funNames
+                    argToFunPat
+                    M.empty
+                )
+                fields
+            let conName = constructorName conInfo
+            exp <-
+              foldl
+                (\exp fieldFun -> [|$exp <*> $(return fieldFun)|])
+                [|return $(conE conName)|]
+                defaultFieldFunExps
+            return $ Match (LitP (IntegerL conIdx)) (NormalB exp) []
+      auxMatches <- zipWithM genAuxFunMatch [0 ..] constructors
+      auxFallbackMatch <- match wildP (normalB [|undefined|]) []
+      let instanceFunName = funNames !! n
+      -- let auxFunName = mkName "go"
+      let selName = mkName "sel"
+      exp <-
+        doE
+          [ bindS
+              ( sigP
+                  (varP selName)
+                  (conT (getSerializedType $ length constructors))
+              )
+              (varE (head funNames)),
+            noBindS $
+              caseE (varE selName) $
+                return <$> auxMatches ++ [auxFallbackMatch]
+          ]
+      return $
+        FunD
+          instanceFunName
+          [ Clause
+              funPats
+              (NormalB exp)
+              []
+          ]
+
+-- | Configuration for serialization function, generate the function from
+-- scratch.
+serializeConfig :: [Name] -> [Name] -> [Name] -> UnaryOpClassConfig
+serializeConfig instanceNames serializeFunNames deserializeFunNames =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig
+            UnaryOpFieldConfig
+              { extraPatNames = [],
+                extraLiftedPatNames = const [],
+                fieldCombineFun = \totalConNumber conIdx _ _ [] exp -> do
+                  let ty = getSerializedType totalConNumber
+                  r <-
+                    foldl
+                      (\r exp -> [|$r >> $(return exp)|])
+                      ( [|
+                          $(varE $ head serializeFunNames)
+                            ($(integerE conIdx) :: $(conT ty))
+                          |]
+                      )
+                      exp
+                  return (r, [True]),
+                fieldResFun = \_ _ _ _ fieldPat fieldFun -> do
+                  r <- [|$(return fieldFun) $(return fieldPat)|]
+                  return (r, [True]),
+                fieldFunExp = defaultFieldFunExp serializeFunNames
+              }
+            serializeFunNames,
+          UnaryOpConfig
+            UnaryOpDeserializeConfig
+            deserializeFunNames
+        ],
+      unaryOpInstanceNames = instanceNames,
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = False,
+      unaryOpContextNames = Nothing
+    }
+
+-- | Configuration for serialization function, reuse the 'Serial' instance.
+serializeWithSerialConfig :: [Name] -> [Name] -> [Name] -> UnaryOpClassConfig
+serializeWithSerialConfig instanceNames serializeFunNames deserializeFunNames =
+  UnaryOpClassConfig
+    { unaryOpConfigs =
+        [ UnaryOpConfig UnaryOpSerializeWithSerialConfig serializeFunNames,
+          UnaryOpConfig UnaryOpDeserializeWithSerialConfig deserializeFunNames
+        ],
+      unaryOpInstanceNames = instanceNames,
+      unaryOpExtraVars = const $ return [],
+      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
+      unaryOpAllowExistential = False,
+      unaryOpContextNames =
+        Just $ take (length instanceNames) [''Serial, ''Serial1, ''Serial2]
+    }
diff --git a/src/Grisette/Internal/TH/Derivation/ShowPPrintCommon.hs b/src/Grisette/Internal/TH/Derivation/ShowPPrintCommon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/ShowPPrintCommon.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.ShowPPrintCommon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.ShowPPrintCommon (showPrintFieldFunExp) where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Grisette.Internal.TH.Derivation.UnaryOpCommon (FieldFunExp)
+import Language.Haskell.TH (Name, Type (AppT, VarT), varE)
+import Language.Haskell.TH.Datatype (TypeSubstitution (freeVariables))
+
+-- | Common 'FieldFunExp' for 'Show' and 'Grisette.Core.PPrint' on a GADT.
+showPrintFieldFunExp :: [Name] -> [Name] -> FieldFunExp
+showPrintFieldFunExp precNames listNames argToFunPat liftedExps = go
+  where
+    allArgNames = M.keysSet argToFunPat
+    typeHasNoArg ty =
+      S.fromList (freeVariables [ty])
+        `S.intersection` allArgNames
+        == S.empty
+    goLst ty = do
+      let fun0 = varE (head listNames)
+          fun1 b = [|$(varE $ listNames !! 1) $(go b) $(goLst b)|]
+          fun2 b c =
+            [|$(varE $ listNames !! 2) $(go b) $(goLst b) $(go c) $(goLst c)|]
+      case ty of
+        AppT (AppT (VarT _) b) c -> fun2 b c
+        AppT (VarT _) b -> fun1 b
+        _ | typeHasNoArg ty -> fun0
+        AppT a b | typeHasNoArg a -> fun1 b
+        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
+        VarT nm -> case M.lookup nm liftedExps of
+          Just [p] -> varE p
+          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+    go ty = do
+      let fun0 = varE (head precNames)
+          fun1 b = [|$(varE $ precNames !! 1) $(go b) $(goLst b)|]
+          fun2 b c =
+            [|$(varE $ precNames !! 2) $(go b) $(goLst b) $(go c) $(goLst c)|]
+      case ty of
+        AppT (AppT (VarT _) b) c -> fun2 b c
+        AppT (VarT _) b -> fun1 b
+        _ | typeHasNoArg ty -> fun0
+        AppT a b | typeHasNoArg a -> fun1 b
+        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
+        VarT nm -> case M.lookup nm argToFunPat of
+          Just pname -> varE pname
+          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
diff --git a/src/Grisette/Internal/TH/Derivation/UnaryOpCommon.hs b/src/Grisette/Internal/TH/Derivation/UnaryOpCommon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/UnaryOpCommon.hs
@@ -0,0 +1,400 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.UnaryOpCommon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpClassConfig (..),
+    UnaryOpFieldConfig (..),
+    UnaryOpConfig (..),
+    UnaryOpFunConfig (..),
+    FieldFunExp,
+    defaultFieldResFun,
+    defaultFieldFunExp,
+    genUnaryOpClass,
+    defaultUnaryOpInstanceTypeFromConfig,
+  )
+where
+
+import Control.Monad (replicateM, zipWithM)
+import qualified Data.List as List
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
+import qualified Data.Set as S
+import Grisette.Internal.TH.Derivation.Common
+  ( CheckArgsResult
+      ( CheckArgsResult,
+        argVars,
+        constructors,
+        keptVars
+      ),
+    DeriveConfig (unconstrainedPositions),
+    checkArgs,
+    ctxForVar,
+    evalModeSpecializeList,
+    extraConstraint,
+    freshenCheckArgsResult,
+    isVarUsedInFields,
+    specializeResult,
+  )
+import Grisette.Internal.TH.Util (allUsedNames)
+import Language.Haskell.TH
+  ( Body (NormalB),
+    Clause (Clause),
+    Dec (FunD, InstanceD),
+    Exp (VarE),
+    Kind,
+    Name,
+    Pat (VarP, WildP),
+    Q,
+    Type (AppT, ConT, VarT),
+    appE,
+    clause,
+    conP,
+    conT,
+    funD,
+    nameBase,
+    newName,
+    normalB,
+    varE,
+    varP,
+  )
+import Language.Haskell.TH.Datatype
+  ( ConstructorInfo (constructorFields, constructorName, constructorVariant),
+    ConstructorVariant,
+    TypeSubstitution (freeVariables),
+    resolveTypeSynonyms,
+  )
+
+-- | Type of field function expression generator.
+type FieldFunExp = M.Map Name Name -> M.Map Name [Name] -> Type -> Q Exp
+
+-- | Default field function expression generator.
+defaultFieldFunExp :: [Name] -> FieldFunExp
+defaultFieldFunExp unaryOpFunNames argToFunPat _ = go
+  where
+    go ty = do
+      let allArgNames = M.keysSet argToFunPat
+      let typeHasNoArg ty =
+            S.fromList (freeVariables [ty])
+              `S.intersection` allArgNames
+              == S.empty
+      let fun0 = varE $ head unaryOpFunNames
+          fun1 b = [|$(varE $ unaryOpFunNames !! 1) $(go b)|]
+          fun2 b c = [|$(varE $ unaryOpFunNames !! 2) $(go b) $(go c)|]
+          fun3 b c d =
+            [|$(varE $ unaryOpFunNames !! 3) $(go b) $(go c) $(go d)|]
+      case ty of
+        AppT (AppT (AppT (VarT _) b) c) d -> fun3 b c d
+        AppT (AppT (VarT _) b) c -> fun2 b c
+        AppT (VarT _) b -> fun1 b
+        _ | typeHasNoArg ty -> fun0
+        AppT a b | typeHasNoArg a -> fun1 b
+        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
+        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3 b c d
+        VarT nm -> case M.lookup nm argToFunPat of
+          Just pname -> varE pname
+          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
+
+-- | Configuration for a unary function field expression generation on a GADT.
+data UnaryOpConfig where
+  UnaryOpConfig ::
+    (UnaryOpFunConfig config) => config -> [Name] -> UnaryOpConfig
+
+-- | Default field result function.
+defaultFieldResFun ::
+  ConstructorVariant -> Name -> [Exp] -> Int -> Exp -> Exp -> Q (Exp, [Bool])
+defaultFieldResFun _ _ extraPatExps _ fieldPatExp defaultFieldFunExp = do
+  res <-
+    appE
+      ( foldl
+          (\exp name -> appE exp (return name))
+          (return defaultFieldFunExp)
+          extraPatExps
+      )
+      (return fieldPatExp)
+  return (res, (True <$ extraPatExps))
+
+funPatAndExps ::
+  FieldFunExp ->
+  (Int -> [String]) ->
+  [(Type, Kind)] ->
+  [Type] ->
+  Q ([Pat], [[Pat]], [Exp])
+funPatAndExps fieldFunExpGen extraLiftedPatNames argTypes fields = do
+  let usedArgs = S.fromList $ freeVariables fields
+  let liftedNames = extraLiftedPatNames (length argTypes)
+  args <-
+    traverse
+      ( \(ty, _) -> do
+          case ty of
+            VarT nm ->
+              if S.member nm usedArgs
+                then do
+                  pname <- newName "p"
+                  epname <- traverse newName liftedNames
+                  return (nm, Just (pname, epname))
+                else return ('undefined, Nothing)
+            _ -> return ('undefined, Nothing)
+      )
+      argTypes
+  let argToFunPat =
+        M.fromList $ mapMaybe (\(nm, mpat) -> fmap ((nm,) . fst) mpat) args
+  let argToLiftedPat =
+        M.fromList $ mapMaybe (\(nm, mpat) -> fmap ((nm,) . snd) mpat) args
+  let funPats = fmap (maybe WildP (VarP . fst) . snd) args
+  let extraLiftedPats =
+        fmap
+          ( maybe
+              (replicate (length liftedNames) WildP)
+              (fmap VarP . snd)
+              . snd
+          )
+          args
+  defaultFieldFunExps <-
+    traverse
+      (fieldFunExpGen argToFunPat argToLiftedPat)
+      fields
+  return (funPats, extraLiftedPats, defaultFieldFunExps)
+
+-- | Generate a clause for a unary function on a GADT.
+genUnaryOpFieldClause ::
+  UnaryOpFieldConfig ->
+  [(Type, Kind)] ->
+  Int ->
+  Int ->
+  ConstructorInfo ->
+  Q Clause
+genUnaryOpFieldClause
+  (UnaryOpFieldConfig {..})
+  argTypes
+  totalConNumber
+  conIdx
+  conInfo = do
+    fields <- mapM resolveTypeSynonyms $ constructorFields conInfo
+    (funPats, funLiftedPats, defaultFieldFunExps) <-
+      funPatAndExps fieldFunExp extraLiftedPatNames argTypes fields
+    extraPatNames <- traverse newName extraPatNames
+    let extraPatExps = fmap VarE extraPatNames
+    fieldsPatNames <- replicateM (length fields) $ newName "field"
+    let extraPats = fmap VarP extraPatNames
+    fieldPats <- conP (constructorName conInfo) (fmap varP fieldsPatNames)
+    let fieldPatExps = fmap VarE fieldsPatNames
+
+    fieldResExpsAndArgsUsed <-
+      sequence $
+        zipWith3
+          ( fieldResFun
+              (constructorVariant conInfo)
+              (constructorName conInfo)
+              extraPatExps
+          )
+          [0 ..]
+          fieldPatExps
+          defaultFieldFunExps
+    let fieldResExps = fst <$> fieldResExpsAndArgsUsed
+    let extraArgsUsedByFields = snd <$> fieldResExpsAndArgsUsed
+
+    (resExp, extraArgsUsedByResult) <-
+      fieldCombineFun
+        totalConNumber
+        conIdx
+        (constructorVariant conInfo)
+        (constructorName conInfo)
+        extraPatExps
+        fieldResExps
+    let resUsedNames = allUsedNames resExp
+    let extraArgsUsed =
+          fmap or $
+            List.transpose $
+              extraArgsUsedByResult : extraArgsUsedByFields
+    let extraArgsPats =
+          zipWith
+            (\pat used -> if used then pat else WildP)
+            extraPats
+            extraArgsUsed
+    let transformPat (VarP nm) =
+          if S.member nm resUsedNames then VarP nm else WildP
+        transformPat p = p
+    return $
+      Clause
+        ( fmap transformPat $
+            concat (zipWith (:) funPats funLiftedPats)
+              ++ extraArgsPats
+              ++ [fieldPats]
+        )
+        (NormalB resExp)
+        []
+
+-- | Configuration for a unary operation type class generation on a GADT.
+data UnaryOpClassConfig = UnaryOpClassConfig
+  { unaryOpConfigs :: [UnaryOpConfig],
+    unaryOpInstanceNames :: [Name],
+    unaryOpContextNames :: Maybe [Name],
+    unaryOpExtraVars :: DeriveConfig -> Q [(Type, Kind)],
+    unaryOpInstanceTypeFromConfig ::
+      DeriveConfig ->
+      [(Type, Kind)] ->
+      [(Type, Kind)] ->
+      Name ->
+      Q Type,
+    unaryOpAllowExistential :: Bool
+  }
+
+-- | Default unary operation instance type generator.
+defaultUnaryOpInstanceTypeFromConfig ::
+  DeriveConfig -> [(Type, Kind)] -> [(Type, Kind)] -> Name -> Q Type
+defaultUnaryOpInstanceTypeFromConfig _ _ _ = conT
+
+-- | Configuration for the derivation rules for a unary operation that can be
+-- derived by transforming each field and then combining the results.
+data UnaryOpFieldConfig = UnaryOpFieldConfig
+  { extraPatNames :: [String],
+    extraLiftedPatNames :: Int -> [String],
+    fieldResFun ::
+      ConstructorVariant ->
+      Name ->
+      [Exp] ->
+      Int ->
+      Exp ->
+      Exp ->
+      Q (Exp, [Bool]),
+    fieldCombineFun ::
+      -- \| Total number of constructors
+      Int ->
+      -- \| Constructor index
+      Int ->
+      -- \| Constructor variant
+      ConstructorVariant ->
+      -- \| Constructor name
+      Name ->
+      -- \| Extra pattern expressions
+      [Exp] ->
+      -- \| Field result expressions
+      [Exp] ->
+      Q (Exp, [Bool]),
+    fieldFunExp :: FieldFunExp
+  }
+
+-- | Configuration for the derivation rules for a unary operation.
+class UnaryOpFunConfig config where
+  genUnaryOpFun ::
+    -- | Derive configuration
+    DeriveConfig ->
+    -- | Configuration
+    config ->
+    -- | Function names
+    [Name] ->
+    -- | Number of functor arguments to the class
+    Int ->
+    -- | Extra variables
+    [(Type, Kind)] ->
+    -- | Kept variables
+    [(Type, Kind)] ->
+    -- | Argument variables
+    [(Type, Kind)] ->
+    -- | Whether the variable is used in fields
+    (Name -> Bool) ->
+    -- | Constructor infos
+    [ConstructorInfo] ->
+    Q Dec
+
+instance UnaryOpFunConfig UnaryOpFieldConfig where
+  genUnaryOpFun _ _ funNames n _ _ _ _ [] =
+    funD (funNames !! n) [clause [] (normalB [|error "impossible"|]) []]
+  genUnaryOpFun _ config funNames n _ _ argTypes _ constructors = do
+    clauses <-
+      zipWithM
+        ( genUnaryOpFieldClause
+            config
+            argTypes
+            (length constructors)
+        )
+        [0 ..]
+        constructors
+    let instanceFunName = funNames !! n
+    return $ FunD instanceFunName clauses
+
+-- | Generate a unary operation type class instance for a data type.
+genUnaryOpClass ::
+  DeriveConfig ->
+  UnaryOpClassConfig ->
+  Int ->
+  Name ->
+  Q [Dec]
+genUnaryOpClass deriveConfig (UnaryOpClassConfig {..}) n typName = do
+  result@CheckArgsResult {..} <-
+    specializeResult (evalModeSpecializeList deriveConfig)
+      =<< freshenCheckArgsResult True
+      =<< checkArgs
+        (nameBase $ head unaryOpInstanceNames)
+        (length unaryOpInstanceNames - 1)
+        typName
+        unaryOpAllowExistential
+        n
+  extraVars <- unaryOpExtraVars deriveConfig
+
+  let isTypeUsedInFields (VarT nm) = isVarUsedInFields result nm
+      isTypeUsedInFields _ = False
+  contextInstanceTypes <-
+    traverse
+      (unaryOpInstanceTypeFromConfig deriveConfig extraVars keptVars)
+      (fromMaybe unaryOpInstanceNames unaryOpContextNames)
+  ctxs <-
+    traverse (uncurry $ ctxForVar contextInstanceTypes) $
+      filter (isTypeUsedInFields . fst) $
+        fmap snd $
+          filter (not . (`elem` unconstrainedPositions deriveConfig) . fst) $
+            zip [0 ..] keptVars
+  let keptType = foldl AppT (ConT typName) $ fmap fst keptVars
+  instanceFuns <-
+    traverse
+      ( \(UnaryOpConfig config funNames) ->
+          genUnaryOpFun
+            deriveConfig
+            config
+            funNames
+            n
+            extraVars
+            keptVars
+            argVars
+            (isVarUsedInFields result)
+            constructors
+      )
+      unaryOpConfigs
+  let instanceName = unaryOpInstanceNames !! n
+  instanceTypes <-
+    traverse
+      (unaryOpInstanceTypeFromConfig deriveConfig extraVars keptVars)
+      unaryOpInstanceNames
+  let instanceType = AppT (instanceTypes !! n) keptType
+  extraPreds <-
+    extraConstraint
+      deriveConfig
+      typName
+      instanceName
+      extraVars
+      keptVars
+      constructors
+  return
+    [ InstanceD
+        Nothing
+        ( extraPreds
+            ++ if null constructors
+              then []
+              else catMaybes ctxs
+        )
+        instanceType
+        instanceFuns
+    ]
diff --git a/src/Grisette/Internal/TH/Derivation/UnifiedOpCommon.hs b/src/Grisette/Internal/TH/Derivation/UnifiedOpCommon.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Internal/TH/Derivation/UnifiedOpCommon.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module      :   Grisette.Internal.TH.Derivation.UnifiedOpCommon
+-- Copyright   :   (c) Sirui Lu 2024
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Internal.TH.Derivation.UnifiedOpCommon
+  ( UnaryOpUnifiedConfig (..),
+    defaultUnaryOpUnifiedFun,
+  )
+where
+
+import Grisette.Internal.TH.Derivation.Common (DeriveConfig (evalModeConfig))
+import Grisette.Internal.TH.Derivation.UnaryOpCommon
+  ( UnaryOpFunConfig (genUnaryOpFun),
+  )
+import Grisette.Internal.Unified.Util (withMode)
+import Language.Haskell.TH
+  ( Exp (VarE),
+    Kind,
+    Name,
+    Q,
+    Type (AppT, ArrowT, StarT, VarT),
+    appE,
+    clause,
+    funD,
+    newName,
+    normalB,
+    varE,
+    varP,
+  )
+
+-- | Default implementation for the derivation rules for a unified operation.
+defaultUnaryOpUnifiedFun :: [Name] -> Type -> (Type, Kind) -> Q (Maybe Exp)
+defaultUnaryOpUnifiedFun funNames modeTy (ty, kind) =
+  case kind of
+    StarT ->
+      Just
+        <$> [|
+          $(varE $ head funNames) @($(return modeTy))
+            @($(return ty))
+          |]
+    AppT (AppT ArrowT StarT) StarT ->
+      Just
+        <$> [|
+          $(varE $ funNames !! 1) @($(return modeTy))
+            @($(return ty))
+          |]
+    AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
+      Just
+        <$> [|
+          $(varE $ funNames !! 2) @($(return modeTy))
+            @($(return ty))
+          |]
+    _ -> return Nothing
+
+-- | Configuration for the derivation rules for a unified operation.
+newtype UnaryOpUnifiedConfig = UnaryOpUnifiedConfig
+  {unifiedFun :: Type -> (Type, Kind) -> Q (Maybe Exp)}
+
+instance UnaryOpFunConfig UnaryOpUnifiedConfig where
+  genUnaryOpFun
+    deriveConfig
+    (UnaryOpUnifiedConfig {..})
+    funNames
+    n
+    extraVars
+    keptTypes
+    _
+    isVarUsedInFields
+    _ = do
+      modeTy <- case evalModeConfig deriveConfig of
+        [] -> return $ fst $ head extraVars
+        [(i, _)] -> return $ fst $ keptTypes !! i
+        _ -> fail "Unified classes does not support multiple evaluation modes"
+      let isTypeUsedInFields (VarT nm) = isVarUsedInFields nm
+          isTypeUsedInFields _ = False
+      exprs <-
+        traverse (unifiedFun modeTy) $
+          filter (isTypeUsedInFields . fst) keptTypes
+      rVar <- newName "r"
+      let rf =
+            foldl
+              ( \exp nextFun -> case nextFun of
+                  Nothing -> exp
+                  Just fun -> appE (return fun) exp
+              )
+              (return $ VarE rVar)
+              exprs
+      let instanceFunName = funNames !! n
+      funD
+        instanceFunName
+        [ clause
+            [varP rVar]
+            ( normalB
+                [|
+                  withMode @($(return modeTy)) $(rf) $(rf)
+                  |]
+            )
+            []
+        ]
diff --git a/src/Grisette/Internal/TH/GADT/BinaryOpCommon.hs b/src/Grisette/Internal/TH/GADT/BinaryOpCommon.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/BinaryOpCommon.hs
+++ /dev/null
@@ -1,377 +0,0 @@
-{-# LANGUAGE ExplicitNamespaces #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.BinaryOpCommon
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.BinaryOpCommon
-  ( BinaryOpClassConfig (..),
-    BinaryOpFieldConfig (..),
-    FieldFunExp,
-    defaultFieldFunExp,
-    genBinaryOpClause,
-    genBinaryOpClass,
-  )
-where
-
-import Control.Monad (replicateM, unless, when, zipWithM)
-import Control.Monad.Identity (IdentityT)
-import qualified Data.List as List
-import qualified Data.Map as M
-import Data.Maybe (catMaybes, mapMaybe)
-import Data.Proxy (Proxy (Proxy))
-import qualified Data.Set as S
-import Grisette.Internal.TH.GADT.Common
-  ( CheckArgsResult
-      ( argVars,
-        constructors,
-        keptVars
-      ),
-    DeriveConfig,
-    checkArgs,
-    ctxForVar,
-    evalModeSpecializeList,
-    extraConstraint,
-    freshenCheckArgsResult,
-    isVarUsedInFields,
-    specializeResult,
-  )
-import Language.Haskell.TH
-  ( Clause,
-    Dec (FunD, InstanceD),
-    Exp (VarE),
-    Kind,
-    Name,
-    Pat (VarP, WildP),
-    Q,
-    Type (AppT, ConT, VarT),
-    clause,
-    conP,
-    nameBase,
-    newName,
-    normalB,
-    recP,
-    sigP,
-    varE,
-    varP,
-    varT,
-    wildP,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorInfo (constructorFields, constructorName, constructorVars),
-    TypeSubstitution (freeVariables),
-    resolveTypeSynonyms,
-    tvName,
-  )
-import Type.Reflection
-  ( TypeRep,
-    eqTypeRep,
-    someTypeRep,
-    typeRep,
-    type (:~~:) (HRefl),
-  )
-
--- | Type of field function expression generator.
-type FieldFunExp = M.Map Name Name -> Type -> Q Exp
-
--- | Default field function expression generator.
-defaultFieldFunExp :: [Name] -> FieldFunExp
-defaultFieldFunExp binaryOpFunNames argToFunPat = go
-  where
-    go ty = do
-      let allArgNames = M.keysSet argToFunPat
-      let typeHasNoArg ty =
-            S.fromList (freeVariables [ty])
-              `S.intersection` allArgNames
-              == S.empty
-      let fun0 = varE $ head binaryOpFunNames
-          fun1 b = [|$(varE $ binaryOpFunNames !! 1) $(go b)|]
-          fun2 b c = [|$(varE $ binaryOpFunNames !! 2) $(go b) $(go c)|]
-          fun3 b c d =
-            [|$(varE $ binaryOpFunNames !! 3) $(go b) $(go c) $(go d)|]
-      case ty of
-        AppT (AppT (AppT (VarT _) b) c) d -> fun3 b c d
-        AppT (AppT (VarT _) b) c -> fun2 b c
-        AppT (VarT _) b -> fun1 b
-        _ | typeHasNoArg ty -> fun0
-        AppT a b | typeHasNoArg a -> fun1 b
-        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
-        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3 b c d
-        VarT nm -> case M.lookup nm argToFunPat of
-          Just pname -> varE pname
-          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-
-funPatAndExps ::
-  FieldFunExp ->
-  [(Type, Kind)] ->
-  [Type] ->
-  Q ([Pat], [Exp])
-funPatAndExps fieldFunExpGen argTypes fields = do
-  let usedArgs = S.fromList $ freeVariables fields
-  args <-
-    traverse
-      ( \(ty, _) ->
-          case ty of
-            VarT nm ->
-              if S.member nm usedArgs
-                then do
-                  pname <- newName "p"
-                  return (nm, Just pname)
-                else return ('undefined, Nothing)
-            _ -> return ('undefined, Nothing)
-      )
-      argTypes
-  let argToFunPat =
-        M.fromList $ mapMaybe (\(ty, mpat) -> fmap (ty,) mpat) args
-  let funPats = fmap (maybe WildP VarP . snd) args
-  defaultFieldFunExps <- traverse (fieldFunExpGen argToFunPat) fields
-  return (funPats, defaultFieldFunExps)
-
--- | Configuration for a binary operation field generation on a GADT.
-data BinaryOpFieldConfig = BinaryOpFieldConfig
-  { extraPatNames :: [String],
-    fieldResFun :: [Exp] -> (Exp, Exp) -> Exp -> Q (Exp, [Bool]),
-    fieldCombineFun :: Name -> [Exp] -> Q (Exp, [Bool]),
-    fieldDifferentExistentialFun :: Exp -> Q Exp,
-    fieldLMatchResult :: Q Exp,
-    fieldRMatchResult :: Q Exp,
-    fieldFunExp :: FieldFunExp,
-    fieldFunNames :: [Name]
-  }
-
--- | Generate a clause for a binary operation on a GADT.
-genBinaryOpClause ::
-  BinaryOpFieldConfig ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  Bool ->
-  ConstructorInfo ->
-  ConstructorInfo ->
-  Q [Clause]
-genBinaryOpClause
-  (BinaryOpFieldConfig {..})
-  lhsArgNewVars
-  _rhsArgNewVars
-  isLast
-  lhsConstructors
-  rhsConstructors =
-    do
-      lhsFields <- mapM resolveTypeSynonyms $ constructorFields lhsConstructors
-      rhsFields <- mapM resolveTypeSynonyms $ constructorFields rhsConstructors
-      (funPats, defaultFieldFunExps) <-
-        funPatAndExps fieldFunExp lhsArgNewVars lhsFields
-      unless (null extraPatNames) $
-        unless isLast $
-          fail "Should not happen"
-      extraPatNames <- traverse newName extraPatNames
-      let extraPats = fmap VarP extraPatNames
-      let extraPatExps = fmap VarE extraPatNames
-      lhsFieldsPatNames <- replicateM (length lhsFields) $ newName "lhsField"
-      rhsFieldsPatNames <- replicateM (length rhsFields) $ newName "rhsField"
-      let lhsFieldPats =
-            conP
-              (constructorName lhsConstructors)
-              ( zipWith
-                  (\nm field -> sigP (varP nm) (return field))
-                  lhsFieldsPatNames
-                  lhsFields
-              )
-      let rhsFieldPats =
-            conP
-              (constructorName rhsConstructors)
-              ( zipWith
-                  (\nm field -> sigP (varP nm) (return field))
-                  rhsFieldsPatNames
-                  rhsFields
-              )
-      let singleMatchPat =
-            if null lhsFields
-              then conP (constructorName lhsConstructors) []
-              else recP (constructorName rhsConstructors) []
-      let lhsFieldPatExps = fmap VarE lhsFieldsPatNames
-      let rhsFieldPatExps = fmap VarE rhsFieldsPatNames
-
-      fieldResExpsAndArgsUsed <-
-        zipWithM
-          (fieldResFun extraPatExps)
-          (zip lhsFieldPatExps rhsFieldPatExps)
-          defaultFieldFunExps
-      let fieldResExps = fst <$> fieldResExpsAndArgsUsed
-      let extraArgsUsedByFields = snd <$> fieldResExpsAndArgsUsed
-      (resExp, extraArgsUsedByResult) <-
-        fieldCombineFun
-          (constructorName lhsConstructors)
-          fieldResExps
-
-      let eqt l r =
-            [|
-              eqTypeRep
-                (typeRep :: TypeRep $(varT $ tvName l))
-                (typeRep :: TypeRep $(varT $ tvName r))
-              |]
-      let eqx trueCont l r = do
-            cmp <-
-              [|
-                compare
-                  (someTypeRep (Proxy :: Proxy $(varT $ tvName l)))
-                  (someTypeRep (Proxy :: Proxy $(varT $ tvName r)))
-                |]
-            [|
-              case $(eqt l r) of
-                Just HRefl -> $(trueCont)
-                _ ->
-                  $(fieldDifferentExistentialFun cmp)
-              |]
-      let construct [] = return resExp
-          construct ((l, r) : xs) = [|$(eqx (construct xs) l r)|]
-
-      let extraArgsUsed =
-            fmap or $
-              List.transpose $
-                extraArgsUsedByResult : extraArgsUsedByFields
-      let extraArgsPats =
-            zipWith
-              (\pat used -> if used then pat else WildP)
-              extraPats
-              extraArgsUsed
-      bothMatched <-
-        clause
-          ((return <$> funPats ++ extraArgsPats) ++ [lhsFieldPats, rhsFieldPats])
-          ( normalB
-              [|
-                $( construct $
-                     zip
-                       (constructorVars lhsConstructors)
-                       (constructorVars rhsConstructors)
-                 )
-                |]
-          )
-          []
-      lhsMatched <-
-        clause
-          ((wildP <$ funPats) ++ [singleMatchPat, wildP])
-          (normalB [|$(fieldLMatchResult)|])
-          []
-      rhsMatched <-
-        clause
-          ((wildP <$ funPats) ++ [wildP, singleMatchPat])
-          (normalB [|$(fieldRMatchResult)|])
-          []
-      if isLast
-        then return [bothMatched]
-        else return [bothMatched, lhsMatched, rhsMatched]
-
--- | Configuration for a binary operation type class generation on a GADT.
-data BinaryOpClassConfig = BinaryOpClassConfig
-  { binaryOpFieldConfigs :: [BinaryOpFieldConfig],
-    binaryOpInstanceNames :: [Name],
-    binaryOpAllowSumType :: Bool,
-    binaryOpAllowExistential :: Bool
-  }
-
--- | Generate a function for a binary operation on a GADT.
-genBinaryOpFun ::
-  BinaryOpFieldConfig ->
-  Int ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [ConstructorInfo] ->
-  [ConstructorInfo] ->
-  Q Dec
-genBinaryOpFun
-  config
-  n
-  lhsArgNewVars
-  rhsArgNewVars
-  lhsConstructors
-  rhsConstructors = do
-    clauses <-
-      zipWithM
-        (genBinaryOpClause config lhsArgNewVars rhsArgNewVars False)
-        (init lhsConstructors)
-        (init rhsConstructors)
-    lastClause <-
-      genBinaryOpClause
-        config
-        lhsArgNewVars
-        rhsArgNewVars
-        True
-        (last lhsConstructors)
-        (last rhsConstructors)
-    let instanceFunName = (fieldFunNames config) !! n
-    return $ FunD instanceFunName (concat clauses ++ lastClause)
-
--- | Generate a type class instance for a binary operation on a GADT.
-genBinaryOpClass ::
-  DeriveConfig -> BinaryOpClassConfig -> Int -> Name -> Q [Dec]
-genBinaryOpClass deriveConfig (BinaryOpClassConfig {..}) n typName = do
-  lhsResult <-
-    specializeResult (evalModeSpecializeList deriveConfig)
-      =<< freshenCheckArgsResult True
-      =<< checkArgs
-        (nameBase $ head binaryOpInstanceNames)
-        (length binaryOpInstanceNames - 1)
-        typName
-        (n == 0 && binaryOpAllowExistential)
-        n
-  when (not binaryOpAllowSumType && length (constructors lhsResult) > 1) $
-    fail $
-      "Cannot derive "
-        <> nameBase (binaryOpInstanceNames !! n)
-        <> " for sum type"
-  rhsResult <-
-    specializeResult (evalModeSpecializeList deriveConfig)
-      =<< checkArgs
-        (nameBase $ head binaryOpInstanceNames)
-        (length binaryOpInstanceNames - 1)
-        typName
-        (n == 0)
-        n
-  let keptVars' = keptVars lhsResult
-  when (typName == ''IdentityT) $
-    fail $
-      show keptVars'
-  let isTypeUsedInFields' (VarT nm) = isVarUsedInFields lhsResult nm
-      isTypeUsedInFields' _ = False
-  ctxs <-
-    traverse (uncurry $ ctxForVar (fmap ConT binaryOpInstanceNames)) $
-      filter (isTypeUsedInFields' . fst) keptVars'
-  let keptType = foldl AppT (ConT typName) $ fmap fst keptVars'
-  instanceFuns <-
-    traverse
-      ( \config ->
-          genBinaryOpFun
-            config
-            n
-            (argVars lhsResult)
-            (argVars rhsResult)
-            (constructors lhsResult)
-            (constructors rhsResult)
-      )
-      binaryOpFieldConfigs
-  let instanceName = binaryOpInstanceNames !! n
-  let instanceType = AppT (ConT instanceName) keptType
-  extraPreds <-
-    extraConstraint
-      deriveConfig
-      typName
-      instanceName
-      []
-      keptVars'
-      (constructors lhsResult)
-  return
-    [ InstanceD
-        Nothing
-        (extraPreds ++ catMaybes ctxs)
-        instanceType
-        instanceFuns
-    ]
diff --git a/src/Grisette/Internal/TH/GADT/Common.hs b/src/Grisette/Internal/TH/GADT/Common.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/Common.hs
+++ /dev/null
@@ -1,452 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.Common
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.Common
-  ( CheckArgsResult (..),
-    checkArgs,
-    ctxForVar,
-    EvalModeConfig (..),
-    DeriveConfig (..),
-    extraEvalModeConstraint,
-    extraBitSizeConstraint,
-    extraFpBitSizeConstraint,
-    extraExtraMergeableConstraint,
-    extraConstraint,
-    specializeResult,
-    evalModeSpecializeList,
-    isVarUsedInFields,
-    freshenCheckArgsResult,
-  )
-where
-
-import Control.Monad (foldM, unless, when)
-import Data.Bifunctor (first)
-import qualified Data.Map as M
-import Data.Maybe (catMaybes, mapMaybe)
-import qualified Data.Set as S
-import GHC.TypeLits (KnownNat, Nat, type (<=))
-import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
-  ( Mergeable,
-    Mergeable1,
-    Mergeable2,
-  )
-import Grisette.Internal.SymPrim.FP (ValidFP)
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C, S))
-import Grisette.Internal.Unified.Util (DecideEvalMode)
-import Language.Haskell.TH
-  ( Kind,
-    Name,
-    Pred,
-    Q,
-    Type (AppT, ArrowT, ConT, PromotedT, StarT, VarT),
-    conT,
-    nameBase,
-    newName,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorInfo (constructorFields, constructorName, constructorVars),
-    DatatypeInfo (datatypeCons, datatypeVars),
-    TypeSubstitution (applySubstitution, freeVariables),
-    reifyDatatype,
-    tvName,
-  )
-import Language.Haskell.TH.Datatype.TyVarBndr (mapTVName, tvKind)
-
--- | Result of 'checkArgs' for a GADT.
-data CheckArgsResult = CheckArgsResult
-  { constructors :: [ConstructorInfo],
-    keptVars :: [(Type, Kind)],
-    argVars :: [(Type, Kind)]
-  }
-
--- | Specialize the evaluation mode tags for the t'CheckArgsResult'.
-specializeResult :: [(Int, EvalModeTag)] -> CheckArgsResult -> Q CheckArgsResult
-specializeResult evalModeConfigs result = do
-  let modeToName C = 'C
-      modeToName S = 'S
-  map <-
-    foldM
-      ( \lst (n, tag) -> do
-          let (_, knd) = lst !! n
-          return $
-            take n lst
-              ++ [(PromotedT $ modeToName tag, knd)]
-              ++ drop (n + 1) lst
-      )
-      (keptVars result)
-      evalModeConfigs
-  return $ result {keptVars = map}
-
-freshenConstructorInfo :: ConstructorInfo -> Q ConstructorInfo
-freshenConstructorInfo conInfo = do
-  let vars = constructorVars conInfo
-  newNames <- traverse (newName . nameBase . tvName) vars
-  let newVars = zipWith (mapTVName . const) newNames vars
-  let substMap = M.fromList $ zip (tvName <$> vars) $ VarT <$> newNames
-  return $ applySubstitution substMap conInfo {constructorVars = newVars}
-
--- | Freshen the type variables in the t'CheckArgsResult'.
-freshenCheckArgsResult :: Bool -> CheckArgsResult -> Q CheckArgsResult
-freshenCheckArgsResult freshenNats result = do
-  let genNewName :: (Type, Kind) -> Q (Maybe Name)
-      genNewName (VarT _, knd) =
-        if not freshenNats && knd == ConT ''Nat
-          then return Nothing
-          else Just <$> newName "a"
-      genNewName _ = return Nothing
-  keptNewNames <- traverse genNewName (keptVars result)
-  argNewNames <- traverse genNewName (argVars result)
-
-  let substMap =
-        M.fromList
-          $ mapMaybe
-            ( \(newName, oldVar) ->
-                case (newName, oldVar) of
-                  (Just newName, (VarT oldName, _)) ->
-                    Just (oldName, VarT newName)
-                  _ -> Nothing
-            )
-          $ zip
-            (keptNewNames ++ argNewNames)
-            (keptVars result ++ argVars result)
-  constructors <-
-    mapM freshenConstructorInfo $
-      applySubstitution substMap $
-        constructors result
-  let newKeptVars = first (applySubstitution substMap) <$> (keptVars result)
-  let newArgVars = first (applySubstitution substMap) <$> (argVars result)
-  return $
-    result
-      { constructors = constructors,
-        keptVars = newKeptVars,
-        argVars = newArgVars
-      }
-
--- | Check if the number of type parameters is valid for a GADT, and return
--- new names for the type variables, split into kept and arg parts.
-checkArgs ::
-  String ->
-  Int ->
-  Name ->
-  Bool ->
-  Int ->
-  Q CheckArgsResult
-checkArgs clsName maxArgNum typName allowExistential n = do
-  when (n < 0) $
-    fail $
-      unlines
-        [ "Cannot derive "
-            ++ clsName
-            ++ " instance with negative type parameters",
-          "\tRequested: " ++ show n,
-          "\tHint: Use a non-negative number of type parameters"
-        ]
-  when (n > maxArgNum) $
-    fail $
-      unlines
-        [ "Cannot derive "
-            <> clsName
-            <> " instance with more than "
-            <> show maxArgNum
-            <> " type parameters",
-          "\tRequested: " <> show n
-        ]
-  d <- reifyDatatype typName
-  let dvars = datatypeVars d
-  when (length dvars < n) $
-    fail $
-      unlines
-        [ "Cannot derive "
-            <> clsName
-            <> show n
-            <> " instance for the type "
-            <> show typName,
-          "\tReason: The type "
-            <> show typName
-            <> " has only "
-            <> show (length dvars)
-            <> " type variables."
-        ]
-  let keptVars =
-        (\bndr -> (VarT $ tvName bndr, tvKind bndr))
-          <$> take (length dvars - n) dvars
-  let argVars =
-        (\bndr -> (VarT $ tvName bndr, tvKind bndr))
-          <$> drop (length dvars - n) dvars
-  let constructors = datatypeCons d
-  unless allowExistential $
-    mapM_
-      ( \c ->
-          when (constructorVars c /= []) $
-            fail $
-              unlines
-                [ "Cannot derive "
-                    <> clsName
-                    <> show n
-                    <> " instance for the type "
-                    <> show typName,
-                  "\tReason: The constructor "
-                    <> nameBase (constructorName c)
-                    <> " has existential variables"
-                ]
-      )
-      constructors
-  mapM_
-    ( \c -> do
-        let fields = constructorFields c
-        let existentialVars = tvName <$> constructorVars c
-        let fieldReferencedVars = freeVariables fields
-        let notReferencedVars =
-              S.fromList existentialVars S.\\ S.fromList fieldReferencedVars
-        unless (null notReferencedVars) $
-          fail $
-            unlines
-              [ "Cannot derive "
-                  <> clsName
-                  <> show n
-                  <> " instance for the type "
-                  <> show typName,
-                "Reason: Ambiguous existential variable in the constructor: "
-                  <> nameBase (constructorName c)
-                  <> ", this is not supported. Please consider binding the "
-                  <> "existential variable to a field. You can use Proxy type to "
-                  <> "do this."
-              ]
-    )
-    constructors
-  return $ CheckArgsResult {..}
-
-isVarUsedInConstructorFields :: [ConstructorInfo] -> Name -> Bool
-isVarUsedInConstructorFields constructors var =
-  let allFields = concatMap constructorFields constructors
-      allFieldsFreeVars = S.fromList $ freeVariables allFields
-   in S.member var allFieldsFreeVars
-
--- | Check if a variable is used in the fields of a constructor.
-isVarUsedInFields :: CheckArgsResult -> Name -> Bool
-isVarUsedInFields CheckArgsResult {..} =
-  isVarUsedInConstructorFields constructors
-
--- | Generate a context for a variable in a GADT.
-ctxForVar :: [Type] -> Type -> Kind -> Q (Maybe Pred)
-ctxForVar instanceExps ty knd = case knd of
-  StarT ->
-    Just
-      <$> [t|$(return $ head instanceExps) $(return ty)|]
-  AppT (AppT ArrowT StarT) StarT ->
-    Just
-      <$> [t|$(return $ instanceExps !! 1) $(return ty)|]
-  AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
-    Just
-      <$> [t|$(return $ instanceExps !! 2) $(return ty)|]
-  AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) StarT ->
-    Just
-      <$> [t|$(return $ instanceExps !! 3) $(return ty)|]
-  AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) _ ->
-    fail $ "Unsupported kind: " <> show knd
-  _ -> return Nothing
-
--- | Configuration for constraints for evaluation modes tag.
---
--- * 'EvalModeConstraints' specifies a list of constraints for the tag, for
---   example, we may use 'Grisette.Unified.EvalModeBase' and
---   'Grisette.Unified.EvalModeBV' to specify that the evaluation mode must
---   support both base (boolean and data types) and bit vectors. This should be
---   used when the data type uses bit vectors.
---
--- * 'EvalModeSpecified' specifies a that an evaluation mode tag should be
---   specialized to a specific tag for all the instances.
-data EvalModeConfig
-  = EvalModeConstraints [Name]
-  | EvalModeSpecified EvalModeTag
-
--- | Configuration for deriving instances for a GADT.
-data DeriveConfig = DeriveConfig
-  { evalModeConfig :: [(Int, EvalModeConfig)],
-    bitSizePositions :: [Int],
-    fpBitSizePositions :: [(Int, Int)],
-    needExtraMergeableUnderEvalMode :: Bool,
-    needExtraMergeableWithConcretizedEvalMode :: Bool
-  }
-
--- | Get all the evaluation modes to specialize in the t'DeriveConfig'.
-evalModeSpecializeList :: DeriveConfig -> [(Int, EvalModeTag)]
-evalModeSpecializeList DeriveConfig {..} =
-  mapMaybe
-    ( \(n, cfg) ->
-        case cfg of
-          EvalModeConstraints _ -> Nothing
-          EvalModeSpecified tag -> Just (n, tag)
-    )
-    evalModeConfig
-
-instance Semigroup DeriveConfig where
-  (<>) = (<>)
-
-instance Monoid DeriveConfig where
-  mempty = DeriveConfig [] [] [] False False
-  mappend = (<>)
-
--- | Generate extra constraints for evaluation modes.
-extraEvalModeConstraint ::
-  Name -> Name -> [(Type, Kind)] -> (Int, EvalModeConfig) -> Q [Pred]
-extraEvalModeConstraint
-  tyName
-  instanceName
-  args
-  (n, EvalModeConstraints names)
-    | n >= length args = return []
-    | otherwise = do
-        let (arg, argKind) = args !! n
-        when (argKind /= ConT ''EvalModeTag) $
-          fail $
-            "Cannot introduce EvalMode constraint for the "
-              <> show n
-              <> "th argument of "
-              <> show tyName
-              <> " when deriving the "
-              <> show instanceName
-              <> " instance because it is not an EvalModeTag."
-        traverse (\nm -> [t|$(conT nm) $(return arg)|]) names
-extraEvalModeConstraint _ _ _ (_, EvalModeSpecified _) = return []
-
--- | Generate extra constraints for bit vectors.
-extraBitSizeConstraint :: Name -> Name -> [(Type, Kind)] -> Int -> Q [Pred]
-extraBitSizeConstraint tyName instanceName args n
-  | n >= length args = return []
-  | otherwise = do
-      let (arg, argKind) = args !! n
-      when (argKind /= ConT ''Nat) $
-        fail $
-          "Cannot introduce BitSize constraint for the "
-            <> show n
-            <> "th argument of "
-            <> show tyName
-            <> " when deriving the "
-            <> show instanceName
-            <> " instance because it is not a Nat."
-      predKnown <- [t|KnownNat $(return arg)|]
-      predPositive <- [t|1 <= $(return arg)|]
-      return [predKnown, predPositive]
-
--- | Generate extra constraints for floating point exponents and significands.
-extraFpBitSizeConstraint ::
-  Name -> Name -> [(Type, Kind)] -> (Int, Int) -> Q [Pred]
-extraFpBitSizeConstraint tyName instanceName args (eb, sb)
-  | eb >= length args || sb >= length args = return []
-  | otherwise = do
-      let (argEb, argEbKind) = args !! eb
-      let (argSb, argSbKind) = args !! sb
-      when (argEbKind /= ConT ''Nat || argSbKind /= ConT ''Nat) $
-        fail $
-          "Cannot introduce ValidFP constraint for the "
-            <> show eb
-            <> "th and "
-            <> show sb
-            <> "th arguments of "
-            <> show tyName
-            <> " when deriving the "
-            <> show instanceName
-            <> " instance because they are not Nats."
-      pred <- [t|ValidFP $(return argEb) $(return argSb)|]
-      return [pred]
-
--- | Generate extra constraints for 'Mergeable' instances.
-extraExtraMergeableConstraint :: [ConstructorInfo] -> [(Type, Kind)] -> Q [Pred]
-extraExtraMergeableConstraint constructors args = do
-  let isTypeUsedInFields' (VarT nm) =
-        isVarUsedInConstructorFields constructors nm
-      isTypeUsedInFields' _ = False
-  catMaybes
-    <$> traverse
-      ( \(arg, knd) ->
-          if isTypeUsedInFields' arg
-            then
-              ctxForVar
-                [ ConT ''Mergeable,
-                  ConT ''Mergeable1,
-                  ConT ''Mergeable2
-                ]
-                arg
-                knd
-            else return Nothing
-      )
-      args
-
--- | Generate extra constraints for a GADT.
-extraConstraint ::
-  DeriveConfig ->
-  Name ->
-  Name ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [ConstructorInfo] ->
-  Q [Pred]
-extraConstraint
-  DeriveConfig {..}
-  tyName
-  instanceName
-  extraArgs
-  keptArgs
-  constructors = do
-    -- checkAllValidExtraConstraintPosition
-    --   deriveConfig
-    --   tyName
-    --   instanceName
-    --   keptArgs
-    evalModePreds <-
-      traverse
-        (extraEvalModeConstraint tyName instanceName keptArgs)
-        evalModeConfig
-    extraArgEvalModePreds <-
-      if null evalModeConfig
-        then
-          traverse
-            ( \(arg, kind) ->
-                if kind == ConT ''EvalModeTag
-                  then (: []) <$> [t|DecideEvalMode $(return arg)|]
-                  else return []
-            )
-            extraArgs
-        else return []
-    bitSizePreds <-
-      traverse
-        (extraBitSizeConstraint tyName instanceName keptArgs)
-        bitSizePositions
-    fpBitSizePreds <-
-      traverse
-        (extraFpBitSizeConstraint tyName instanceName keptArgs)
-        fpBitSizePositions
-    extraMergeablePreds <-
-      if needExtraMergeableUnderEvalMode
-        && ( any
-               ( \case
-                   (_, EvalModeConstraints _) -> True
-                   (_, EvalModeSpecified _) -> False
-               )
-               evalModeConfig
-               || needExtraMergeableWithConcretizedEvalMode
-           )
-        then extraExtraMergeableConstraint constructors keptArgs
-        else return []
-    return $
-      extraMergeablePreds
-        ++ concat
-          ( extraArgEvalModePreds
-              ++ evalModePreds
-              ++ bitSizePreds
-              ++ fpBitSizePreds
-          )
diff --git a/src/Grisette/Internal/TH/GADT/ConvertOpCommon.hs b/src/Grisette/Internal/TH/GADT/ConvertOpCommon.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/ConvertOpCommon.hs
+++ /dev/null
@@ -1,469 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.ConvertOpCommon
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.ConvertOpCommon
-  ( genConvertOpClass,
-    ConvertOpClassConfig (..),
-    defaultFieldFunExp,
-  )
-where
-
-import Control.Monad (foldM, replicateM, zipWithM)
-import qualified Data.Map as M
-import Data.Maybe (catMaybes, mapMaybe)
-import qualified Data.Set as S
-import Grisette.Internal.Core.Data.Class.PlainUnion (unionToCon)
-import Grisette.Internal.Internal.Decl.Core.Control.Monad.Union (Union)
-import Grisette.Internal.Internal.Decl.Core.Data.Class.TryMerge (toUnionSym)
-import Grisette.Internal.TH.GADT.Common
-  ( CheckArgsResult (argVars, constructors, keptVars),
-    DeriveConfig
-      ( DeriveConfig,
-        bitSizePositions,
-        evalModeConfig,
-        fpBitSizePositions,
-        needExtraMergeableUnderEvalMode,
-        needExtraMergeableWithConcretizedEvalMode
-      ),
-    EvalModeConfig (EvalModeConstraints, EvalModeSpecified),
-    checkArgs,
-    extraBitSizeConstraint,
-    extraEvalModeConstraint,
-    extraExtraMergeableConstraint,
-    extraFpBitSizeConstraint,
-    freshenCheckArgsResult,
-    isVarUsedInFields,
-  )
-import Grisette.Internal.TH.Util (allUsedNames)
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C, S))
-import Grisette.Internal.Unified.Util
-  ( EvalModeConvertible (withModeConvertible'),
-  )
-import Language.Haskell.TH
-  ( Body (NormalB),
-    Clause (Clause),
-    Dec (FunD, InstanceD),
-    Exp (VarE),
-    Kind,
-    Name,
-    Overlap (Incoherent),
-    Pat (VarP, WildP),
-    Pred,
-    Q,
-    Type (AppT, ArrowT, ConT, StarT, VarT),
-    clause,
-    conP,
-    funD,
-    nameBase,
-    newName,
-    normalB,
-    varE,
-    varP,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorInfo (constructorFields, constructorName),
-    TypeSubstitution (freeVariables),
-    resolveTypeSynonyms,
-  )
-
-type FieldFunExp = M.Map Name Name -> Type -> Q Exp
-
--- | Default field transformation function.
-defaultFieldFunExp :: [Name] -> FieldFunExp
-defaultFieldFunExp binaryOpFunNames argToFunPat = go
-  where
-    go ty = do
-      let allArgNames = M.keysSet argToFunPat
-      let typeHasNoArg ty =
-            S.fromList (freeVariables [ty])
-              `S.intersection` allArgNames
-              == S.empty
-      let fun0 = varE $ head binaryOpFunNames
-          fun1 b = [|$(varE $ binaryOpFunNames !! 1) $(go b)|]
-          fun2 b c = [|$(varE $ binaryOpFunNames !! 2) $(go b) $(go c)|]
-          fun3 b c d =
-            [|$(varE $ binaryOpFunNames !! 3) $(go b) $(go c) $(go d)|]
-      case ty of
-        AppT (AppT (AppT (VarT _) b) c) d -> fun3 b c d
-        AppT (AppT (VarT _) b) c -> fun2 b c
-        AppT (VarT _) b -> fun1 b
-        _ | typeHasNoArg ty -> fun0
-        AppT a b | typeHasNoArg a -> fun1 b
-        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
-        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3 b c d
-        VarT nm -> case M.lookup nm argToFunPat of
-          Just pname -> varE pname
-          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-
-funPatAndExps ::
-  FieldFunExp ->
-  [(Type, Kind)] ->
-  [Type] ->
-  Q ([Pat], [Exp])
-funPatAndExps fieldFunExpGen argTypes fields = do
-  let usedArgs = S.fromList $ freeVariables fields
-  args <-
-    traverse
-      ( \(ty, _) ->
-          case ty of
-            VarT nm ->
-              if S.member nm usedArgs
-                then do
-                  pname <- newName "p"
-                  return (nm, Just pname)
-                else return ('undefined, Nothing)
-            _ -> return ('undefined, Nothing)
-      )
-      argTypes
-  let argToFunPat =
-        M.fromList $ mapMaybe (\(ty, mpat) -> fmap (ty,) mpat) args
-  let funPats = fmap (maybe WildP VarP . snd) args
-  defaultFieldFunExps <- traverse (fieldFunExpGen argToFunPat) fields
-  return (funPats, defaultFieldFunExps)
-
-tagPair ::
-  DeriveConfig ->
-  EvalModeTag ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [(Type, Type)]
-tagPair deriveConfig convertOpTarget lhsKeptVars rhsKeptVars =
-  let conKeptVars =
-        if convertOpTarget == S then lhsKeptVars else rhsKeptVars
-      symKeptVars =
-        if convertOpTarget == S then rhsKeptVars else lhsKeptVars
-   in mapMaybe
-        ( \case
-            (n, EvalModeConstraints _)
-              | n < length conKeptVars && n >= 0 ->
-                  Just (fst $ conKeptVars !! n, fst $ symKeptVars !! n)
-            _ -> Nothing
-        )
-        (evalModeConfig deriveConfig)
-
-caseSplitTagPairs ::
-  DeriveConfig ->
-  EvalModeTag ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  Exp ->
-  Q Exp
-caseSplitTagPairs deriveConfig convertOpTarget lhsKeptVars rhsKeptVars exp = do
-  let tags = tagPair deriveConfig convertOpTarget lhsKeptVars rhsKeptVars
-  foldM
-    ( \exp (lty, rty) ->
-        [|
-          withModeConvertible'
-            @($(return lty))
-            @($(return rty))
-            $(return exp)
-            $(return exp)
-            $(return exp)
-          |]
-    )
-    exp
-    tags
-
-genConvertOpFieldClause ::
-  DeriveConfig ->
-  ConvertOpClassConfig ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  ConstructorInfo ->
-  Q Clause
-genConvertOpFieldClause
-  deriveConfig@DeriveConfig {..}
-  ConvertOpClassConfig {..}
-  lhsKeptTypes
-  rhsKeptTypes
-  lhsArgTypes
-  _rhsArgTypes
-  lhsConInfo = do
-    fields <- mapM resolveTypeSynonyms $ constructorFields lhsConInfo
-    (funPats, defaultFieldFunExps) <- funPatAndExps convertFieldFunExp lhsArgTypes fields
-    fieldsPatNames <- replicateM (length fields) $ newName "field"
-    fieldPats <- conP (constructorName lhsConInfo) (fmap varP fieldsPatNames)
-    let fieldPatExps = fmap VarE fieldsPatNames
-    fieldResExps <- zipWithM convertFieldResFun fieldPatExps defaultFieldFunExps
-    resExp <- convertFieldCombineFun (constructorName lhsConInfo) fieldResExps
-    let resUsedNames = allUsedNames resExp
-    let transformPat (VarP nm) =
-          if S.member nm resUsedNames then VarP nm else WildP
-        transformPat p = p
-    resExpWithTags <-
-      caseSplitTagPairs
-        deriveConfig
-        convertOpTarget
-        lhsKeptTypes
-        rhsKeptTypes
-        resExp
-    -- let conKeptVars =
-    --       if convertOpTarget == S then lhsKeptTypes else rhsKeptTypes
-    -- let symKeptVars =
-    --       if convertOpTarget == S then rhsKeptTypes else lhsKeptTypes
-    -- let tags =
-    --       mapMaybe
-    --         ( \case
-    --             (n, EvalModeConstraints _)
-    --               | n < length conKeptVars && n >= 0 ->
-    --                   Just (fst $ conKeptVars !! n, fst $ symKeptVars !! n)
-    --             _ -> Nothing
-    --         )
-    --         evalModeConfig
-    -- resExpWithTags <-
-    --   foldM
-    --     ( \exp (lty, rty) ->
-    --         [|
-    --           withModeConvertible'
-    --             @($(return lty))
-    --             @($(return rty))
-    --             $(return exp)
-    --             $(return exp)
-    --             $(return exp)
-    --           |]
-    --     )
-    --     resExp
-    --     tags
-    return $
-      Clause
-        (fmap transformPat $ funPats ++ [fieldPats])
-        (NormalB resExpWithTags)
-        []
-
-genConvertOpFun ::
-  DeriveConfig ->
-  ConvertOpClassConfig ->
-  Int ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [ConstructorInfo] ->
-  Q Dec
-genConvertOpFun
-  deriveConfig
-  convertOpClassConfig
-  n
-  lhsKeptTypes
-  rhsKeptTypes
-  lhsArgTypes
-  rhsArgTypes
-  lhsConstructors = do
-    clauses <-
-      traverse
-        ( genConvertOpFieldClause
-            deriveConfig
-            convertOpClassConfig
-            lhsKeptTypes
-            rhsKeptTypes
-            lhsArgTypes
-            rhsArgTypes
-        )
-        lhsConstructors
-    let instanceFunName = (convertOpFunNames convertOpClassConfig) !! n
-    return $ FunD instanceFunName clauses
-
--- | Configuration for a convert operation class.
-data ConvertOpClassConfig = ConvertOpClassConfig
-  { convertOpTarget :: EvalModeTag,
-    convertOpInstanceNames :: [Name],
-    convertOpFunNames :: [Name],
-    convertFieldResFun :: Exp -> Exp -> Q Exp,
-    convertFieldCombineFun :: Name -> [Exp] -> Q Exp,
-    convertFieldFunExp :: FieldFunExp
-  }
-
-convertCtxForVar :: [Type] -> Type -> Type -> Kind -> Q (Maybe Pred)
-convertCtxForVar instanceExps lty rty knd = case knd of
-  StarT ->
-    Just
-      <$> [t|$(return $ head instanceExps) $(return lty) $(return rty)|]
-  AppT (AppT ArrowT StarT) StarT ->
-    Just
-      <$> [t|$(return $ instanceExps !! 1) $(return lty) $(return rty)|]
-  AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
-    Just
-      <$> [t|$(return $ instanceExps !! 2) $(return lty) $(return rty)|]
-  AppT (AppT (AppT StarT StarT) StarT) _ ->
-    fail $ "Unsupported kind: " <> show knd
-  _ -> return Nothing
-
--- | Generate extra constraints for a GADT.
-extraConstraintConvert ::
-  DeriveConfig ->
-  EvalModeTag ->
-  Name ->
-  Name ->
-  [(Type, Kind)] ->
-  [(Type, Kind)] ->
-  [ConstructorInfo] ->
-  Q [Pred]
-extraConstraintConvert
-  DeriveConfig {..}
-  convertOpTarget
-  tyName
-  instanceName
-  lhsKeptArgs
-  rhsKeptArgs
-  rhsConstructors = do
-    let conKeptVars = if convertOpTarget == S then lhsKeptArgs else rhsKeptArgs
-    let symKeptVars = if convertOpTarget == S then rhsKeptArgs else lhsKeptArgs
-
-    rhsEvalModePreds <-
-      if convertOpTarget == S && needExtraMergeableWithConcretizedEvalMode
-        then
-          traverse
-            (extraEvalModeConstraint tyName instanceName rhsKeptArgs)
-            evalModeConfig
-        else return []
-    extraArgEvalModePreds <-
-      traverse
-        ( \case
-            (n, EvalModeConstraints _)
-              | n < length lhsKeptArgs && n >= 0 ->
-                  (: [])
-                    <$> [t|
-                      EvalModeConvertible
-                        $(return $ fst $ conKeptVars !! n)
-                        $(return $ fst $ symKeptVars !! n)
-                      |]
-            _ -> return []
-        )
-        evalModeConfig
-    bitSizePreds <-
-      traverse
-        (extraBitSizeConstraint tyName instanceName lhsKeptArgs)
-        bitSizePositions
-    fpBitSizePreds <-
-      traverse
-        (extraFpBitSizeConstraint tyName instanceName lhsKeptArgs)
-        fpBitSizePositions
-    extraMergeablePreds <-
-      if convertOpTarget == S
-        && ( any
-               ( \case
-                   (_, EvalModeConstraints _) -> True
-                   (_, EvalModeSpecified _) -> False
-               )
-               evalModeConfig
-               || needExtraMergeableWithConcretizedEvalMode
-           )
-        then extraExtraMergeableConstraint rhsConstructors rhsKeptArgs
-        else return []
-    return $
-      concat
-        ( rhsEvalModePreds
-            ++ extraArgEvalModePreds
-            ++ bitSizePreds
-            ++ fpBitSizePreds
-            ++ [extraMergeablePreds]
-        )
-
--- | Generate a convert operation class instance.
-genConvertOpClass ::
-  DeriveConfig -> ConvertOpClassConfig -> Int -> Name -> Q [Dec]
-genConvertOpClass deriveConfig (ConvertOpClassConfig {..}) n typName = do
-  oldLhsResult <-
-    freshenCheckArgsResult True
-      =<< checkArgs
-        (nameBase $ head convertOpInstanceNames)
-        (length convertOpInstanceNames - 1)
-        typName
-        False
-        n
-  oldRhsResult <- freshenCheckArgsResult False oldLhsResult
-  let lResult = oldLhsResult
-  let rResult = oldRhsResult
-  let instanceName = convertOpInstanceNames !! n
-  let lKeptVars = keptVars lResult
-  let rKeptVars = keptVars rResult
-  let lConstructors = constructors lResult
-  let rConstructors = constructors rResult
-  let lKeptType = foldl AppT (ConT typName) $ fmap fst lKeptVars
-  let rKeptType = foldl AppT (ConT typName) $ fmap fst rKeptVars
-  extraPreds <-
-    extraConstraintConvert
-      deriveConfig
-      convertOpTarget
-      typName
-      instanceName
-      lKeptVars
-      rKeptVars
-      rConstructors
-  unionExtraPreds <-
-    extraConstraintConvert
-      deriveConfig {needExtraMergeableWithConcretizedEvalMode = True}
-      convertOpTarget
-      typName
-      instanceName
-      lKeptVars
-      rKeptVars
-      rConstructors
-
-  let instanceType = AppT (AppT (ConT instanceName) lKeptType) rKeptType
-  let isTypeUsedInFields (VarT nm) = isVarUsedInFields lResult nm
-      isTypeUsedInFields _ = False
-  ctxs <-
-    traverse
-      ( \((lty, knd), (rty, _)) ->
-          convertCtxForVar (ConT <$> convertOpInstanceNames) lty rty knd
-      )
-      $ filter (isTypeUsedInFields . fst . fst)
-      $ zip lKeptVars rKeptVars
-
-  instanceFun <-
-    genConvertOpFun
-      deriveConfig
-      (ConvertOpClassConfig {..})
-      n
-      (keptVars lResult)
-      (keptVars rResult)
-      (argVars lResult)
-      (argVars rResult)
-      lConstructors
-
-  let instanceUnionType =
-        case convertOpTarget of
-          S ->
-            AppT
-              (AppT (ConT instanceName) lKeptType)
-              (AppT (ConT ''Union) rKeptType)
-          C ->
-            AppT
-              (AppT (ConT instanceName) (AppT (ConT ''Union) lKeptType))
-              rKeptType
-  instanceUnionFun <- do
-    resExp <-
-      if convertOpTarget == S
-        then varE 'toUnionSym
-        else varE 'unionToCon
-    funD (head convertOpFunNames) [clause [] (normalB $ return resExp) []]
-
-  return $
-    InstanceD
-      (Just Incoherent)
-      (extraPreds ++ catMaybes ctxs)
-      instanceType
-      [instanceFun]
-      : ( [ InstanceD
-              (Just Incoherent)
-              (unionExtraPreds ++ catMaybes ctxs)
-              instanceUnionType
-              [instanceUnionFun]
-            | n == 0
-          ]
-        )
diff --git a/src/Grisette/Internal/TH/GADT/DeriveAllSyms.hs b/src/Grisette/Internal/TH/GADT/DeriveAllSyms.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveAllSyms.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveAllSyms
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveAllSyms
-  ( deriveGADTAllSyms,
-    deriveGADTAllSyms1,
-    deriveGADTAllSyms2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.SymPrim.AllSyms
-  ( AllSyms (allSymsS),
-    AllSyms1 (liftAllSymsS),
-    AllSyms2 (liftAllSymsS2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultFieldFunExp,
-    defaultFieldResFun,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Language.Haskell.TH (Dec, Exp (AppE, ListE, VarE), Name, Q)
-
-allSymsConfig :: UnaryOpClassConfig
-allSymsConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = [],
-                extraLiftedPatNames = const [],
-                fieldResFun = defaultFieldResFun,
-                fieldCombineFun = \_ _ _ _ exp ->
-                  return (AppE (VarE 'mconcat) $ ListE exp, False <$ exp),
-                fieldFunExp =
-                  defaultFieldFunExp
-                    [ 'allSymsS,
-                      'liftAllSymsS,
-                      'liftAllSymsS2
-                    ]
-              }
-            ['allSymsS, 'liftAllSymsS, 'liftAllSymsS2]
-        ],
-      unaryOpInstanceNames = [''AllSyms, ''AllSyms1, ''AllSyms2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'AllSyms' instance for a GADT.
-deriveGADTAllSyms :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTAllSyms deriveConfig = genUnaryOpClass deriveConfig allSymsConfig 0
-
--- | Derive 'AllSyms1' instance for a GADT.
-deriveGADTAllSyms1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTAllSyms1 deriveConfig = genUnaryOpClass deriveConfig allSymsConfig 1
-
--- | Derive 'AllSyms2' instance for a GADT.
-deriveGADTAllSyms2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTAllSyms2 deriveConfig = genUnaryOpClass deriveConfig allSymsConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveEq.hs b/src/Grisette/Internal/TH/GADT/DeriveEq.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveEq.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveEq
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveEq
-  ( deriveGADTEq,
-    deriveGADTEq1,
-    deriveGADTEq2,
-  )
-where
-
-import Data.Functor.Classes (Eq1 (liftEq), Eq2 (liftEq2))
-import Grisette.Internal.TH.GADT.BinaryOpCommon
-  ( BinaryOpClassConfig
-      ( BinaryOpClassConfig,
-        binaryOpAllowSumType,
-        binaryOpFieldConfigs,
-        binaryOpInstanceNames
-      ),
-    BinaryOpFieldConfig
-      ( BinaryOpFieldConfig,
-        extraPatNames,
-        fieldCombineFun,
-        fieldDifferentExistentialFun,
-        fieldFunExp,
-        fieldFunNames,
-        fieldLMatchResult,
-        fieldRMatchResult,
-        fieldResFun
-      ),
-    binaryOpAllowExistential,
-    defaultFieldFunExp,
-    genBinaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Language.Haskell.TH (Dec, Exp (ListE), Q)
-import Language.Haskell.TH.Syntax (Name)
-
-eqConfig :: BinaryOpClassConfig
-eqConfig =
-  BinaryOpClassConfig
-    { binaryOpFieldConfigs =
-        [ BinaryOpFieldConfig
-            { extraPatNames = [],
-              fieldResFun = \_ (lhs, rhs) f ->
-                (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
-              fieldCombineFun = \_ lst ->
-                (,[]) <$> [|and $(return $ ListE lst)|],
-              fieldDifferentExistentialFun = const [|False|],
-              fieldFunExp = defaultFieldFunExp ['(==), 'liftEq, 'liftEq2],
-              fieldFunNames = ['(==), 'liftEq, 'liftEq2],
-              fieldLMatchResult = [|False|],
-              fieldRMatchResult = [|False|]
-            }
-        ],
-      binaryOpInstanceNames = [''Eq, ''Eq1, ''Eq2],
-      binaryOpAllowSumType = True,
-      binaryOpAllowExistential = True
-    }
-
--- | Derive 'Eq' instance for a GADT.
-deriveGADTEq :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTEq deriveConfig = genBinaryOpClass deriveConfig eqConfig 0
-
--- | Derive 'Eq1' instance for a GADT.
-deriveGADTEq1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTEq1 deriveConfig = genBinaryOpClass deriveConfig eqConfig 1
-
--- | Derive 'Eq2' instance for a GADT.
-deriveGADTEq2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTEq2 deriveConfig = genBinaryOpClass deriveConfig eqConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveEvalSym.hs b/src/Grisette/Internal/TH/GADT/DeriveEvalSym.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveEvalSym.hs
+++ /dev/null
@@ -1,94 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveEvalSym
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveEvalSym
-  ( deriveGADTEvalSym,
-    deriveGADTEvalSym1,
-    deriveGADTEvalSym2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.EvalSym
-  ( EvalSym (evalSym),
-    EvalSym1 (liftEvalSym),
-    EvalSym2 (liftEvalSym2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultFieldFunExp,
-    defaultFieldResFun,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Language.Haskell.TH
-  ( Dec,
-    Exp (AppE, ConE),
-    Name,
-    Q,
-  )
-
-evalSymConfig :: UnaryOpClassConfig
-evalSymConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = ["fillDefault", "model"],
-                extraLiftedPatNames = const [],
-                fieldResFun = defaultFieldResFun,
-                fieldCombineFun = \_ _ con extraPat exp -> do
-                  return (foldl AppE (ConE con) exp, False <$ extraPat),
-                fieldFunExp =
-                  defaultFieldFunExp ['evalSym, 'liftEvalSym, 'liftEvalSym2]
-              }
-            ['evalSym, 'liftEvalSym, 'liftEvalSym2]
-        ],
-      unaryOpInstanceNames =
-        [''EvalSym, ''EvalSym1, ''EvalSym2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'EvalSym' instance for a GADT.
-deriveGADTEvalSym :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTEvalSym deriveConfig = genUnaryOpClass deriveConfig evalSymConfig 0
-
--- | Derive 'EvalSym1' instance for a GADT.
-deriveGADTEvalSym1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTEvalSym1 deriveConfig = genUnaryOpClass deriveConfig evalSymConfig 1
-
--- | Derive 'EvalSym2' instance for a GADT.
-deriveGADTEvalSym2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTEvalSym2 deriveConfig = genUnaryOpClass deriveConfig evalSymConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveExtractSym.hs b/src/Grisette/Internal/TH/GADT/DeriveExtractSym.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveExtractSym.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-{-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveExtractSym
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveExtractSym
-  ( deriveGADTExtractSym,
-    deriveGADTExtractSym1,
-    deriveGADTExtractSym2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.ExtractSym
-  ( ExtractSym (extractSymMaybe),
-    ExtractSym1 (liftExtractSymMaybe),
-    ExtractSym2 (liftExtractSymMaybe2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultFieldFunExp,
-    defaultFieldResFun,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Language.Haskell.TH
-  ( Dec,
-    Exp (AppE, ListE, VarE),
-    Name,
-    Q,
-  )
-
-extractSymConfig :: UnaryOpClassConfig
-extractSymConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = [],
-                extraLiftedPatNames = const [],
-                fieldResFun = defaultFieldResFun,
-                fieldCombineFun = \_ _ _ _ exp ->
-                  if null exp
-                    then (,[]) <$> [|return mempty|]
-                    else return (AppE (VarE 'mconcat) $ ListE exp, False <$ exp),
-                fieldFunExp =
-                  defaultFieldFunExp
-                    [ 'extractSymMaybe,
-                      'liftExtractSymMaybe,
-                      'liftExtractSymMaybe2
-                    ]
-              }
-            [ 'extractSymMaybe,
-              'liftExtractSymMaybe,
-              'liftExtractSymMaybe2
-            ]
-        ],
-      unaryOpInstanceNames =
-        [''ExtractSym, ''ExtractSym1, ''ExtractSym2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'ExtractSym' instance for a GADT.
-deriveGADTExtractSym :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTExtractSym deriveConfig = genUnaryOpClass deriveConfig extractSymConfig 0
-
--- | Derive 'ExtractSym1' instance for a GADT.
-deriveGADTExtractSym1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTExtractSym1 deriveConfig = genUnaryOpClass deriveConfig extractSymConfig 1
-
--- | Derive 'ExtractSym2' instance for a GADT.
-deriveGADTExtractSym2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTExtractSym2 deriveConfig = genUnaryOpClass deriveConfig extractSymConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveGADT.hs b/src/Grisette/Internal/TH/GADT/DeriveGADT.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveGADT.hs
+++ /dev/null
@@ -1,735 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveGADT
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveGADT
-  ( deriveGADT,
-    deriveGADTWith,
-    allClasses0,
-    allClasses01,
-    allClasses012,
-    basicClasses0,
-    noExistentialClasses0,
-    ordClasses0,
-    basicClasses1,
-    noExistentialClasses1,
-    ordClasses1,
-    basicClasses2,
-    noExistentialClasses2,
-    ordClasses2,
-  )
-where
-
-import Control.Arrow (Arrow (second))
-import Control.DeepSeq (NFData, NFData1, NFData2)
-import Data.Bytes.Serial (Serial, Serial1, Serial2)
-import Data.Functor.Classes (Eq1, Eq2, Ord1, Ord2, Show1, Show2)
-import Data.Hashable (Hashable)
-import Data.Hashable.Lifted (Hashable1, Hashable2)
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Grisette.Internal.Internal.Decl.Core.Data.Class.EvalSym
-  ( EvalSym,
-    EvalSym1,
-    EvalSym2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.ExtractSym
-  ( ExtractSym,
-    ExtractSym1,
-    ExtractSym2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
-  ( Mergeable,
-    Mergeable1,
-    Mergeable2,
-    Mergeable3,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.PPrint
-  ( PPrint,
-    PPrint1,
-    PPrint2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SimpleMergeable
-  ( SimpleMergeable,
-    SimpleMergeable1,
-    SimpleMergeable2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SubstSym
-  ( SubstSym,
-    SubstSym1,
-    SubstSym2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SymEq
-  ( SymEq,
-    SymEq1,
-    SymEq2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SymOrd
-  ( SymOrd,
-    SymOrd1,
-    SymOrd2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.ToCon
-  ( ToCon,
-    ToCon1,
-    ToCon2,
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.ToSym
-  ( ToSym,
-    ToSym1,
-    ToSym2,
-  )
-import Grisette.Internal.Internal.Decl.SymPrim.AllSyms
-  ( AllSyms,
-    AllSyms1,
-    AllSyms2,
-  )
-import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSimpleMergeable
-  ( UnifiedSimpleMergeable,
-    UnifiedSimpleMergeable1,
-    UnifiedSimpleMergeable2,
-  )
-import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymEq
-  ( UnifiedSymEq,
-    UnifiedSymEq1,
-    UnifiedSymEq2,
-  )
-import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymOrd
-  ( UnifiedSymOrd,
-    UnifiedSymOrd1,
-    UnifiedSymOrd2,
-  )
-import Grisette.Internal.TH.GADT.Common
-  ( DeriveConfig
-      ( evalModeConfig,
-        needExtraMergeableUnderEvalMode,
-        needExtraMergeableWithConcretizedEvalMode
-      ),
-    EvalModeConfig (EvalModeConstraints, EvalModeSpecified),
-  )
-import Grisette.Internal.TH.GADT.DeriveAllSyms
-  ( deriveGADTAllSyms,
-    deriveGADTAllSyms1,
-    deriveGADTAllSyms2,
-  )
-import Grisette.Internal.TH.GADT.DeriveEq
-  ( deriveGADTEq,
-    deriveGADTEq1,
-    deriveGADTEq2,
-  )
-import Grisette.Internal.TH.GADT.DeriveEvalSym
-  ( deriveGADTEvalSym,
-    deriveGADTEvalSym1,
-    deriveGADTEvalSym2,
-  )
-import Grisette.Internal.TH.GADT.DeriveExtractSym
-  ( deriveGADTExtractSym,
-    deriveGADTExtractSym1,
-    deriveGADTExtractSym2,
-  )
-import Grisette.Internal.TH.GADT.DeriveHashable
-  ( deriveGADTHashable,
-    deriveGADTHashable1,
-    deriveGADTHashable2,
-  )
-import Grisette.Internal.TH.GADT.DeriveMergeable
-  ( genMergeable,
-    genMergeable',
-    genMergeableAndGetMergingInfoResult,
-    genMergeableNoExistential,
-  )
-import Grisette.Internal.TH.GADT.DeriveNFData
-  ( deriveGADTNFData,
-    deriveGADTNFData1,
-    deriveGADTNFData2,
-  )
-import Grisette.Internal.TH.GADT.DeriveOrd
-  ( deriveGADTOrd,
-    deriveGADTOrd1,
-    deriveGADTOrd2,
-  )
-import Grisette.Internal.TH.GADT.DerivePPrint
-  ( deriveGADTPPrint,
-    deriveGADTPPrint1,
-    deriveGADTPPrint2,
-  )
-import Grisette.Internal.TH.GADT.DeriveSerial
-  ( deriveGADTSerial,
-    deriveGADTSerial1,
-    deriveGADTSerial2,
-  )
-import Grisette.Internal.TH.GADT.DeriveShow
-  ( deriveGADTShow,
-    deriveGADTShow1,
-    deriveGADTShow2,
-  )
-import Grisette.Internal.TH.GADT.DeriveSimpleMergeable
-  ( deriveGADTSimpleMergeable,
-    deriveGADTSimpleMergeable1,
-    deriveGADTSimpleMergeable2,
-  )
-import Grisette.Internal.TH.GADT.DeriveSubstSym
-  ( deriveGADTSubstSym,
-    deriveGADTSubstSym1,
-    deriveGADTSubstSym2,
-  )
-import Grisette.Internal.TH.GADT.DeriveSymEq
-  ( deriveGADTSymEq,
-    deriveGADTSymEq1,
-    deriveGADTSymEq2,
-  )
-import Grisette.Internal.TH.GADT.DeriveSymOrd
-  ( deriveGADTSymOrd,
-    deriveGADTSymOrd1,
-    deriveGADTSymOrd2,
-  )
-import Grisette.Internal.TH.GADT.DeriveToCon
-  ( deriveGADTToCon,
-    deriveGADTToCon1,
-    deriveGADTToCon2,
-  )
-import Grisette.Internal.TH.GADT.DeriveToSym
-  ( deriveGADTToSym,
-    deriveGADTToSym1,
-    deriveGADTToSym2,
-  )
-import Grisette.Internal.TH.GADT.DeriveUnifiedSimpleMergeable
-  ( deriveGADTUnifiedSimpleMergeable,
-    deriveGADTUnifiedSimpleMergeable1,
-    deriveGADTUnifiedSimpleMergeable2,
-  )
-import Grisette.Internal.TH.GADT.DeriveUnifiedSymEq
-  ( deriveGADTUnifiedSymEq,
-    deriveGADTUnifiedSymEq1,
-    deriveGADTUnifiedSymEq2,
-  )
-import Grisette.Internal.TH.GADT.DeriveUnifiedSymOrd
-  ( deriveGADTUnifiedSymOrd,
-    deriveGADTUnifiedSymOrd1,
-    deriveGADTUnifiedSymOrd2,
-  )
-import Grisette.Internal.TH.Util (dataTypeHasExistential)
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C, S))
-import Language.Haskell.TH (Dec, Name, Q)
-
-deriveProcedureMap :: M.Map Name (DeriveConfig -> Name -> Q [Dec])
-deriveProcedureMap =
-  M.fromList
-    [ (''EvalSym, deriveGADTEvalSym),
-      (''EvalSym1, deriveGADTEvalSym1),
-      (''EvalSym2, deriveGADTEvalSym2),
-      (''ExtractSym, deriveGADTExtractSym),
-      (''ExtractSym1, deriveGADTExtractSym1),
-      (''ExtractSym2, deriveGADTExtractSym2),
-      (''SubstSym, deriveGADTSubstSym),
-      (''SubstSym1, deriveGADTSubstSym1),
-      (''SubstSym2, deriveGADTSubstSym2),
-      (''NFData, deriveGADTNFData),
-      (''NFData1, deriveGADTNFData1),
-      (''NFData2, deriveGADTNFData2),
-      (''Hashable, deriveGADTHashable),
-      (''Hashable1, deriveGADTHashable1),
-      (''Hashable2, deriveGADTHashable2),
-      (''Show, deriveGADTShow),
-      (''Show1, deriveGADTShow1),
-      (''Show2, deriveGADTShow2),
-      (''PPrint, deriveGADTPPrint),
-      (''PPrint1, deriveGADTPPrint1),
-      (''PPrint2, deriveGADTPPrint2),
-      (''AllSyms, deriveGADTAllSyms),
-      (''AllSyms1, deriveGADTAllSyms1),
-      (''AllSyms2, deriveGADTAllSyms2),
-      (''Eq, deriveGADTEq),
-      (''Eq1, deriveGADTEq1),
-      (''Eq2, deriveGADTEq2),
-      (''Ord, deriveGADTOrd),
-      (''Ord1, deriveGADTOrd1),
-      (''Ord2, deriveGADTOrd2),
-      (''SymOrd, deriveGADTSymOrd),
-      (''SymOrd1, deriveGADTSymOrd1),
-      (''SymOrd2, deriveGADTSymOrd2),
-      (''SymEq, deriveGADTSymEq),
-      (''SymEq1, deriveGADTSymEq1),
-      (''SymEq2, deriveGADTSymEq2),
-      (''UnifiedSymEq, deriveGADTUnifiedSymEq),
-      (''UnifiedSymEq1, deriveGADTUnifiedSymEq1),
-      (''UnifiedSymEq2, deriveGADTUnifiedSymEq2),
-      (''UnifiedSymOrd, deriveGADTUnifiedSymOrd),
-      (''UnifiedSymOrd1, deriveGADTUnifiedSymOrd1),
-      (''UnifiedSymOrd2, deriveGADTUnifiedSymOrd2),
-      (''ToSym, deriveGADTToSym),
-      (''ToSym1, deriveGADTToSym1),
-      (''ToSym2, deriveGADTToSym2),
-      (''ToCon, deriveGADTToCon),
-      (''ToCon1, deriveGADTToCon1),
-      (''ToCon2, deriveGADTToCon2),
-      (''Serial, deriveGADTSerial),
-      (''Serial1, deriveGADTSerial1),
-      (''Serial2, deriveGADTSerial2),
-      (''SimpleMergeable, deriveGADTSimpleMergeable),
-      (''SimpleMergeable1, deriveGADTSimpleMergeable1),
-      (''SimpleMergeable2, deriveGADTSimpleMergeable2),
-      (''UnifiedSimpleMergeable, deriveGADTUnifiedSimpleMergeable),
-      (''UnifiedSimpleMergeable1, deriveGADTUnifiedSimpleMergeable1),
-      (''UnifiedSimpleMergeable2, deriveGADTUnifiedSimpleMergeable2)
-    ]
-
-deriveSingleGADT :: DeriveConfig -> Name -> Name -> Q [Dec]
-deriveSingleGADT deriveConfig typName className = do
-  let newExtra
-        | className
-            `elem` [ ''Eq,
-                     ''Eq1,
-                     ''Eq2,
-                     ''SymEq,
-                     ''SymEq1,
-                     ''SymEq2,
-                     ''SymOrd,
-                     ''SymOrd1,
-                     ''SymOrd2,
-                     ''UnifiedSymEq,
-                     ''UnifiedSymEq1,
-                     ''UnifiedSymEq2,
-                     ''UnifiedSymOrd,
-                     ''UnifiedSymOrd1,
-                     ''UnifiedSymOrd2,
-                     ''UnifiedSimpleMergeable,
-                     ''UnifiedSimpleMergeable1,
-                     ''UnifiedSimpleMergeable2
-                   ] =
-            deriveConfig
-              { needExtraMergeableUnderEvalMode = False,
-                needExtraMergeableWithConcretizedEvalMode = False
-              }
-        | className
-            `elem` [''SimpleMergeable, ''SimpleMergeable1, ''SimpleMergeable2] =
-            deriveConfig
-              { evalModeConfig =
-                  second
-                    ( \case
-                        EvalModeConstraints _ -> EvalModeSpecified S
-                        EvalModeSpecified tag -> EvalModeSpecified tag
-                    )
-                    <$> evalModeConfig deriveConfig,
-                needExtraMergeableUnderEvalMode = False,
-                needExtraMergeableWithConcretizedEvalMode = False
-              }
-        | className `elem` [''Ord, ''Ord1, ''Ord2] =
-            deriveConfig
-              { evalModeConfig =
-                  second
-                    ( \case
-                        EvalModeConstraints _ -> EvalModeSpecified C
-                        EvalModeSpecified tag -> EvalModeSpecified tag
-                    )
-                    <$> evalModeConfig deriveConfig,
-                needExtraMergeableUnderEvalMode = False,
-                needExtraMergeableWithConcretizedEvalMode = False
-              }
-        | otherwise = deriveConfig
-  case M.lookup className deriveProcedureMap of
-    Just procedure -> procedure newExtra typName
-    Nothing ->
-      fail $ "No derivation available for class " ++ show className
-
-deriveGADTWith' :: DeriveConfig -> Name -> [Name] -> Q [Dec]
-deriveGADTWith' deriveConfig typName classNameList = do
-  let classNames = S.fromList classNameList
-  let (ns, ms) = splitMergeable $ S.toList classNames
-  decs <- mapM (deriveSingleGADT deriveConfig typName) ns
-  decMergeables <- deriveMergeables ms
-  return $ concat decs ++ decMergeables
-  where
-    configWithOutExtraMergeable :: DeriveConfig
-    configWithOutExtraMergeable =
-      deriveConfig {needExtraMergeableUnderEvalMode = False}
-    deriveMergeables :: [Int] -> Q [Dec]
-    deriveMergeables [] = return []
-    deriveMergeables [n] = genMergeable configWithOutExtraMergeable typName n
-    deriveMergeables (n : ns) = do
-      hasExistential <- dataTypeHasExistential typName
-      if hasExistential
-        then do
-          (info, dn) <-
-            genMergeableAndGetMergingInfoResult
-              configWithOutExtraMergeable
-              typName
-              n
-          dns <-
-            traverse (genMergeable' configWithOutExtraMergeable info typName) ns
-          return $ dn ++ concatMap snd dns
-        else do
-          dns <-
-            traverse
-              (genMergeableNoExistential configWithOutExtraMergeable typName)
-              (n : ns)
-          return $ concat dns
-    splitMergeable :: [Name] -> ([Name], [Int])
-    splitMergeable [] = ([], [])
-    splitMergeable (x : xs) =
-      let (ns, is) = splitMergeable xs
-       in if
-            | x == ''Mergeable -> (ns, 0 : is)
-            | x == ''Mergeable1 -> (ns, 1 : is)
-            | x == ''Mergeable2 -> (ns, 2 : is)
-            | x == ''Mergeable3 -> (ns, 3 : is)
-            | otherwise -> (x : ns, is)
-
--- | Derive the specified classes for a GADT with the given name.
---
--- Support the following classes.
---
--- * 'Mergeable'
--- * 'Mergeable1'
--- * 'Mergeable2'
--- * 'Mergeable3'
--- * 'EvalSym'
--- * 'EvalSym1'
--- * 'EvalSym2'
--- * 'ExtractSym'
--- * 'ExtractSym1'
--- * 'ExtractSym2'
--- * 'SubstSym'
--- * 'SubstSym1'
--- * 'SubstSym2'
--- * 'NFData'
--- * 'NFData1'
--- * 'NFData2'
--- * 'Hashable'
--- * 'Hashable1'
--- * 'Hashable2'
--- * 'Show'
--- * 'Show1'
--- * 'Show2'
--- * 'PPrint'
--- * 'PPrint1'
--- * 'PPrint2'
--- * 'AllSyms'
--- * 'AllSyms1'
--- * 'AllSyms2'
--- * 'Eq'
--- * 'Eq1'
--- * 'Eq2'
--- * 'Ord'
--- * 'Ord1'
--- * 'Ord2'
--- * 'SymOrd'
--- * 'SymOrd1'
--- * 'SymOrd2'
--- * 'SymEq'
--- * 'SymEq1'
--- * 'SymEq2'
--- * 'UnifiedSymEq'
--- * 'UnifiedSymEq1'
--- * 'UnifiedSymEq2'
--- * 'UnifiedSymOrd'
--- * 'UnifiedSymOrd1'
--- * 'UnifiedSymOrd2'
--- * 'ToSym'
--- * 'ToSym1'
--- * 'ToSym2'
--- * 'ToCon'
--- * 'ToCon1'
--- * 'ToCon2'
--- * 'Serial'
--- * 'Serial1'
--- * 'Serial2'
--- * 'SimpleMergeable'
--- * 'SimpleMergeable1'
--- * 'SimpleMergeable2'
---
--- Note that the following type classes cannot be derived for GADTs with
--- existential type variables.
---
--- * 'Eq1'
--- * 'Eq2'
--- * 'SymEq1'
--- * 'SymEq2'
--- * 'Ord1'
--- * 'Ord2'
--- * 'SymOrd1'
--- * 'SymOrd2'
-deriveGADTWith :: DeriveConfig -> [Name] -> [Name] -> Q [Dec]
-deriveGADTWith deriveConfig typeNameList classNameList = do
-  let typeNames = S.toList $ S.fromList typeNameList
-  concat
-    <$> traverse
-      (\typeName -> deriveGADTWith' deriveConfig typeName classNameList)
-      typeNames
-
--- | Derive the specified classes for a GADT with the given name.
---
--- See 'deriveGADTWith' for more details.
-deriveGADT :: [Name] -> [Name] -> Q [Dec]
-deriveGADT = deriveGADTWith mempty
-
--- | All the classes that can be derived for GADTs.
---
--- This includes:
---
--- * 'Mergeable'
--- * 'EvalSym'
--- * 'ExtractSym'
--- * 'SubstSym'
--- * 'NFData'
--- * 'Hashable'
--- * 'Show'
--- * 'PPrint'
--- * 'AllSyms'
--- * 'Eq'
--- * 'SymEq'
--- * 'SymOrd'
--- * 'UnifiedSymEq'
--- * 'Ord'
--- * 'UnifiedSymOrd'
--- * 'Serial'
--- * 'ToCon'
--- * 'ToSym'
-allClasses0 :: [Name]
-allClasses0 = basicClasses0 ++ ordClasses0 ++ noExistentialClasses0
-
--- | All the @*1@ classes that can be derived for GADT functors.
---
--- This includes:
---
--- * 'Mergeable1'
--- * 'EvalSym1'
--- * 'ExtractSym1'
--- * 'SubstSym1'
--- * 'NFData1'
--- * 'Hashable1'
--- * 'Show1'
--- * 'PPrint1'
--- * 'AllSyms1'
--- * 'Eq1'
--- * 'SymEq1'
--- * 'SymOrd1'
--- * 'UnifiedSymEq1'
--- * 'Ord1'
--- * 'UnifiedSymOrd1'
--- * 'Serial1'
--- * 'ToCon1'
--- * 'ToSym1'
-allClasses1 :: [Name]
-allClasses1 = basicClasses1 ++ ordClasses1 ++ noExistentialClasses1
-
--- | All the classes that can be derived for GADT functors.
---
--- This includes all the classes in 'allClasses0' and 'allClasses1'.
-allClasses01 :: [Name]
-allClasses01 = allClasses0 ++ allClasses1
-
--- | All the @*2@ classes that can be derived for GADT functors.
---
--- This includes:
---
--- * 'Mergeable2'
--- * 'EvalSym2'
--- * 'ExtractSym2'
--- * 'SubstSym2'
--- * 'NFData2'
--- * 'Hashable2'
--- * 'Show2'
--- * 'PPrint2'
--- * 'AllSyms2'
--- * 'Eq2'
--- * 'SymEq2'
--- * 'SymOrd2'
--- * 'UnifiedSymEq2'
--- * 'Ord2'
--- * 'UnifiedSymOrd2'
--- * 'Serial2'
--- * 'ToCon2'
--- * 'ToSym2'
-allClasses2 :: [Name]
-allClasses2 = basicClasses2 ++ ordClasses2 ++ noExistentialClasses2
-
--- | All the classes that can be derived for GADTfunctors.
---
--- This includes all the classes in 'allClasses0', 'allClasses1',
--- and 'allClasses2'.
-allClasses012 :: [Name]
-allClasses012 = allClasses0 ++ allClasses1 ++ allClasses2
-
--- | Basic classes for GADTs.
---
--- This includes:
---
--- * 'Mergeable'
--- * 'EvalSym'
--- * 'ExtractSym'
--- * 'SubstSym'
--- * 'NFData'
--- * 'Hashable'
--- * 'Show'
--- * 'PPrint'
--- * 'AllSyms'
--- * 'Eq'
--- * 'SymEq'
--- * 'SymOrd'
--- * 'UnifiedSymEq'
---
--- These classes can be derived for most GADTs.
-basicClasses0 :: [Name]
-basicClasses0 =
-  [ ''Mergeable,
-    ''EvalSym,
-    ''ExtractSym,
-    ''SubstSym,
-    ''NFData,
-    ''Hashable,
-    ''Show,
-    ''PPrint,
-    ''AllSyms,
-    ''Eq,
-    ''SymEq,
-    ''SymOrd,
-    ''UnifiedSymEq
-  ]
-
--- | Classes that can only be derived for GADTs without existential type
--- variables.
---
--- This includes:
---
--- * 'Serial'
--- * 'ToCon'
--- * 'ToSym'
-noExistentialClasses0 :: [Name]
-noExistentialClasses0 = [''Serial, ''ToCon, ''ToSym]
-
--- | Concrete ordered classes that can be derived for GADTs that
---
--- * uses unified evaluation mode, or
--- * does not contain any symbolic variables.
---
--- This includes:
---
--- * 'Ord'
--- * 'UnifiedSymOrd'
-ordClasses0 :: [Name]
-ordClasses0 = [''Ord, ''UnifiedSymOrd]
-
--- | Basic classes for GADT functors.
---
--- This includes:
---
--- * 'Mergeable1'
--- * 'EvalSym1'
--- * 'ExtractSym1'
--- * 'SubstSym1'
--- * 'NFData1'
--- * 'Hashable1'
--- * 'Show1'
--- * 'PPrint1'
--- * 'AllSyms1'
--- * 'Eq1'
--- * 'SymEq1'
--- * 'SymOrd1'
--- * 'UnifiedSymEq1'
-basicClasses1 :: [Name]
-basicClasses1 =
-  [ ''Mergeable1,
-    ''EvalSym1,
-    ''ExtractSym1,
-    ''SubstSym1,
-    ''NFData1,
-    ''Hashable1,
-    ''Show1,
-    ''PPrint1,
-    ''AllSyms1,
-    ''Eq1,
-    ''SymEq1,
-    ''SymOrd1,
-    ''UnifiedSymEq1
-  ]
-
--- | @*1@ classes that can only be derived for GADT functors without existential
--- type variables.
---
--- This includes:
---
--- * 'Serial1'
--- * 'ToCon1'
--- * 'ToSym1'
-noExistentialClasses1 :: [Name]
-noExistentialClasses1 = [''Serial1, ''ToCon1, ''ToSym1]
-
--- | @*1@ concrete ordered classes that can be derived for GADT functors that
---
--- * uses unified evaluation mode, or
--- * does not contain any symbolic variables.
---
--- This includes:
---
--- * 'Ord1'
--- * 'UnifiedSymOrd1'
-ordClasses1 :: [Name]
-ordClasses1 = [''Ord1, ''UnifiedSymOrd1]
-
--- | Basic classes for GADT functors.
---
--- This includes:
---
--- * 'Mergeable2'
--- * 'EvalSym2'
--- * 'ExtractSym2'
--- * 'SubstSym2'
--- * 'NFData2'
--- * 'Hashable2'
--- * 'Show2'
--- * 'PPrint2'
--- * 'AllSyms2'
--- * 'Eq2'
--- * 'SymEq2'
--- * 'SymOrd2'
--- * 'UnifiedSymEq2'
-basicClasses2 :: [Name]
-basicClasses2 =
-  [ ''Mergeable2,
-    ''EvalSym2,
-    ''ExtractSym2,
-    ''SubstSym2,
-    ''NFData2,
-    ''Hashable2,
-    ''Show2,
-    ''PPrint2,
-    ''AllSyms2,
-    ''Eq2,
-    ''SymEq2,
-    ''SymOrd2,
-    ''UnifiedSymEq2
-  ]
-
--- | @*2@ classes that can only be derived for GADT functors without existential
--- type variables.
---
--- This includes:
---
--- * 'Serial2'
--- * 'ToCon2'
--- * 'ToSym2'
-noExistentialClasses2 :: [Name]
-noExistentialClasses2 = [''Serial2, ''ToCon2, ''ToSym2]
-
--- | @*2@ concrete ordered classes that can be derived for GADT functors that
---
--- * uses unified evaluation mode, or
--- * does not contain any symbolic variables.
---
--- This includes:
---
--- * 'Ord2'
--- * 'UnifiedSymOrd2'
-ordClasses2 :: [Name]
-ordClasses2 = [''Ord2, ''UnifiedSymOrd2]
diff --git a/src/Grisette/Internal/TH/GADT/DeriveHashable.hs b/src/Grisette/Internal/TH/GADT/DeriveHashable.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveHashable.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveHashable
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveHashable
-  ( deriveGADTHashable,
-    deriveGADTHashable1,
-    deriveGADTHashable2,
-  )
-where
-
-import Data.Hashable (Hashable (hashWithSalt))
-import Data.Hashable.Lifted
-  ( Hashable1 (liftHashWithSalt),
-    Hashable2 (liftHashWithSalt2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultFieldFunExp,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Language.Haskell.TH (Dec, Name, Q)
-
-hashableConfig :: UnaryOpClassConfig
-hashableConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = ["salt"],
-                extraLiftedPatNames = const [],
-                fieldCombineFun =
-                  \_ _ _ [salt] exp -> do
-                    r <-
-                      foldl
-                        (\salt exp -> [|$(return exp) $salt|])
-                        (return salt)
-                        exp
-                    return (r, [True]),
-                fieldResFun = \_ _ _ _ fieldPat fieldFun -> do
-                  r <- [|\salt -> $(return fieldFun) salt $(return fieldPat)|]
-                  return (r, [False]),
-                fieldFunExp =
-                  defaultFieldFunExp
-                    ['hashWithSalt, 'liftHashWithSalt, 'liftHashWithSalt2]
-              }
-            ['hashWithSalt, 'liftHashWithSalt, 'liftHashWithSalt2]
-        ],
-      unaryOpInstanceNames =
-        [''Hashable, ''Hashable1, ''Hashable2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'Hashable' instance for a GADT.
-deriveGADTHashable :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTHashable deriveConfig = genUnaryOpClass deriveConfig hashableConfig 0
-
--- | Derive 'Hashable1' instance for a GADT.
-deriveGADTHashable1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTHashable1 deriveConfig = genUnaryOpClass deriveConfig hashableConfig 1
-
--- | Derive 'Hashable2' instance for a GADT.
-deriveGADTHashable2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTHashable2 deriveConfig = genUnaryOpClass deriveConfig hashableConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveMergeable.hs b/src/Grisette/Internal/TH/GADT/DeriveMergeable.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveMergeable.hs
+++ /dev/null
@@ -1,792 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveMergeable
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveMergeable
-  ( deriveGADTMergeable,
-    deriveGADTMergeable1,
-    deriveGADTMergeable2,
-    deriveGADTMergeable3,
-    genMergeableAndGetMergingInfoResult,
-    genMergeable,
-    genMergeable',
-    genMergeableNoExistential,
-  )
-where
-
-import Control.Monad (foldM, replicateM, zipWithM)
-import qualified Data.Map as M
-import Data.Maybe (catMaybes, isJust, mapMaybe)
-import qualified Data.Set as S
-import Data.Word (Word16, Word32, Word64, Word8)
-import Grisette.Internal.Internal.Decl.Core.Data.Class.Mergeable
-  ( Mergeable (rootStrategy),
-    Mergeable1 (liftRootStrategy),
-    Mergeable2 (liftRootStrategy2),
-    Mergeable3 (liftRootStrategy3),
-    MergingStrategy (SimpleStrategy, SortedStrategy),
-    product2Strategy,
-    wrapStrategy,
-  )
-import Grisette.Internal.TH.GADT.Common
-  ( CheckArgsResult
-      ( CheckArgsResult,
-        argVars,
-        constructors,
-        keptVars
-      ),
-    DeriveConfig,
-    checkArgs,
-    evalModeSpecializeList,
-    extraConstraint,
-    isVarUsedInFields,
-    specializeResult,
-  )
-import Grisette.Internal.TH.GADT.UnaryOpCommon (FieldFunExp, UnaryOpClassConfig (UnaryOpClassConfig, unaryOpAllowExistential, unaryOpConfigs, unaryOpExtraVars, unaryOpInstanceNames, unaryOpInstanceTypeFromConfig), UnaryOpConfig (UnaryOpConfig), UnaryOpFunConfig (genUnaryOpFun), defaultUnaryOpInstanceTypeFromConfig, genUnaryOpClass)
-import Grisette.Internal.TH.Util (dataTypeHasExistential, integerE, mangleName)
-import Language.Haskell.TH
-  ( Bang (Bang),
-    Body (NormalB),
-    Clause (Clause),
-    Con (ForallC, GadtC),
-    Dec (DataD, FunD, InstanceD, PragmaD, SigD),
-    Exp (AppE, ConE, VarE),
-    Inline (Inline),
-    Kind,
-    Name,
-    Pat (SigP, VarP, WildP),
-    Phases (AllPhases),
-    Pragma (InlineP),
-    Pred,
-    Q,
-    RuleMatch (FunLike),
-    SourceStrictness (NoSourceStrictness),
-    SourceUnpackedness (NoSourceUnpackedness),
-    Type (AppT, ArrowT, ConT, ForallT, StarT, VarT),
-    appE,
-    caseE,
-    conE,
-    conT,
-    integerL,
-    lamE,
-    litP,
-    lookupTypeName,
-    mkName,
-    nameBase,
-    newName,
-    normalB,
-    recP,
-    sigP,
-    tupP,
-    varE,
-    varP,
-    varT,
-    wildP,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorInfo
-      ( constructorContext,
-        constructorFields,
-        constructorName,
-        constructorVars
-      ),
-    DatatypeInfo (datatypeCons, datatypeName, datatypeVars),
-    TypeSubstitution (applySubstitution, freeVariables),
-    reifyDatatype,
-    resolveTypeSynonyms,
-    tvName,
-  )
-import Language.Haskell.TH.Datatype.TyVarBndr
-  ( TyVarBndrUnit,
-    kindedTVSpecified,
-    plainTVFlag,
-    specifiedSpec,
-  )
-import Language.Haskell.TH.Lib (clause, conP, litE, match, stringL)
-import Type.Reflection (SomeTypeRep (SomeTypeRep), TypeRep, typeRep)
-import Unsafe.Coerce (unsafeCoerce)
-
-genMergingInfoCon ::
-  [TyVarBndrUnit] ->
-  Name ->
-  Bool ->
-  ConstructorInfo ->
-  Q (Con, Name, [Clause], [Clause], [Clause])
-genMergingInfoCon dataTypeVars tyName isLast con = do
-  let conName = mangleName $ constructorName con
-  let newConName = mkName $ conName <> "MergingInfo"
-  let oriVars = dataTypeVars ++ constructorVars con
-  newDataTypeVars <- traverse (newName . nameBase . tvName) dataTypeVars
-  newConstructorVars <-
-    traverse (newName . nameBase . tvName) $ constructorVars con
-  let newNames = newDataTypeVars ++ newConstructorVars
-  -- newNames <- traverse (newName . nameBase . tvName) oriVars
-  let newVars = fmap VarT newNames
-  let substMap = M.fromList $ zip (tvName <$> oriVars) newVars
-  let fields =
-        zip [0 ..] $
-          applySubstitution substMap $
-            constructorFields con
-  let tyFields =
-        AppT (ConT ''TypeRep)
-          <$> applySubstitution
-            substMap
-            ((VarT . tvName) <$> constructorVars con)
-  let strategyFields = fmap (AppT (ConT ''MergingStrategy) . snd) fields
-  tyFieldNamesL <- traverse (const $ newName "p") tyFields
-  tyFieldNamesR <- traverse (const $ newName "p") tyFields
-  let tyFieldPatsL = fmap varP tyFieldNamesL
-  let tyFieldPatsR = fmap varP tyFieldNamesR
-  let tyFieldVarsL = fmap varE tyFieldNamesL
-  let tyFieldVarsR = fmap varE tyFieldNamesR
-  let strategyFieldPats = replicate (length strategyFields) wildP
-  let patsL = tyFieldPatsL ++ strategyFieldPats
-  let patsR = tyFieldPatsR ++ strategyFieldPats
-  let allWildcards = fmap (const wildP) $ tyFieldPatsL ++ strategyFieldPats
-  let eqCont l r cont =
-        [|
-          SomeTypeRep $l == SomeTypeRep $r
-            && $cont
-          |]
-  let eqExp =
-        foldl (\cont (l, r) -> eqCont l r cont) (conE 'True) $
-          zip tyFieldVarsL tyFieldVarsR
-  eqClause <-
-    clause
-      [conP newConName patsL, conP newConName patsR]
-      (normalB eqExp)
-      []
-  let cmpCont l r cont =
-        [|
-          case SomeTypeRep $l `compare` SomeTypeRep $r of
-            EQ -> $cont
-            x -> x
-          |]
-  let cmpExp =
-        foldl (\cont (l, r) -> cmpCont l r cont) (conE 'EQ) $
-          zip tyFieldVarsL tyFieldVarsR
-  cmpClause0 <-
-    clause
-      [conP newConName patsL, conP newConName patsR]
-      (normalB cmpExp)
-      []
-  cmpClause1 <-
-    clause
-      [conP newConName allWildcards, wildP]
-      (normalB $ conE 'LT)
-      []
-  cmpClause2 <-
-    clause
-      [wildP, conP newConName allWildcards]
-      (normalB $ conE 'GT)
-      []
-  let cmpClauses =
-        if isLast
-          then [cmpClause0]
-          else [cmpClause0, cmpClause1, cmpClause2]
-  let showCont t cont =
-        [|$cont <> " " <> show $t|]
-  let showExp = foldl (flip showCont) (litE $ stringL conName) tyFieldVarsL
-  showClause <-
-    clause
-      [conP newConName patsL]
-      (normalB showExp)
-      []
-  let ctx = applySubstitution substMap $ constructorContext con
-  let ctxAndGadtUsedVars =
-        S.fromList (freeVariables ctx)
-          <> S.fromList (freeVariables tyFields)
-          <> S.fromList (freeVariables strategyFields)
-  let isCtxAndGadtUsedVar nm = S.member nm ctxAndGadtUsedVars
-  return
-    ( ForallC
-        ( (`plainTVFlag` specifiedSpec)
-            <$> filter isCtxAndGadtUsedVar newDataTypeVars ++ newConstructorVars
-        )
-        ctx
-        $ GadtC
-          [newConName]
-          ( (Bang NoSourceUnpackedness NoSourceStrictness,)
-              <$> tyFields ++ strategyFields
-          )
-          (ConT tyName),
-      newConName,
-      [eqClause],
-      cmpClauses,
-      [showClause]
-    )
-
-data MergingInfoResult = MergingInfoResult
-  { _infoName :: Name,
-    _conInfoNames :: [Name]
-  }
-
-genMergingInfo :: Name -> Q (MergingInfoResult, [Dec])
-genMergingInfo typName = do
-  d <- reifyDatatype typName
-  let originalName = mangleName $ datatypeName d
-  let newName = originalName <> "MergingInfo"
-  found <- lookupTypeName newName
-  let constructors = datatypeCons d
-  let name = mkName newName
-  r <-
-    if null constructors
-      then return []
-      else do
-        cons0 <-
-          traverse (genMergingInfoCon (datatypeVars d) name False) $
-            init constructors
-        consLast <-
-          genMergingInfoCon (datatypeVars d) name True $
-            last constructors
-        return $ cons0 ++ [consLast]
-  let cons = fmap (\(a, _, _, _, _) -> a) r
-  let eqClauses =
-        concatMap (\(_, _, a, _, _) -> a) r
-          ++ [ Clause [WildP, WildP] (NormalB $ ConE 'False) []
-               | length constructors > 1
-             ]
-  let cmpClauses = concatMap (\(_, _, _, a, _) -> a) r
-  let showClauses = concatMap (\(_, _, _, _, a) -> a) r
-  return
-    ( MergingInfoResult
-        name
-        (fmap (\(_, a, _, _, _) -> a) r),
-      if isJust found
-        then []
-        else
-          [ DataD [] name [] Nothing cons [],
-            InstanceD
-              Nothing
-              []
-              (ConT ''Eq `AppT` ConT name)
-              [FunD '(==) eqClauses],
-            InstanceD
-              Nothing
-              []
-              (ConT ''Ord `AppT` ConT name)
-              [FunD 'compare cmpClauses],
-            InstanceD
-              Nothing
-              []
-              (ConT ''Show `AppT` ConT name)
-              [FunD 'show showClauses]
-          ]
-    )
-
--- | Generate 'Mergeable' instance and merging information for a GADT.
-genMergeableAndGetMergingInfoResult ::
-  DeriveConfig -> Name -> Int -> Q (MergingInfoResult, [Dec])
-genMergeableAndGetMergingInfoResult deriveConfig typName n = do
-  (infoResult, infoDec) <- genMergingInfo typName
-  (_, decs) <- genMergeable' deriveConfig infoResult typName n
-  return (infoResult, infoDec ++ decs)
-
-constructMergingStrategyExp :: ConstructorInfo -> [Exp] -> Q Exp
-constructMergingStrategyExp _ [] = [|SimpleStrategy $ \_ t _ -> t|]
-constructMergingStrategyExp conInfo [x] = do
-  upname <- newName "a"
-  let unwrapPat = conP (constructorName conInfo) [varP upname]
-  let unwrapFun = lamE [unwrapPat] $ appE (varE 'unsafeCoerce) (varE upname)
-  [|
-    wrapStrategy
-      $(return x)
-      (unsafeCoerce . $(conE $ constructorName conInfo))
-      $unwrapFun
-    |]
-constructMergingStrategyExp conInfo (x : xs) = do
-  upnames <- replicateM (length xs + 1) $ newName "a"
-  let wrapPat1 [] = error "Should not happen"
-      wrapPat1 [x] = varP x
-      wrapPat1 (x : xs) = tupP [varP x, wrapPat1 xs]
-  let wrapped = foldl AppE (ConE $ constructorName conInfo) $ fmap VarE upnames
-  let wrapFun =
-        lamE
-          [varP $ head upnames, wrapPat1 $ tail upnames]
-          [|unsafeCoerce ($(return wrapped))|]
-  let unwrapPat = conP (constructorName conInfo) $ fmap varP upnames
-  let unwrapExp1 [] = error "Should not happen"
-      unwrapExp1 [_] = error "Should not happen"
-      unwrapExp1 [x, y] =
-        [|(unsafeCoerce $(varE x), unsafeCoerce $(varE y))|]
-      unwrapExp1 (x : xs) = [|(unsafeCoerce $(varE x), $(unwrapExp1 xs))|]
-  let unwrapFun = lamE [unwrapPat] (unwrapExp1 upnames)
-  let strategy1 [] = error "Should not happen"
-      strategy1 [x] = return x
-      strategy1 (x : xs) =
-        [|
-          product2Strategy
-            ((,))
-            (\(x, y) -> (x, y))
-            $(return x)
-            $(strategy1 xs)
-          |]
-  [|
-    product2Strategy
-      $wrapFun
-      $unwrapFun
-      $(return x)
-      $(strategy1 xs)
-    |]
-
-genMergeFunClause' :: Name -> ConstructorInfo -> Q Clause
-genMergeFunClause' conInfoName con = do
-  let numExistential = length $ constructorVars con
-  let numFields = length $ constructorFields con
-  let argWildCards = replicate numExistential wildP :: [Q Pat]
-
-  pnames <- replicateM numFields $ newName "s"
-  clause
-    ([conP conInfoName $ argWildCards ++ fmap varP pnames])
-    (normalB (constructMergingStrategyExp con (map VarE pnames)))
-    []
-
-constructVarPats :: ConstructorInfo -> Q Pat
-constructVarPats conInfo = do
-  let fields = constructorFields conInfo
-      capture n = return $ SigP WildP $ fields !! n
-  conP (constructorName conInfo) $ capture <$> [0 .. length fields - 1]
-
-genMergingInfoFunClause' ::
-  [(Type, Kind)] -> Name -> ConstructorInfo -> Q Clause
-genMergingInfoFunClause' argTypes conInfoName con = do
-  let conVars = constructorVars con
-  capturedVarTyReps <-
-    traverse (\bndr -> [|typeRep @($(varT $ tvName bndr))|]) conVars
-  varPat <- constructVarPats con
-  let infoExpWithTypeReps = foldl AppE (ConE conInfoName) capturedVarTyReps
-
-  let fields = constructorFields con
-  let usedArgs = S.fromList $ freeVariables fields
-
-  strategyNames <-
-    traverse
-      ( \(ty, _) ->
-          case ty of
-            VarT nm ->
-              if S.member nm usedArgs
-                then do
-                  pname <- newName "p"
-                  return (nm, Just pname)
-                else return ('undefined, Nothing)
-            _ -> return ('undefined, Nothing)
-      )
-      argTypes
-  let argToStrategyPat =
-        mapMaybe (\(nm, mpat) -> fmap (nm,) mpat) strategyNames
-  let strategyPats = fmap (maybe WildP VarP . snd) strategyNames
-
-  let argNameSet =
-        S.fromList $
-          mapMaybe
-            ( \(ty, _) -> case ty of
-                VarT nm -> Just nm
-                _ -> Nothing
-            )
-            argTypes
-  let containsArg :: Type -> Bool
-      containsArg ty =
-        S.intersection argNameSet (S.fromList (freeVariables [ty])) /= S.empty
-  let typeHasNoArg = not . containsArg
-
-  let fieldStrategyExp ty =
-        if not (containsArg ty)
-          then [|rootStrategy :: MergingStrategy $(return ty)|]
-          else case ty of
-            _
-              | typeHasNoArg ty ->
-                  [|rootStrategy :: MergingStrategy $(return ty)|]
-            AppT a b
-              | typeHasNoArg a ->
-                  [|
-                    liftRootStrategy
-                      $(fieldStrategyExp b) ::
-                      MergingStrategy $(return ty)
-                    |]
-            AppT (AppT a b) c
-              | typeHasNoArg a ->
-                  [|
-                    liftRootStrategy2
-                      $(fieldStrategyExp b)
-                      $(fieldStrategyExp c) ::
-                      MergingStrategy $(return ty)
-                    |]
-            AppT (AppT (AppT a b) c) d
-              | typeHasNoArg a ->
-                  [|
-                    liftRootStrategy3
-                      $(fieldStrategyExp b)
-                      $(fieldStrategyExp c)
-                      $(fieldStrategyExp d) ::
-                      MergingStrategy $(return ty)
-                    |]
-            VarT nm -> do
-              case lookup nm argToStrategyPat of
-                Just pname -> varE pname
-                _ -> fail "BUG: fieldStrategyExp"
-            _ -> fail $ "fieldStrategyExp: unsupported type: " <> show ty
-  fieldStrategyExps <- traverse fieldStrategyExp fields
-  let infoExp = foldl AppE infoExpWithTypeReps fieldStrategyExps
-  -- fail $ show infoExp
-  return $ Clause (strategyPats ++ [varPat]) (NormalB infoExp) []
-
-mergeableFieldFunExp :: [Name] -> FieldFunExp
-mergeableFieldFunExp unaryOpFunNames argToFunPat _ = go
-  where
-    go ty = do
-      let allArgNames = M.keysSet argToFunPat
-      let typeHasNoArg ty =
-            S.fromList (freeVariables [ty])
-              `S.intersection` allArgNames
-              == S.empty
-      let fun0a a = [|$(varE $ head unaryOpFunNames) @($(return a))|]
-          fun1a a b = [|$(varE $ unaryOpFunNames !! 1) @($(return a)) $(go b)|]
-          fun2a a b c =
-            [|
-              $(varE $ unaryOpFunNames !! 2)
-                @($(return a))
-                $(go b)
-                $(go c)
-              |]
-          fun3a a b c d =
-            [|
-              $(varE $ unaryOpFunNames !! 3)
-                @($(return a))
-                $(go b)
-                $(go c)
-                $(go d)
-              |]
-
-      case ty of
-        AppT (AppT (AppT a@(VarT _) b) c) d -> fun3a a b c d
-        AppT (AppT a@(VarT _) b) c -> fun2a a b c
-        AppT a@(VarT _) b -> fun1a a b
-        _ | typeHasNoArg ty -> fun0a ty
-        AppT a b | typeHasNoArg a -> fun1a a b
-        AppT (AppT a b) c | typeHasNoArg a -> fun2a a b c
-        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3a a b c d
-        VarT nm -> case M.lookup nm argToFunPat of
-          Just pname -> varE pname
-          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-
-mergeableNoExistentialConfig :: UnaryOpClassConfig
-mergeableNoExistentialConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            MergeableNoExistentialConfig
-              { mergeableNoExistentialFun =
-                  mergeableFieldFunExp
-                    [ 'rootStrategy,
-                      'liftRootStrategy,
-                      'liftRootStrategy2,
-                      'liftRootStrategy3
-                    ]
-              }
-            [ 'rootStrategy,
-              'liftRootStrategy,
-              'liftRootStrategy2,
-              'liftRootStrategy3
-            ]
-        ],
-      unaryOpInstanceNames =
-        [''Mergeable, ''Mergeable1, ''Mergeable2, ''Mergeable3],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = False
-    }
-
-newtype MergeableNoExistentialConfig = MergeableNoExistentialConfig
-  { mergeableNoExistentialFun :: FieldFunExp
-  }
-
-instance UnaryOpFunConfig MergeableNoExistentialConfig where
-  genUnaryOpFun
-    _
-    MergeableNoExistentialConfig {..}
-    funNames
-    n
-    _
-    _
-    argTypes
-    _
-    constructors = do
-      allFields <-
-        mapM resolveTypeSynonyms $
-          concatMap constructorFields constructors
-      let usedArgs = S.fromList $ freeVariables allFields
-      args <-
-        traverse
-          ( \(ty, _) -> do
-              case ty of
-                VarT nm ->
-                  if S.member nm usedArgs
-                    then do
-                      pname <- newName "p"
-                      return (nm, Just pname)
-                    else return ('undefined, Nothing)
-                _ -> return ('undefined, Nothing)
-          )
-          argTypes
-      let argToFunPat =
-            M.fromList $ mapMaybe (\(nm, mpat) -> fmap (nm,) mpat) args
-      let funPats = fmap (maybe WildP VarP . snd) args
-      let genAuxFunExp conInfo = do
-            fields <- mapM resolveTypeSynonyms $ constructorFields conInfo
-            defaultFieldFunExps <-
-              traverse
-                (mergeableNoExistentialFun argToFunPat M.empty)
-                fields
-            constructMergingStrategyExp conInfo defaultFieldFunExps
-      auxExps <- mapM genAuxFunExp constructors
-      funExp <- case auxExps of
-        [] -> [|NoStrategy|]
-        [singleExp] -> return singleExp
-        _ -> do
-          p <- newName "p"
-          let numConstructors = length constructors
-          let getIdx i =
-                if numConstructors <= 2
-                  then if i == 0 then [|False|] else [|True|]
-                  else integerE i
-          let getIdxPat i =
-                if numConstructors <= 2
-                  then conP (if i == 0 then 'False else 'True) []
-                  else do
-                    let w8Bound = fromIntegral (maxBound @Word8)
-                    let w16Bound = fromIntegral (maxBound @Word16)
-                    let w32Bound = fromIntegral (maxBound @Word32)
-                    let w64Bound = fromIntegral (maxBound @Word64)
-                    sigP
-                      (litP (integerL i))
-                      ( conT $
-                          if
-                            | numConstructors <= w8Bound + 1 -> ''Word8
-                            | numConstructors <= w16Bound + 1 -> ''Word16
-                            | numConstructors <= w32Bound + 1 -> ''Word32
-                            | numConstructors <= w64Bound + 1 -> ''Word64
-                            | otherwise -> ''Integer
-                      )
-          let idxFun =
-                lamE [varP p] $
-                  caseE
-                    (varE p)
-                    ( zipWith
-                        ( \conIdx conInfo -> do
-                            match
-                              (recP (constructorName conInfo) [])
-                              (normalB (getIdx conIdx))
-                              []
-                        )
-                        [0 ..]
-                        constructors
-                    )
-          let auxFun =
-                lamE [varP p] $
-                  caseE
-                    (varE p)
-                    ( zipWith
-                        ( \conIdx exp -> do
-                            match
-                              (getIdxPat conIdx)
-                              (normalB (return exp))
-                              []
-                        )
-                        [0 ..]
-                        auxExps
-                        ++ [match wildP (normalB [|undefined|]) []]
-                    )
-          [|
-            SortedStrategy $idxFun $auxFun
-            |]
-      let instanceFunName = funNames !! n
-      return $
-        FunD
-          instanceFunName
-          [ Clause
-              funPats
-              (NormalB funExp)
-              []
-          ]
-
--- | Generate 'Mergeable' instance for a GADT, using a given merging info
--- result.
-genMergeable' ::
-  DeriveConfig -> MergingInfoResult -> Name -> Int -> Q (Name, [Dec])
-genMergeable' deriveConfig (MergingInfoResult infoName conInfoNames) typName n = do
-  result@CheckArgsResult {..} <-
-    specializeResult (evalModeSpecializeList deriveConfig)
-      =<< checkArgs "Mergeable" 3 typName True n
-
-  d <- reifyDatatype typName
-  let ctxForVar :: (Type, Kind) -> Q (Maybe Pred)
-      ctxForVar (ty, kind) = case kind of
-        StarT -> Just <$> [t|Mergeable $(return ty)|]
-        AppT (AppT ArrowT StarT) StarT ->
-          Just <$> [t|Mergeable1 $(return ty)|]
-        AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
-          Just <$> [t|Mergeable2 $(return ty)|]
-        AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) StarT ->
-          Just <$> [t|Mergeable3 $(return ty)|]
-        AppT (AppT (AppT (AppT ArrowT StarT) StarT) StarT) _ ->
-          fail $ "Unsupported kind: " <> show kind
-        _ -> return Nothing
-  let isTypeUsedInFields (VarT nm) = isVarUsedInFields result nm
-      isTypeUsedInFields _ = False
-  mergeableContexts <-
-    traverse ctxForVar $ filter (isTypeUsedInFields . fst) keptVars
-
-  let instanceName =
-        case n of
-          0 -> ''Mergeable
-          1 -> ''Mergeable1
-          2 -> ''Mergeable2
-          3 -> ''Mergeable3
-          _ -> error "Unsupported n"
-
-  let instanceHead = ConT instanceName
-  extraPreds <-
-    extraConstraint
-      deriveConfig
-      typName
-      instanceName
-      []
-      keptVars
-      constructors
-
-  let targetType =
-        foldl
-          (\ty (var, _) -> AppT ty var)
-          (ConT typName)
-          (keptVars ++ argVars)
-  let infoType = ConT infoName
-  let mergingInfoFunFinalType = AppT (AppT ArrowT targetType) infoType
-
-  let mergingInfoFunTypeWithoutCtx =
-        foldr
-          (((AppT . AppT ArrowT) . AppT (ConT ''MergingStrategy)) . fst)
-          mergingInfoFunFinalType
-          argVars
-
-  let mergingInfoFunType =
-        ForallT
-          ( mapMaybe
-              ( \(ty, knd) -> case ty of
-                  VarT nm -> Just $ kindedTVSpecified nm knd
-                  _ -> Nothing
-              )
-              $ keptVars ++ argVars
-          )
-          (extraPreds ++ catMaybes mergeableContexts)
-          mergingInfoFunTypeWithoutCtx
-  let mangledName = mangleName (datatypeName d)
-  let mergingInfoFunName =
-        mkName $
-          "mergingInfo"
-            <> (if n /= 0 then show n else "")
-            <> mangledName
-  let mergingInfoFunSigD = SigD mergingInfoFunName mergingInfoFunType
-  clauses <-
-    traverse (uncurry (genMergingInfoFunClause' argVars)) $
-      zip conInfoNames constructors
-  let mergingInfoFunDec = FunD mergingInfoFunName clauses
-
-  let mergeFunType =
-        AppT (AppT ArrowT infoType) (AppT (ConT ''MergingStrategy) targetType)
-  let mergeFunName =
-        mkName $
-          "merge"
-            <> (if n /= 0 then show n else "")
-            <> mangledName
-  let mergeFunSigD = SigD mergeFunName mergeFunType
-  mergeFunClauses <- zipWithM genMergeFunClause' conInfoNames constructors
-  let mergeFunDec = FunD mergeFunName mergeFunClauses
-
-  let instanceType =
-        AppT
-          instanceHead
-          (foldl AppT (ConT typName) $ fmap fst keptVars)
-
-  let mergeInstanceFunName = case n of
-        0 -> 'rootStrategy
-        1 -> 'liftRootStrategy
-        2 -> 'liftRootStrategy2
-        3 -> 'liftRootStrategy3
-        _ -> error "Unsupported n"
-  mergeInstanceFunPatNames <- replicateM n $ newName "rootStrategy"
-  let mergeInstanceFunPats = VarP <$> mergeInstanceFunPatNames
-
-  mergeInstanceFunBody <-
-    [|
-      SortedStrategy
-        $( foldM
-             (\exp name -> appE (return exp) $ varE name)
-             (VarE mergingInfoFunName)
-             mergeInstanceFunPatNames
-         )
-        $(varE mergeFunName)
-      |]
-
-  let mergeInstanceFunClause =
-        Clause mergeInstanceFunPats (NormalB mergeInstanceFunBody) []
-
-  return
-    ( mergingInfoFunName,
-      [ PragmaD (InlineP mergingInfoFunName Inline FunLike AllPhases),
-        mergingInfoFunSigD,
-        mergingInfoFunDec,
-        PragmaD (InlineP mergeFunName Inline FunLike AllPhases),
-        mergeFunSigD,
-        mergeFunDec,
-        InstanceD
-          Nothing
-          (extraPreds ++ catMaybes mergeableContexts)
-          instanceType
-          [FunD mergeInstanceFunName [mergeInstanceFunClause]]
-      ]
-    )
-
--- | Generate 'Mergeable' instance for a GADT without existential variables.
-genMergeableNoExistential :: DeriveConfig -> Name -> Int -> Q [Dec]
-genMergeableNoExistential deriveConfig typName n = do
-  genUnaryOpClass deriveConfig mergeableNoExistentialConfig n typName
-
--- | Generate 'Mergeable' instance for a GADT.
-genMergeable :: DeriveConfig -> Name -> Int -> Q [Dec]
-genMergeable deriveConfig typName n = do
-  hasExistential <- dataTypeHasExistential typName
-  if hasExistential
-    then do
-      (infoResult, infoDec) <- genMergingInfo typName
-      (_, decs) <- genMergeable' deriveConfig infoResult typName n
-      return $ infoDec ++ decs
-    else genMergeableNoExistential deriveConfig typName n
-
--- | Derive 'Mergeable' instance for GADT.
-deriveGADTMergeable :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTMergeable deriveConfig nm = genMergeable deriveConfig nm 0
-
--- | Derive 'Mergeable1' instance for GADT.
-deriveGADTMergeable1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTMergeable1 deriveConfig nm = genMergeable deriveConfig nm 1
-
--- | Derive 'Mergeable2' instance for GADT.
-deriveGADTMergeable2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTMergeable2 deriveConfig nm = genMergeable deriveConfig nm 2
-
--- | Derive 'Mergeable3' instance for GADT.
-deriveGADTMergeable3 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTMergeable3 deriveConfig nm = genMergeable deriveConfig nm 3
diff --git a/src/Grisette/Internal/TH/GADT/DeriveNFData.hs b/src/Grisette/Internal/TH/GADT/DeriveNFData.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveNFData.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveNFData
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveNFData
-  ( deriveGADTNFData,
-    deriveGADTNFData1,
-    deriveGADTNFData2,
-  )
-where
-
-import Control.DeepSeq (NFData (rnf), NFData1 (liftRnf), NFData2 (liftRnf2))
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultFieldFunExp,
-    defaultFieldResFun,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Language.Haskell.TH (Dec, Name)
-import Language.Haskell.TH.Syntax (Q)
-
-nfdataConfig :: UnaryOpClassConfig
-nfdataConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = [],
-                extraLiftedPatNames = const [],
-                fieldCombineFun = \_ _ _ _ exps -> do
-                  r <-
-                    foldl
-                      (\acc exp -> [|$acc `seq` $(return exp)|])
-                      ([|()|])
-                      exps
-                  return (r, []),
-                fieldResFun = defaultFieldResFun,
-                fieldFunExp = defaultFieldFunExp ['rnf, 'liftRnf, 'liftRnf2]
-              }
-            ['rnf, 'liftRnf, 'liftRnf2]
-        ],
-      unaryOpInstanceNames = [''NFData, ''NFData1, ''NFData2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'NFData' instance for a GADT.
-deriveGADTNFData :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTNFData deriveConfig = genUnaryOpClass deriveConfig nfdataConfig 0
-
--- | Derive 'NFData1' instance for a GADT.
-deriveGADTNFData1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTNFData1 deriveConfig = genUnaryOpClass deriveConfig nfdataConfig 1
-
--- | Derive 'NFData2' instance for a GADT.
-deriveGADTNFData2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTNFData2 deriveConfig = genUnaryOpClass deriveConfig nfdataConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveOrd.hs b/src/Grisette/Internal/TH/GADT/DeriveOrd.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveOrd.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveOrd
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveOrd
-  ( deriveGADTOrd,
-    deriveGADTOrd1,
-    deriveGADTOrd2,
-  )
-where
-
-import Data.Functor.Classes (Ord1 (liftCompare), Ord2 (liftCompare2))
-import Grisette.Internal.TH.GADT.BinaryOpCommon
-  ( BinaryOpClassConfig
-      ( BinaryOpClassConfig,
-        binaryOpAllowSumType,
-        binaryOpFieldConfigs,
-        binaryOpInstanceNames
-      ),
-    BinaryOpFieldConfig
-      ( BinaryOpFieldConfig,
-        extraPatNames,
-        fieldCombineFun,
-        fieldDifferentExistentialFun,
-        fieldFunExp,
-        fieldFunNames,
-        fieldLMatchResult,
-        fieldRMatchResult,
-        fieldResFun
-      ),
-    binaryOpAllowExistential,
-    defaultFieldFunExp,
-    genBinaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Language.Haskell.TH (Dec, Exp (ListE), Name, Q)
-
-ordConfig :: BinaryOpClassConfig
-ordConfig =
-  BinaryOpClassConfig
-    { binaryOpFieldConfigs =
-        [ BinaryOpFieldConfig
-            { extraPatNames = [],
-              fieldResFun = \_ (lhs, rhs) f ->
-                (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
-              fieldCombineFun = \_ lst ->
-                (,[]) <$> [|mconcat $(return $ ListE lst)|],
-              fieldDifferentExistentialFun = return,
-              fieldFunExp =
-                defaultFieldFunExp ['compare, 'liftCompare, 'liftCompare2],
-              fieldFunNames = ['compare, 'liftCompare, 'liftCompare2],
-              fieldLMatchResult = [|LT|],
-              fieldRMatchResult = [|GT|]
-            }
-        ],
-      binaryOpInstanceNames = [''Ord, ''Ord1, ''Ord2],
-      binaryOpAllowSumType = True,
-      binaryOpAllowExistential = True
-    }
-
--- | Derive 'Ord' instance for a GADT.
-deriveGADTOrd :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTOrd deriveConfig = genBinaryOpClass deriveConfig ordConfig 0
-
--- | Derive 'Ord1' instance for a GADT.
-deriveGADTOrd1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTOrd1 deriveConfig = genBinaryOpClass deriveConfig ordConfig 1
-
--- | Derive 'Ord2' instance for a GADT.
-deriveGADTOrd2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTOrd2 deriveConfig = genBinaryOpClass deriveConfig ordConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DerivePPrint.hs b/src/Grisette/Internal/TH/GADT/DerivePPrint.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DerivePPrint.hs
+++ /dev/null
@@ -1,195 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DerivePPrint
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DerivePPrint
-  ( deriveGADTPPrint,
-    deriveGADTPPrint1,
-    deriveGADTPPrint2,
-  )
-where
-
-import Data.Maybe (fromMaybe)
-import Data.String (IsString (fromString))
-import GHC.Show (appPrec1)
-import Grisette.Internal.Internal.Decl.Core.Data.Class.PPrint
-  ( PPrint (pformatList, pformatPrec),
-    PPrint1 (liftPFormatList, liftPFormatPrec),
-    PPrint2 (liftPFormatList2, liftPFormatPrec2),
-    align,
-    condEnclose,
-    flatAlt,
-    group,
-    groupedEnclose,
-    nest,
-    pformatWithConstructorNoAlign,
-    vcat,
-    vsep,
-    (<+>),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.ShowPPrintCommon (showPrintFieldFunExp)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Grisette.Internal.TH.Util (integerE, isNonUnitTuple)
-import Language.Haskell.TH
-  ( Dec,
-    Exp (ListE),
-    Fixity (Fixity),
-    Name,
-    defaultFixity,
-    listE,
-    nameBase,
-    stringE,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorVariant (InfixConstructor, NormalConstructor, RecordConstructor),
-    reifyFixityCompat,
-  )
-import Language.Haskell.TH.Syntax (Q)
-
-pprintConfig :: UnaryOpClassConfig
-pprintConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = ["prec"],
-                extraLiftedPatNames = \i -> (["pl" | i /= 0]),
-                fieldCombineFun = \_ variant conName [prec] exps -> do
-                  let initExps =
-                        (\e -> [|$(return e) <> "," <> flatAlt "" " "|])
-                          <$> init exps
-                      lastExp = [|$(return $ last exps)|]
-                      commaSeped = initExps ++ [lastExp]
-                  case (variant, exps) of
-                    (NormalConstructor, []) -> do
-                      r <- [|fromString $(stringE $ nameBase conName)|]
-                      return (r, [False])
-                    (NormalConstructor, [exp]) -> do
-                      r <-
-                        [|
-                          pformatWithConstructorNoAlign
-                            $(return prec)
-                            $(stringE $ nameBase conName)
-                            [$(return exp)]
-                          |]
-                      return (r, [True])
-                    (NormalConstructor, _) | isNonUnitTuple conName -> do
-                      r <- [|groupedEnclose "(" ")" $ vcat $ $(listE commaSeped)|]
-                      return (r, [False])
-                    (NormalConstructor, _) -> do
-                      r <-
-                        [|
-                          pformatWithConstructorNoAlign
-                            $(return prec)
-                            $(stringE $ nameBase conName)
-                            [vsep $(return $ ListE exps)]
-                          |]
-                      return (r, [True])
-                    (RecordConstructor _, _) -> do
-                      r <-
-                        [|
-                          pformatWithConstructorNoAlign
-                            $(return prec)
-                            $(stringE $ nameBase conName)
-                            [groupedEnclose "{" "}" $ vcat $ $(listE commaSeped)]
-                          |]
-                      return (r, [True])
-                    (InfixConstructor, [l, r]) -> do
-                      fi <-
-                        fromMaybe defaultFixity `fmap` reifyFixityCompat conName
-                      let conPrec = case fi of Fixity prec _ -> prec
-                      r <-
-                        [|
-                          group
-                            $ condEnclose
-                              ($(return prec) > $(integerE conPrec))
-                              "("
-                              ")"
-                            $ nest 2
-                            $ vsep
-                              [ align $ $(return l),
-                                fromString $(stringE $ nameBase conName)
-                                  <+> $(return r)
-                              ]
-                          |]
-                      return (r, [True])
-                    _ ->
-                      fail "deriveGADTPPrint: unexpected constructor variant",
-                fieldResFun = \variant conName _ pos fieldPat fieldFun -> do
-                  let makePPrintField p =
-                        [|
-                          $(return fieldFun)
-                            $(integerE p)
-                            $(return fieldPat)
-                          |]
-                  let attachUsedInfo = ((,[False]) <$>)
-                  case variant of
-                    NormalConstructor
-                      | isNonUnitTuple conName ->
-                          attachUsedInfo $ makePPrintField 0
-                    NormalConstructor ->
-                      attachUsedInfo $ makePPrintField appPrec1
-                    RecordConstructor names ->
-                      attachUsedInfo
-                        [|
-                          fromString $(stringE $ nameBase (names !! pos) ++ " = ")
-                            <> $(makePPrintField 0)
-                          |]
-                    InfixConstructor -> do
-                      fi <-
-                        fromMaybe defaultFixity `fmap` reifyFixityCompat conName
-                      let conPrec = case fi of Fixity prec _ -> prec
-                      attachUsedInfo $ makePPrintField (conPrec + 1),
-                fieldFunExp =
-                  showPrintFieldFunExp
-                    ['pformatPrec, 'liftPFormatPrec, 'liftPFormatPrec2]
-                    ['pformatList, 'liftPFormatList, 'liftPFormatList2]
-              }
-            ['pformatPrec, 'liftPFormatPrec, 'liftPFormatPrec2]
-        ],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceNames = [''PPrint, ''PPrint1, ''PPrint2],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'PPrint' instance for a GADT.
-deriveGADTPPrint :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTPPrint deriveConfig = genUnaryOpClass deriveConfig pprintConfig 0
-
--- | Derive 'PPrint1' instance for a GADT.
-deriveGADTPPrint1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTPPrint1 deriveConfig = genUnaryOpClass deriveConfig pprintConfig 1
-
--- | Derive 'PPrint2' instance for a GADT.
-deriveGADTPPrint2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTPPrint2 deriveConfig = genUnaryOpClass deriveConfig pprintConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveSerial.hs b/src/Grisette/Internal/TH/GADT/DeriveSerial.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveSerial.hs
+++ /dev/null
@@ -1,203 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveSerial
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveSerial
-  ( deriveGADTSerial,
-    deriveGADTSerial1,
-    deriveGADTSerial2,
-  )
-where
-
-import Control.Monad (zipWithM)
-import Data.Bytes.Serial
-  ( Serial (deserialize, serialize),
-    Serial1 (deserializeWith, serializeWith),
-    Serial2 (deserializeWith2, serializeWith2),
-  )
-import qualified Data.Map as M
-import Data.Maybe (mapMaybe)
-import qualified Data.Set as S
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( FieldFunExp,
-    UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    UnaryOpFunConfig (genUnaryOpFun),
-    defaultFieldFunExp,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Grisette.Internal.TH.Util (integerE)
-import Language.Haskell.TH
-  ( Body (NormalB),
-    Clause (Clause),
-    Dec (FunD),
-    Lit (IntegerL),
-    Match (Match),
-    Name,
-    Pat (LitP, VarP, WildP),
-    Q,
-    Type (VarT),
-    bindS,
-    caseE,
-    conE,
-    conT,
-    doE,
-    match,
-    mkName,
-    newName,
-    noBindS,
-    normalB,
-    sigP,
-    varE,
-    varP,
-    wildP,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorInfo (constructorFields, constructorName),
-    TypeSubstitution (freeVariables),
-    resolveTypeSynonyms,
-  )
-
-newtype UnaryOpDeserializeConfig = UnaryOpDeserializeConfig
-  {fieldDeserializeFun :: FieldFunExp}
-
-instance UnaryOpFunConfig UnaryOpDeserializeConfig where
-  genUnaryOpFun
-    _
-    UnaryOpDeserializeConfig {..}
-    funNames
-    n
-    _
-    _
-    argTypes
-    _
-    constructors = do
-      allFields <-
-        mapM resolveTypeSynonyms $
-          concatMap constructorFields constructors
-      let usedArgs = S.fromList $ freeVariables allFields
-      args <-
-        traverse
-          ( \(ty, _) -> do
-              case ty of
-                VarT nm ->
-                  if S.member nm usedArgs
-                    then do
-                      pname <- newName "p"
-                      return (nm, Just pname)
-                    else return ('undefined, Nothing)
-                _ -> return ('undefined, Nothing)
-          )
-          argTypes
-      let argToFunPat =
-            M.fromList $ mapMaybe (\(nm, mpat) -> fmap (nm,) mpat) args
-      let funPats = fmap (maybe WildP VarP . snd) args
-      let genAuxFunMatch conIdx conInfo = do
-            fields <- mapM resolveTypeSynonyms $ constructorFields conInfo
-            defaultFieldFunExps <-
-              traverse
-                (fieldDeserializeFun argToFunPat M.empty)
-                fields
-            let conName = constructorName conInfo
-            exp <-
-              foldl
-                (\exp fieldFun -> [|$exp <*> $(return fieldFun)|])
-                [|return $(conE conName)|]
-                defaultFieldFunExps
-            return $ Match (LitP (IntegerL conIdx)) (NormalB exp) []
-      auxMatches <- zipWithM genAuxFunMatch [0 ..] constructors
-      auxFallbackMatch <- match wildP (normalB [|undefined|]) []
-      let instanceFunName = funNames !! n
-      -- let auxFunName = mkName "go"
-      let selName = mkName "sel"
-      exp <-
-        doE
-          [ bindS
-              (sigP (varP selName) (conT ''Int))
-              [|deserialize|],
-            noBindS $
-              caseE (varE selName) $
-                return <$> auxMatches ++ [auxFallbackMatch]
-          ]
-      return $
-        FunD
-          instanceFunName
-          [ Clause
-              funPats
-              (NormalB exp)
-              []
-          ]
-
-serialConfig :: UnaryOpClassConfig
-serialConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = [],
-                extraLiftedPatNames = const [],
-                fieldCombineFun = \conIdx _ _ [] exp -> do
-                  r <-
-                    foldl
-                      (\r exp -> [|$r >> $(return exp)|])
-                      ([|serialize ($(integerE conIdx) :: Int)|])
-                      exp
-                  return (r, [True]),
-                fieldResFun = \_ _ _ _ fieldPat fieldFun -> do
-                  r <- [|$(return fieldFun) $(return fieldPat)|]
-                  return (r, [True]),
-                fieldFunExp =
-                  defaultFieldFunExp
-                    ['serialize, 'serializeWith, 'serializeWith2]
-              }
-            ['serialize, 'serializeWith, 'serializeWith2],
-          UnaryOpConfig
-            UnaryOpDeserializeConfig
-              { fieldDeserializeFun =
-                  defaultFieldFunExp
-                    ['deserialize, 'deserializeWith, 'deserializeWith2]
-              }
-            ['deserialize, 'deserializeWith, 'deserializeWith2]
-        ],
-      unaryOpInstanceNames = [''Serial, ''Serial1, ''Serial2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = False
-    }
-
--- | Derive 'Serial' instance for a GADT.
-deriveGADTSerial :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSerial deriveConfig = genUnaryOpClass deriveConfig serialConfig 0
-
--- | Derive 'Serial1' instance for a GADT.
-deriveGADTSerial1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSerial1 deriveConfig = genUnaryOpClass deriveConfig serialConfig 1
-
--- | Derive 'Serial2' instance for a GADT.
-deriveGADTSerial2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSerial2 deriveConfig = genUnaryOpClass deriveConfig serialConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveShow.hs b/src/Grisette/Internal/TH/GADT/DeriveShow.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveShow.hs
+++ /dev/null
@@ -1,195 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveShow
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveShow
-  ( deriveGADTShow,
-    deriveGADTShow1,
-    deriveGADTShow2,
-  )
-where
-
-import Data.Functor.Classes
-  ( Show1 (liftShowList, liftShowsPrec),
-    Show2 (liftShowList2, liftShowsPrec2),
-  )
-import qualified Data.List as List
-import Data.Maybe (fromMaybe)
-import GHC.Show (appPrec, appPrec1)
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.ShowPPrintCommon (showPrintFieldFunExp)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Grisette.Internal.TH.Util (integerE, isNonUnitTuple)
-import Language.Haskell.TH
-  ( Dec,
-    Fixity (Fixity),
-    Name,
-    Q,
-    defaultFixity,
-    integerL,
-    listE,
-    litE,
-    nameBase,
-    stringE,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorVariant (InfixConstructor, NormalConstructor, RecordConstructor),
-    reifyFixityCompat,
-  )
-
-showConfig :: UnaryOpClassConfig
-showConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = ["prec"],
-                extraLiftedPatNames = \i -> (["sl" | i /= 0]),
-                fieldCombineFun =
-                  \_ variant conName [prec] exps -> do
-                    case (variant, exps) of
-                      (NormalConstructor, []) -> do
-                        r <- [|showString $(stringE $ nameBase conName)|]
-                        return (r, [False])
-                      (NormalConstructor, [exp]) -> do
-                        r <-
-                          [|
-                            showParen
-                              ($(return prec) > $(integerE appPrec))
-                              ( showString $(stringE $ nameBase conName)
-                                  . showChar ' '
-                                  . $(return exp)
-                              )
-                            |]
-                        return (r, [True])
-                      (NormalConstructor, _) | isNonUnitTuple conName -> do
-                        let commaSeped =
-                              List.intersperse [|showChar ','|] $
-                                return <$> exps
-                        r <-
-                          [|
-                            showChar '('
-                              . foldr1 (.) $(listE commaSeped)
-                              . showChar ')'
-                            |]
-                        return (r, [False])
-                      (NormalConstructor, _) -> do
-                        let spaceSeped =
-                              List.intersperse [|showChar ' '|] $
-                                return <$> exps
-                        r <-
-                          [|
-                            showParen
-                              ($(return prec) > $(integerE appPrec))
-                              ( showString $(stringE $ nameBase conName)
-                                  . showChar ' '
-                                  . (foldr1 (.) $(listE spaceSeped))
-                              )
-                            |]
-                        return (r, [True])
-                      (RecordConstructor _, _) -> do
-                        let commaSpaceSeped =
-                              List.intersperse [|showString ", "|] $
-                                return <$> exps
-                        r <-
-                          [|
-                            showString $(stringE $ nameBase conName)
-                              . showString " {"
-                              . foldr1 (.) $(listE commaSpaceSeped)
-                              . showString "}"
-                            |]
-                        return (r, [False])
-                      (InfixConstructor, [l, r]) -> do
-                        fi <-
-                          fromMaybe defaultFixity `fmap` reifyFixityCompat conName
-                        let conPrec = case fi of Fixity prec _ -> prec
-                        r <-
-                          [|
-                            showParen
-                              ($(return prec) > $(integerE conPrec))
-                              ( $(return l)
-                                  . showChar ' '
-                                  . showString $(stringE $ nameBase conName)
-                                  . showChar ' '
-                                  . $(return r)
-                              )
-                            |]
-                        return (r, [True])
-                      _ ->
-                        fail "deriveGADTShow: unexpected constructor variant",
-                fieldResFun = \variant conName _ pos fieldPat fieldFun -> do
-                  let makeShowField p =
-                        [|
-                          $(return fieldFun)
-                            $(litE $ integerL $ fromIntegral p)
-                            $(return fieldPat)
-                          |]
-                  let attachUsedInfo = ((,[False]) <$>)
-                  case variant of
-                    NormalConstructor
-                      | isNonUnitTuple conName ->
-                          attachUsedInfo $ makeShowField 0
-                    NormalConstructor ->
-                      attachUsedInfo $ makeShowField appPrec1
-                    RecordConstructor names ->
-                      attachUsedInfo
-                        [|
-                          showString $(stringE $ nameBase (names !! pos) ++ " = ")
-                            . $(makeShowField 0)
-                          |]
-                    InfixConstructor -> do
-                      fi <-
-                        fromMaybe defaultFixity `fmap` reifyFixityCompat conName
-                      let conPrec = case fi of Fixity prec _ -> prec
-                      attachUsedInfo $ makeShowField (conPrec + 1),
-                fieldFunExp =
-                  showPrintFieldFunExp
-                    ['showsPrec, 'liftShowsPrec, 'liftShowsPrec2]
-                    ['showList, 'liftShowList, 'liftShowList2]
-              }
-            ['showsPrec, 'liftShowsPrec, 'liftShowsPrec2]
-        ],
-      unaryOpInstanceNames = [''Show, ''Show1, ''Show2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'Show' instance for a GADT.
-deriveGADTShow :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTShow deriveConfig = genUnaryOpClass deriveConfig showConfig 0
-
--- | Derive 'Show1' instance for a GADT.
-deriveGADTShow1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTShow1 deriveConfig = genUnaryOpClass deriveConfig showConfig 1
-
--- | Derive 'Show2' instance for a GADT.
-deriveGADTShow2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTShow2 deriveConfig = genUnaryOpClass deriveConfig showConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveSimpleMergeable.hs b/src/Grisette/Internal/TH/GADT/DeriveSimpleMergeable.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveSimpleMergeable.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveSimpleMergeable
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveSimpleMergeable
-  ( deriveGADTSimpleMergeable,
-    deriveGADTSimpleMergeable1,
-    deriveGADTSimpleMergeable2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SimpleMergeable
-  ( SimpleMergeable (mrgIte),
-    SimpleMergeable1 (liftMrgIte),
-    SimpleMergeable2 (liftMrgIte2),
-  )
-import Grisette.Internal.TH.GADT.BinaryOpCommon
-  ( BinaryOpClassConfig
-      ( BinaryOpClassConfig,
-        binaryOpAllowSumType,
-        binaryOpFieldConfigs,
-        binaryOpInstanceNames
-      ),
-    BinaryOpFieldConfig
-      ( BinaryOpFieldConfig,
-        extraPatNames,
-        fieldCombineFun,
-        fieldDifferentExistentialFun,
-        fieldFunExp,
-        fieldFunNames,
-        fieldLMatchResult,
-        fieldRMatchResult,
-        fieldResFun
-      ),
-    binaryOpAllowExistential,
-    defaultFieldFunExp,
-    genBinaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Language.Haskell.TH (Dec, Exp (AppE, ConE), Name, Q)
-
-simpleMergeableConfig :: BinaryOpClassConfig
-simpleMergeableConfig =
-  BinaryOpClassConfig
-    { binaryOpFieldConfigs =
-        [ BinaryOpFieldConfig
-            { extraPatNames = ["c"],
-              fieldResFun = \[c] (lhs, rhs) f ->
-                (,[True])
-                  <$> [|$(return f) $(return c) $(return lhs) $(return rhs)|],
-              fieldCombineFun =
-                \con lst -> return (foldl AppE (ConE con) lst, [False]),
-              fieldDifferentExistentialFun = const [|undefined|],
-              fieldFunExp =
-                defaultFieldFunExp ['mrgIte, 'liftMrgIte, 'liftMrgIte2],
-              fieldFunNames = ['mrgIte, 'liftMrgIte, 'liftMrgIte2],
-              fieldLMatchResult = [|undefined|],
-              fieldRMatchResult = [|undefined|]
-            }
-        ],
-      binaryOpInstanceNames =
-        [''SimpleMergeable, ''SimpleMergeable1, ''SimpleMergeable2],
-      binaryOpAllowSumType = False,
-      binaryOpAllowExistential = True
-    }
-
--- | Derive 'SimpleMergeable' instance for a GADT.
-deriveGADTSimpleMergeable :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSimpleMergeable deriveConfig =
-  genBinaryOpClass deriveConfig simpleMergeableConfig 0
-
--- | Derive 'SimpleMergeable1' instance for a GADT.
-deriveGADTSimpleMergeable1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSimpleMergeable1 deriveConfig =
-  genBinaryOpClass deriveConfig simpleMergeableConfig 1
-
--- | Derive 'SimpleMergeable2' instance for a GADT.
-deriveGADTSimpleMergeable2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSimpleMergeable2 deriveConfig =
-  genBinaryOpClass deriveConfig simpleMergeableConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveSubstSym.hs b/src/Grisette/Internal/TH/GADT/DeriveSubstSym.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveSubstSym.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveSubstSym
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveSubstSym
-  ( deriveGADTSubstSym,
-    deriveGADTSubstSym1,
-    deriveGADTSubstSym2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SubstSym
-  ( SubstSym (substSym),
-    SubstSym1 (liftSubstSym),
-    SubstSym2 (liftSubstSym2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    UnaryOpFieldConfig
-      ( UnaryOpFieldConfig,
-        extraLiftedPatNames,
-        extraPatNames,
-        fieldCombineFun,
-        fieldFunExp,
-        fieldResFun
-      ),
-    defaultFieldFunExp,
-    defaultFieldResFun,
-    defaultUnaryOpInstanceTypeFromConfig,
-    genUnaryOpClass,
-  )
-import Language.Haskell.TH (Dec, Exp (AppE, ConE), Name)
-import Language.Haskell.TH.Syntax (Q)
-
-substSymConfig :: UnaryOpClassConfig
-substSymConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpFieldConfig
-              { extraPatNames = ["symbol", "newVal"],
-                extraLiftedPatNames = const [],
-                fieldResFun = defaultFieldResFun,
-                fieldCombineFun = \_ _ con extraPat exp ->
-                  return (foldl AppE (ConE con) exp, False <$ extraPat),
-                fieldFunExp =
-                  defaultFieldFunExp
-                    ['substSym, 'liftSubstSym, 'liftSubstSym2]
-              }
-            ['substSym, 'liftSubstSym, 'liftSubstSym2]
-        ],
-      unaryOpInstanceNames =
-        [''SubstSym, ''SubstSym1, ''SubstSym2],
-      unaryOpExtraVars = const $ return [],
-      unaryOpInstanceTypeFromConfig = defaultUnaryOpInstanceTypeFromConfig,
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'SubstSym' instance for a GADT.
-deriveGADTSubstSym :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSubstSym deriveConfig = genUnaryOpClass deriveConfig substSymConfig 0
-
--- | Derive 'SubstSym1' instance for a GADT.
-deriveGADTSubstSym1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSubstSym1 deriveConfig = genUnaryOpClass deriveConfig substSymConfig 1
-
--- | Derive 'SubstSym2' instance for a GADT.
-deriveGADTSubstSym2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSubstSym2 deriveConfig = genUnaryOpClass deriveConfig substSymConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveSymEq.hs b/src/Grisette/Internal/TH/GADT/DeriveSymEq.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveSymEq.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveSymEq
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveSymEq
-  ( deriveGADTSymEq,
-    deriveGADTSymEq1,
-    deriveGADTSymEq2,
-  )
-where
-
-import Grisette.Internal.Core.Data.Class.LogicalOp
-  ( LogicalOp (false, true, (.&&)),
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SymEq
-  ( SymEq ((.==)),
-    SymEq1 (liftSymEq),
-    SymEq2 (liftSymEq2),
-  )
-import Grisette.Internal.TH.GADT.BinaryOpCommon
-  ( BinaryOpClassConfig
-      ( BinaryOpClassConfig,
-        binaryOpAllowSumType,
-        binaryOpFieldConfigs,
-        binaryOpInstanceNames
-      ),
-    BinaryOpFieldConfig
-      ( BinaryOpFieldConfig,
-        extraPatNames,
-        fieldCombineFun,
-        fieldDifferentExistentialFun,
-        fieldFunExp,
-        fieldFunNames,
-        fieldLMatchResult,
-        fieldRMatchResult,
-        fieldResFun
-      ),
-    binaryOpAllowExistential,
-    defaultFieldFunExp,
-    genBinaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Language.Haskell.TH (Dec, Exp (ListE), Name, Q)
-
-symEqConfig :: BinaryOpClassConfig
-symEqConfig =
-  BinaryOpClassConfig
-    { binaryOpFieldConfigs =
-        [ BinaryOpFieldConfig
-            { extraPatNames = [],
-              fieldResFun = \_ (lhs, rhs) f ->
-                (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
-              fieldCombineFun =
-                \_ lst -> (,[]) <$> [|foldl (.&&) true $(return $ ListE lst)|],
-              fieldDifferentExistentialFun = const [|false|],
-              fieldFunExp =
-                defaultFieldFunExp ['(.==), 'liftSymEq, 'liftSymEq2],
-              fieldFunNames = ['(.==), 'liftSymEq, 'liftSymEq2],
-              fieldLMatchResult = [|false|],
-              fieldRMatchResult = [|false|]
-            }
-        ],
-      binaryOpInstanceNames = [''SymEq, ''SymEq1, ''SymEq2],
-      binaryOpAllowSumType = True,
-      binaryOpAllowExistential = True
-    }
-
--- | Derive 'SymEq' instance for a GADT.
-deriveGADTSymEq :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSymEq deriveConfig = genBinaryOpClass deriveConfig symEqConfig 0
-
--- | Derive 'SymEq1' instance for a GADT.
-deriveGADTSymEq1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSymEq1 deriveConfig = genBinaryOpClass deriveConfig symEqConfig 1
-
--- | Derive 'SymEq2' instance for a GADT.
-deriveGADTSymEq2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSymEq2 deriveConfig = genBinaryOpClass deriveConfig symEqConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveSymOrd.hs b/src/Grisette/Internal/TH/GADT/DeriveSymOrd.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveSymOrd.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveSymOrd
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveSymOrd
-  ( deriveGADTSymOrd,
-    deriveGADTSymOrd1,
-    deriveGADTSymOrd2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.SymOrd
-  ( SymOrd (symCompare),
-    SymOrd1 (liftSymCompare),
-    SymOrd2 (liftSymCompare2),
-  )
-import Grisette.Internal.Internal.Decl.Core.Data.Class.TryMerge
-  ( mrgSingle,
-  )
-import Grisette.Internal.TH.GADT.BinaryOpCommon
-  ( BinaryOpClassConfig
-      ( BinaryOpClassConfig,
-        binaryOpAllowSumType,
-        binaryOpFieldConfigs,
-        binaryOpInstanceNames
-      ),
-    BinaryOpFieldConfig
-      ( BinaryOpFieldConfig,
-        extraPatNames,
-        fieldCombineFun,
-        fieldDifferentExistentialFun,
-        fieldFunExp,
-        fieldFunNames,
-        fieldLMatchResult,
-        fieldRMatchResult,
-        fieldResFun
-      ),
-    binaryOpAllowExistential,
-    defaultFieldFunExp,
-    genBinaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Language.Haskell.TH (Dec, Name, Q)
-
-symOrdConfig :: BinaryOpClassConfig
-symOrdConfig =
-  BinaryOpClassConfig
-    { binaryOpFieldConfigs =
-        [ BinaryOpFieldConfig
-            { extraPatNames = [],
-              fieldResFun =
-                \_ (lhs, rhs) f ->
-                  (,[]) <$> [|$(return f) $(return lhs) $(return rhs)|],
-              fieldCombineFun =
-                \_ lst -> do
-                  let go [] = [|mrgSingle EQ|]
-                      go [x] = [|$(return x)|]
-                      go (x : xs) =
-                        [|
-                          do
-                            a <- $(return x)
-                            case a of
-                              EQ -> $(go xs)
-                              _ -> mrgSingle a
-                          |]
-                  (,[]) <$> go lst,
-              fieldDifferentExistentialFun =
-                \exp -> [|mrgSingle $(return exp)|],
-              fieldFunExp =
-                defaultFieldFunExp
-                  ['symCompare, 'liftSymCompare, 'liftSymCompare2],
-              fieldFunNames = ['symCompare, 'liftSymCompare, 'liftSymCompare2],
-              fieldLMatchResult = [|mrgSingle LT|],
-              fieldRMatchResult = [|mrgSingle GT|]
-            }
-        ],
-      binaryOpInstanceNames = [''SymOrd, ''SymOrd1, ''SymOrd2],
-      binaryOpAllowSumType = True,
-      binaryOpAllowExistential = True
-    }
-
--- | Derive 'SymOrd' instance for a GADT.
-deriveGADTSymOrd :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSymOrd deriveConfig = genBinaryOpClass deriveConfig symOrdConfig 0
-
--- | Derive 'SymOrd1' instance for a GADT.
-deriveGADTSymOrd1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSymOrd1 deriveConfig = genBinaryOpClass deriveConfig symOrdConfig 1
-
--- | Derive 'SymOrd2' instance for a GADT.
-deriveGADTSymOrd2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTSymOrd2 deriveConfig = genBinaryOpClass deriveConfig symOrdConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveToCon.hs b/src/Grisette/Internal/TH/GADT/DeriveToCon.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveToCon.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveToCon
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveToCon
-  ( deriveGADTToCon,
-    deriveGADTToCon1,
-    deriveGADTToCon2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.ToCon
-  ( ToCon (toCon),
-    ToCon1 (liftToCon),
-    ToCon2 (liftToCon2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.ConvertOpCommon
-  ( ConvertOpClassConfig
-      ( ConvertOpClassConfig,
-        convertFieldCombineFun,
-        convertFieldFunExp,
-        convertFieldResFun,
-        convertOpFunNames,
-        convertOpInstanceNames,
-        convertOpTarget
-      ),
-    defaultFieldFunExp,
-    genConvertOpClass,
-  )
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (C))
-import Language.Haskell.TH (Dec, Name, Q, conE)
-
-toConClassConfig :: ConvertOpClassConfig
-toConClassConfig =
-  ConvertOpClassConfig
-    { convertFieldResFun = \v f -> [|$(return f) $(return v)|],
-      convertFieldCombineFun = \f args ->
-        foldl
-          (\acc arg -> [|$(acc) <*> $arg|])
-          [|return $(conE f)|]
-          $ fmap return args,
-      convertFieldFunExp = defaultFieldFunExp ['toCon, 'liftToCon, 'liftToCon2],
-      convertOpTarget = C,
-      convertOpInstanceNames = [''ToCon, ''ToCon1, ''ToCon2],
-      convertOpFunNames = ['toCon, 'liftToCon, 'liftToCon2]
-    }
-
--- | Derive 'ToCon' instance for a GADT.
-deriveGADTToCon :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTToCon deriveConfig = genConvertOpClass deriveConfig toConClassConfig 0
-
--- | Derive 'ToCon1' instance for a GADT.
-deriveGADTToCon1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTToCon1 deriveConfig =
-  genConvertOpClass deriveConfig toConClassConfig 1
-
--- | Derive 'ToCon2' instance for a GADT.
-deriveGADTToCon2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTToCon2 deriveConfig =
-  genConvertOpClass deriveConfig toConClassConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveToSym.hs b/src/Grisette/Internal/TH/GADT/DeriveToSym.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveToSym.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveToSym
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveToSym
-  ( deriveGADTToSym,
-    deriveGADTToSym1,
-    deriveGADTToSym2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Core.Data.Class.ToSym
-  ( ToSym (toSym),
-    ToSym1 (liftToSym),
-    ToSym2 (liftToSym2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig)
-import Grisette.Internal.TH.GADT.ConvertOpCommon
-  ( ConvertOpClassConfig
-      ( ConvertOpClassConfig,
-        convertFieldCombineFun,
-        convertFieldFunExp,
-        convertFieldResFun,
-        convertOpInstanceNames,
-        convertOpTarget
-      ),
-    convertOpFunNames,
-    defaultFieldFunExp,
-    genConvertOpClass,
-  )
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag (S))
-import Language.Haskell.TH (Dec, Name, Q, appE, conE)
-
-toSymClassConfig :: ConvertOpClassConfig
-toSymClassConfig =
-  ConvertOpClassConfig
-    { convertFieldResFun = \v f -> [|$(return f) $(return v)|],
-      convertFieldCombineFun =
-        \f args -> foldl appE (conE f) $ fmap return args,
-      convertFieldFunExp = defaultFieldFunExp ['toSym, 'liftToSym, 'liftToSym2],
-      convertOpTarget = S,
-      convertOpInstanceNames = [''ToSym, ''ToSym1, ''ToSym2],
-      convertOpFunNames = ['toSym, 'liftToSym, 'liftToSym2]
-    }
-
--- | Derive 'ToSym' instance for a GADT.
-deriveGADTToSym :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTToSym deriveConfig = genConvertOpClass deriveConfig toSymClassConfig 0
-
--- | Derive 'ToSym1' instance for a GADT.
-deriveGADTToSym1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTToSym1 deriveConfig =
-  genConvertOpClass deriveConfig toSymClassConfig 1
-
--- | Derive 'ToSym2' instance for a GADT.
-deriveGADTToSym2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTToSym2 deriveConfig =
-  genConvertOpClass deriveConfig toSymClassConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveUnifiedSimpleMergeable.hs b/src/Grisette/Internal/TH/GADT/DeriveUnifiedSimpleMergeable.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveUnifiedSimpleMergeable.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveUnifiedSimpleMergeable
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveUnifiedSimpleMergeable
-  ( deriveGADTUnifiedSimpleMergeable,
-    deriveGADTUnifiedSimpleMergeable1,
-    deriveGADTUnifiedSimpleMergeable2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSimpleMergeable
-  ( UnifiedSimpleMergeable (withBaseSimpleMergeable),
-    UnifiedSimpleMergeable1 (withBaseSimpleMergeable1),
-    UnifiedSimpleMergeable2 (withBaseSimpleMergeable2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig (evalModeConfig))
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    genUnaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.UnifiedOpCommon
-  ( UnaryOpUnifiedConfig (UnaryOpUnifiedConfig, unifiedFun),
-    defaultUnaryOpUnifiedFun,
-  )
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
-import Language.Haskell.TH
-  ( Dec,
-    Name,
-    Q,
-    Type (ConT, VarT),
-    appT,
-    conT,
-    newName,
-  )
-
-unifiedSimpleMergeableConfig :: UnaryOpClassConfig
-unifiedSimpleMergeableConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpUnifiedConfig
-              { unifiedFun =
-                  defaultUnaryOpUnifiedFun
-                    [ 'withBaseSimpleMergeable,
-                      'withBaseSimpleMergeable1,
-                      'withBaseSimpleMergeable2
-                    ]
-              }
-            [ 'withBaseSimpleMergeable,
-              'withBaseSimpleMergeable1,
-              'withBaseSimpleMergeable2
-            ]
-        ],
-      unaryOpInstanceNames =
-        [ ''UnifiedSimpleMergeable,
-          ''UnifiedSimpleMergeable1,
-          ''UnifiedSimpleMergeable2
-        ],
-      unaryOpExtraVars = \config -> do
-        let modeConfigs = evalModeConfig config
-        case modeConfigs of
-          [] -> do
-            nm <- newName "mode"
-            return [(VarT nm, ConT ''EvalModeTag)]
-          [_] -> return []
-          _ -> fail "UnifiedSimpleMergeable does not support multiple evaluation modes",
-      unaryOpInstanceTypeFromConfig =
-        \config newModeVars keptNewVars con -> do
-          let modeConfigs = evalModeConfig config
-          modeVar <- case modeConfigs of
-            [] -> return $ head newModeVars
-            [(i, _)] -> do
-              if i >= length keptNewVars
-                then fail "UnifiedSimpleMergeable reference to a non-existent mode variable"
-                else return $ keptNewVars !! i
-            _ -> fail "UnifiedSimpleMergeable does not support multiple evaluation modes"
-          appT (conT con) (return $ fst modeVar),
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'UnifiedSimpleMergeable' instance for a GADT.
-deriveGADTUnifiedSimpleMergeable :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSimpleMergeable deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSimpleMergeableConfig 0
-
--- | Derive 'UnifiedSimpleMergeable1' instance for a GADT.
-deriveGADTUnifiedSimpleMergeable1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSimpleMergeable1 deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSimpleMergeableConfig 1
-
--- | Derive 'UnifiedSimpleMergeable2' instance for a GADT.
-deriveGADTUnifiedSimpleMergeable2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSimpleMergeable2 deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSimpleMergeableConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveUnifiedSymEq.hs b/src/Grisette/Internal/TH/GADT/DeriveUnifiedSymEq.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveUnifiedSymEq.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveUnifiedSymEq
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveUnifiedSymEq
-  ( deriveGADTUnifiedSymEq,
-    deriveGADTUnifiedSymEq1,
-    deriveGADTUnifiedSymEq2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymEq
-  ( UnifiedSymEq (withBaseSymEq),
-    UnifiedSymEq1 (withBaseSymEq1),
-    UnifiedSymEq2 (withBaseSymEq2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig (evalModeConfig))
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    genUnaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.UnifiedOpCommon
-  ( UnaryOpUnifiedConfig (UnaryOpUnifiedConfig, unifiedFun),
-    defaultUnaryOpUnifiedFun,
-  )
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
-import Language.Haskell.TH
-  ( Dec,
-    Name,
-    Q,
-    Type (ConT, VarT),
-    appT,
-    conT,
-    newName,
-  )
-
-unifiedSymEqConfig :: UnaryOpClassConfig
-unifiedSymEqConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpUnifiedConfig
-              { unifiedFun =
-                  defaultUnaryOpUnifiedFun
-                    ['withBaseSymEq, 'withBaseSymEq1, 'withBaseSymEq2]
-              }
-            ['withBaseSymEq, 'withBaseSymEq1, 'withBaseSymEq2]
-        ],
-      unaryOpInstanceNames = [''UnifiedSymEq, ''UnifiedSymEq1, ''UnifiedSymEq2],
-      unaryOpExtraVars = \config -> do
-        let modeConfigs = evalModeConfig config
-        case modeConfigs of
-          [] -> do
-            nm <- newName "mode"
-            return [(VarT nm, ConT ''EvalModeTag)]
-          [_] -> return []
-          _ -> fail "UnifiedSymEq does not support multiple evaluation modes",
-      unaryOpInstanceTypeFromConfig =
-        \config newModeVars keptNewVars con -> do
-          let modeConfigs = evalModeConfig config
-          modeVar <- case modeConfigs of
-            [] -> return $ head newModeVars
-            [(i, _)] -> do
-              if i >= length keptNewVars
-                then fail "UnifiedSymEq reference to a non-existent mode variable"
-                else return $ keptNewVars !! i
-            _ -> fail "UnifiedSymEq does not support multiple evaluation modes"
-          appT (conT con) (return $ fst modeVar),
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'UnifiedSymEq' instance for a GADT.
-deriveGADTUnifiedSymEq :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSymEq deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSymEqConfig 0
-
--- | Derive 'UnifiedSymEq1' instance for a GADT.
-deriveGADTUnifiedSymEq1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSymEq1 deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSymEqConfig 1
-
--- | Derive 'UnifiedSymEq2' instance for a GADT.
-deriveGADTUnifiedSymEq2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSymEq2 deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSymEqConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/DeriveUnifiedSymOrd.hs b/src/Grisette/Internal/TH/GADT/DeriveUnifiedSymOrd.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/DeriveUnifiedSymOrd.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Unused LANGUAGE pragma" #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.DeriveUnifiedSymOrd
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.DeriveUnifiedSymOrd
-  ( deriveGADTUnifiedSymOrd,
-    deriveGADTUnifiedSymOrd1,
-    deriveGADTUnifiedSymOrd2,
-  )
-where
-
-import Grisette.Internal.Internal.Decl.Unified.Class.UnifiedSymOrd
-  ( UnifiedSymOrd (withBaseSymOrd),
-    UnifiedSymOrd1 (withBaseSymOrd1),
-    UnifiedSymOrd2 (withBaseSymOrd2),
-  )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig (evalModeConfig))
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig
-      ( UnaryOpClassConfig,
-        unaryOpAllowExistential,
-        unaryOpConfigs,
-        unaryOpExtraVars,
-        unaryOpInstanceNames,
-        unaryOpInstanceTypeFromConfig
-      ),
-    UnaryOpConfig (UnaryOpConfig),
-    genUnaryOpClass,
-  )
-import Grisette.Internal.TH.GADT.UnifiedOpCommon
-  ( UnaryOpUnifiedConfig (UnaryOpUnifiedConfig, unifiedFun),
-    defaultUnaryOpUnifiedFun,
-  )
-import Grisette.Internal.Unified.EvalModeTag (EvalModeTag)
-import Language.Haskell.TH
-  ( Dec,
-    Name,
-    Q,
-    Type (ConT, VarT),
-    appT,
-    conT,
-    newName,
-  )
-
-unifiedSymOrdConfig :: UnaryOpClassConfig
-unifiedSymOrdConfig =
-  UnaryOpClassConfig
-    { unaryOpConfigs =
-        [ UnaryOpConfig
-            UnaryOpUnifiedConfig
-              { unifiedFun =
-                  defaultUnaryOpUnifiedFun
-                    ['withBaseSymOrd, 'withBaseSymOrd1, 'withBaseSymOrd2]
-              }
-            ['withBaseSymOrd, 'withBaseSymOrd1, 'withBaseSymOrd2]
-        ],
-      unaryOpInstanceNames = [''UnifiedSymOrd, ''UnifiedSymOrd1, ''UnifiedSymOrd2],
-      unaryOpExtraVars = \config -> do
-        let modeConfigs = evalModeConfig config
-        case modeConfigs of
-          [] -> do
-            nm <- newName "mode"
-            return [(VarT nm, ConT ''EvalModeTag)]
-          [_] -> return []
-          _ -> fail "UnifiedSymOrd does not support multiple evaluation modes",
-      unaryOpInstanceTypeFromConfig =
-        \config newModeVars keptNewVars con -> do
-          let modeConfigs = evalModeConfig config
-          modeVar <- case modeConfigs of
-            [] -> return $ head newModeVars
-            [(i, _)] -> do
-              if i >= length keptNewVars
-                then fail "UnifiedSymOrd reference to a non-existent mode variable"
-                else return $ keptNewVars !! i
-            _ -> fail "UnifiedSymOrd does not support multiple evaluation modes"
-          appT (conT con) (return $ fst modeVar),
-      unaryOpAllowExistential = True
-    }
-
--- | Derive 'UnifiedSymOrd' instance for a GADT.
-deriveGADTUnifiedSymOrd :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSymOrd deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSymOrdConfig 0
-
--- | Derive 'UnifiedSymOrd1' instance for a GADT.
-deriveGADTUnifiedSymOrd1 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSymOrd1 deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSymOrdConfig 1
-
--- | Derive 'UnifiedSymOrd2' instance for a GADT.
-deriveGADTUnifiedSymOrd2 :: DeriveConfig -> Name -> Q [Dec]
-deriveGADTUnifiedSymOrd2 deriveConfig =
-  genUnaryOpClass deriveConfig unifiedSymOrdConfig 2
diff --git a/src/Grisette/Internal/TH/GADT/ShowPPrintCommon.hs b/src/Grisette/Internal/TH/GADT/ShowPPrintCommon.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/ShowPPrintCommon.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.ShowPPrintCommon
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.ShowPPrintCommon (showPrintFieldFunExp) where
-
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Grisette.Internal.TH.GADT.UnaryOpCommon (FieldFunExp)
-import Language.Haskell.TH (Name, Type (AppT, VarT), varE)
-import Language.Haskell.TH.Datatype (TypeSubstitution (freeVariables))
-
--- | Common 'FieldFunExp' for 'Show' and 'Grisette.Core.PPrint' on a GADT.
-showPrintFieldFunExp :: [Name] -> [Name] -> FieldFunExp
-showPrintFieldFunExp precNames listNames argToFunPat liftedExps = go
-  where
-    allArgNames = M.keysSet argToFunPat
-    typeHasNoArg ty =
-      S.fromList (freeVariables [ty])
-        `S.intersection` allArgNames
-        == S.empty
-    goLst ty = do
-      let fun0 = varE (head listNames)
-          fun1 b = [|$(varE $ listNames !! 1) $(go b) $(goLst b)|]
-          fun2 b c =
-            [|$(varE $ listNames !! 2) $(go b) $(goLst b) $(go c) $(goLst c)|]
-      case ty of
-        AppT (AppT (VarT _) b) c -> fun2 b c
-        AppT (VarT _) b -> fun1 b
-        _ | typeHasNoArg ty -> fun0
-        AppT a b | typeHasNoArg a -> fun1 b
-        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
-        VarT nm -> case M.lookup nm liftedExps of
-          Just [p] -> varE p
-          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-    go ty = do
-      let fun0 = varE (head precNames)
-          fun1 b = [|$(varE $ precNames !! 1) $(go b) $(goLst b)|]
-          fun2 b c =
-            [|$(varE $ precNames !! 2) $(go b) $(goLst b) $(go c) $(goLst c)|]
-      case ty of
-        AppT (AppT (VarT _) b) c -> fun2 b c
-        AppT (VarT _) b -> fun1 b
-        _ | typeHasNoArg ty -> fun0
-        AppT a b | typeHasNoArg a -> fun1 b
-        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
-        VarT nm -> case M.lookup nm argToFunPat of
-          Just pname -> varE pname
-          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
diff --git a/src/Grisette/Internal/TH/GADT/UnaryOpCommon.hs b/src/Grisette/Internal/TH/GADT/UnaryOpCommon.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/UnaryOpCommon.hs
+++ /dev/null
@@ -1,371 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.UnaryOpCommon
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpClassConfig (..),
-    UnaryOpFieldConfig (..),
-    UnaryOpConfig (..),
-    UnaryOpFunConfig (..),
-    FieldFunExp,
-    defaultFieldResFun,
-    defaultFieldFunExp,
-    genUnaryOpClass,
-    defaultUnaryOpInstanceTypeFromConfig,
-  )
-where
-
-import Control.Monad (replicateM, zipWithM)
-import qualified Data.List as List
-import qualified Data.Map as M
-import Data.Maybe (catMaybes, mapMaybe)
-import qualified Data.Set as S
-import Grisette.Internal.TH.GADT.Common
-  ( CheckArgsResult
-      ( CheckArgsResult,
-        argVars,
-        constructors,
-        keptVars
-      ),
-    DeriveConfig,
-    checkArgs,
-    ctxForVar,
-    evalModeSpecializeList,
-    extraConstraint,
-    freshenCheckArgsResult,
-    isVarUsedInFields,
-    specializeResult,
-  )
-import Grisette.Internal.TH.Util (allUsedNames)
-import Language.Haskell.TH
-  ( Body (NormalB),
-    Clause (Clause),
-    Dec (FunD, InstanceD),
-    Exp (VarE),
-    Kind,
-    Name,
-    Pat (VarP, WildP),
-    Q,
-    Type (AppT, ConT, VarT),
-    appE,
-    conP,
-    conT,
-    nameBase,
-    newName,
-    varE,
-    varP,
-  )
-import Language.Haskell.TH.Datatype
-  ( ConstructorInfo (constructorFields, constructorName, constructorVariant),
-    ConstructorVariant,
-    TypeSubstitution (freeVariables),
-    resolveTypeSynonyms,
-  )
-
--- | Type of field function expression generator.
-type FieldFunExp = M.Map Name Name -> M.Map Name [Name] -> Type -> Q Exp
-
--- | Default field function expression generator.
-defaultFieldFunExp :: [Name] -> FieldFunExp
-defaultFieldFunExp unaryOpFunNames argToFunPat _ = go
-  where
-    go ty = do
-      let allArgNames = M.keysSet argToFunPat
-      let typeHasNoArg ty =
-            S.fromList (freeVariables [ty])
-              `S.intersection` allArgNames
-              == S.empty
-      let fun0 = varE $ head unaryOpFunNames
-          fun1 b = [|$(varE $ unaryOpFunNames !! 1) $(go b)|]
-          fun2 b c = [|$(varE $ unaryOpFunNames !! 2) $(go b) $(go c)|]
-          fun3 b c d =
-            [|$(varE $ unaryOpFunNames !! 3) $(go b) $(go c) $(go d)|]
-      case ty of
-        AppT (AppT (AppT (VarT _) b) c) d -> fun3 b c d
-        AppT (AppT (VarT _) b) c -> fun2 b c
-        AppT (VarT _) b -> fun1 b
-        _ | typeHasNoArg ty -> fun0
-        AppT a b | typeHasNoArg a -> fun1 b
-        AppT (AppT a b) c | typeHasNoArg a -> fun2 b c
-        AppT (AppT (AppT a b) c) d | typeHasNoArg a -> fun3 b c d
-        VarT nm -> case M.lookup nm argToFunPat of
-          Just pname -> varE pname
-          _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-        _ -> fail $ "defaultFieldFunExp: unsupported type: " <> show ty
-
--- | Configuration for a unary function field expression generation on a GADT.
-data UnaryOpConfig where
-  UnaryOpConfig ::
-    (UnaryOpFunConfig config) => config -> [Name] -> UnaryOpConfig
-
--- | Default field result function.
-defaultFieldResFun ::
-  ConstructorVariant -> Name -> [Exp] -> Int -> Exp -> Exp -> Q (Exp, [Bool])
-defaultFieldResFun _ _ extraPatExps _ fieldPatExp defaultFieldFunExp = do
-  res <-
-    appE
-      ( foldl
-          (\exp name -> appE exp (return name))
-          (return defaultFieldFunExp)
-          extraPatExps
-      )
-      (return fieldPatExp)
-  return (res, (True <$ extraPatExps))
-
-funPatAndExps ::
-  FieldFunExp ->
-  (Int -> [String]) ->
-  [(Type, Kind)] ->
-  [Type] ->
-  Q ([Pat], [[Pat]], [Exp])
-funPatAndExps fieldFunExpGen extraLiftedPatNames argTypes fields = do
-  let usedArgs = S.fromList $ freeVariables fields
-  let liftedNames = extraLiftedPatNames (length argTypes)
-  args <-
-    traverse
-      ( \(ty, _) -> do
-          case ty of
-            VarT nm ->
-              if S.member nm usedArgs
-                then do
-                  pname <- newName "p"
-                  epname <- traverse newName liftedNames
-                  return (nm, Just (pname, epname))
-                else return ('undefined, Nothing)
-            _ -> return ('undefined, Nothing)
-      )
-      argTypes
-  let argToFunPat =
-        M.fromList $ mapMaybe (\(nm, mpat) -> fmap ((nm,) . fst) mpat) args
-  let argToLiftedPat =
-        M.fromList $ mapMaybe (\(nm, mpat) -> fmap ((nm,) . snd) mpat) args
-  let funPats = fmap (maybe WildP (VarP . fst) . snd) args
-  let extraLiftedPats =
-        fmap
-          ( maybe
-              (replicate (length liftedNames) WildP)
-              (fmap VarP . snd)
-              . snd
-          )
-          args
-  defaultFieldFunExps <-
-    traverse
-      (fieldFunExpGen argToFunPat argToLiftedPat)
-      fields
-  return (funPats, extraLiftedPats, defaultFieldFunExps)
-
--- | Generate a clause for a unary function on a GADT.
-genUnaryOpFieldClause ::
-  UnaryOpFieldConfig ->
-  [(Type, Kind)] ->
-  Int ->
-  ConstructorInfo ->
-  Q Clause
-genUnaryOpFieldClause
-  (UnaryOpFieldConfig {..})
-  argTypes
-  conIdx
-  conInfo = do
-    fields <- mapM resolveTypeSynonyms $ constructorFields conInfo
-    (funPats, funLiftedPats, defaultFieldFunExps) <-
-      funPatAndExps fieldFunExp extraLiftedPatNames argTypes fields
-    extraPatNames <- traverse newName extraPatNames
-    let extraPatExps = fmap VarE extraPatNames
-    fieldsPatNames <- replicateM (length fields) $ newName "field"
-    let extraPats = fmap VarP extraPatNames
-    fieldPats <- conP (constructorName conInfo) (fmap varP fieldsPatNames)
-    let fieldPatExps = fmap VarE fieldsPatNames
-
-    fieldResExpsAndArgsUsed <-
-      sequence $
-        zipWith3
-          ( fieldResFun
-              (constructorVariant conInfo)
-              (constructorName conInfo)
-              extraPatExps
-          )
-          [0 ..]
-          fieldPatExps
-          defaultFieldFunExps
-    let fieldResExps = fst <$> fieldResExpsAndArgsUsed
-    let extraArgsUsedByFields = snd <$> fieldResExpsAndArgsUsed
-
-    (resExp, extraArgsUsedByResult) <-
-      fieldCombineFun
-        conIdx
-        (constructorVariant conInfo)
-        (constructorName conInfo)
-        extraPatExps
-        fieldResExps
-    let resUsedNames = allUsedNames resExp
-    let extraArgsUsed =
-          fmap or $
-            List.transpose $
-              extraArgsUsedByResult : extraArgsUsedByFields
-    let extraArgsPats =
-          zipWith
-            (\pat used -> if used then pat else WildP)
-            extraPats
-            extraArgsUsed
-    let transformPat (VarP nm) =
-          if S.member nm resUsedNames then VarP nm else WildP
-        transformPat p = p
-    return $
-      Clause
-        ( fmap transformPat $
-            concat (zipWith (:) funPats funLiftedPats)
-              ++ extraArgsPats
-              ++ [fieldPats]
-        )
-        (NormalB resExp)
-        []
-
--- | Configuration for a unary operation type class generation on a GADT.
-data UnaryOpClassConfig = UnaryOpClassConfig
-  { unaryOpConfigs :: [UnaryOpConfig],
-    unaryOpInstanceNames :: [Name],
-    unaryOpExtraVars :: DeriveConfig -> Q [(Type, Kind)],
-    unaryOpInstanceTypeFromConfig ::
-      DeriveConfig ->
-      [(Type, Kind)] ->
-      [(Type, Kind)] ->
-      Name ->
-      Q Type,
-    unaryOpAllowExistential :: Bool
-  }
-
--- | Default unary operation instance type generator.
-defaultUnaryOpInstanceTypeFromConfig ::
-  DeriveConfig -> [(Type, Kind)] -> [(Type, Kind)] -> Name -> Q Type
-defaultUnaryOpInstanceTypeFromConfig _ _ _ = conT
-
--- | Configuration for the derivation rules for a unary operation that can be
--- derived by transforming each field and then combining the results.
-data UnaryOpFieldConfig = UnaryOpFieldConfig
-  { extraPatNames :: [String],
-    extraLiftedPatNames :: Int -> [String],
-    fieldResFun ::
-      ConstructorVariant ->
-      Name ->
-      [Exp] ->
-      Int ->
-      Exp ->
-      Exp ->
-      Q (Exp, [Bool]),
-    fieldCombineFun ::
-      Int ->
-      ConstructorVariant ->
-      Name ->
-      [Exp] ->
-      [Exp] ->
-      Q (Exp, [Bool]),
-    fieldFunExp :: FieldFunExp
-  }
-
--- | Configuration for the derivation rules for a unary operation.
-class UnaryOpFunConfig config where
-  genUnaryOpFun ::
-    -- | Derive configuration
-    DeriveConfig ->
-    -- | Configuration
-    config ->
-    -- | Function names
-    [Name] ->
-    -- | Number of functor arguments to the class
-    Int ->
-    -- | Extra variables
-    [(Type, Kind)] ->
-    -- | Kept variables
-    [(Type, Kind)] ->
-    -- | Argument variables
-    [(Type, Kind)] ->
-    -- | Whether the variable is used in fields
-    (Name -> Bool) ->
-    -- | Constructor infos
-    [ConstructorInfo] ->
-    Q Dec
-
-instance UnaryOpFunConfig UnaryOpFieldConfig where
-  genUnaryOpFun _ config funNames n _ _ argTypes _ constructors = do
-    clauses <-
-      zipWithM
-        ( genUnaryOpFieldClause
-            config
-            argTypes
-        )
-        [0 ..]
-        constructors
-    let instanceFunName = funNames !! n
-    return $ FunD instanceFunName clauses
-
--- | Generate a unary operation type class instance for a GADT.
-genUnaryOpClass ::
-  DeriveConfig ->
-  UnaryOpClassConfig ->
-  Int ->
-  Name ->
-  Q [Dec]
-genUnaryOpClass deriveConfig (UnaryOpClassConfig {..}) n typName = do
-  result@CheckArgsResult {..} <-
-    specializeResult (evalModeSpecializeList deriveConfig)
-      =<< freshenCheckArgsResult True
-      =<< checkArgs
-        (nameBase $ head unaryOpInstanceNames)
-        (length unaryOpInstanceNames - 1)
-        typName
-        unaryOpAllowExistential
-        n
-  extraVars <- unaryOpExtraVars deriveConfig
-  instanceTypes <-
-    traverse
-      (unaryOpInstanceTypeFromConfig deriveConfig extraVars keptVars)
-      unaryOpInstanceNames
-  let isTypeUsedInFields (VarT nm) = isVarUsedInFields result nm
-      isTypeUsedInFields _ = False
-  ctxs <-
-    traverse (uncurry $ ctxForVar instanceTypes) $
-      filter (isTypeUsedInFields . fst) keptVars
-  let keptType = foldl AppT (ConT typName) $ fmap fst keptVars
-  instanceFuns <-
-    traverse
-      ( \(UnaryOpConfig config funNames) ->
-          genUnaryOpFun
-            deriveConfig
-            config
-            funNames
-            n
-            extraVars
-            keptVars
-            argVars
-            (isVarUsedInFields result)
-            constructors
-      )
-      unaryOpConfigs
-  let instanceName = unaryOpInstanceNames !! n
-  let instanceType = AppT (instanceTypes !! n) keptType
-  extraPreds <-
-    extraConstraint
-      deriveConfig
-      typName
-      instanceName
-      extraVars
-      keptVars
-      constructors
-  return
-    [ InstanceD
-        Nothing
-        (extraPreds ++ catMaybes ctxs)
-        instanceType
-        instanceFuns
-    ]
diff --git a/src/Grisette/Internal/TH/GADT/UnifiedOpCommon.hs b/src/Grisette/Internal/TH/GADT/UnifiedOpCommon.hs
deleted file mode 100644
--- a/src/Grisette/Internal/TH/GADT/UnifiedOpCommon.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-
--- |
--- Module      :   Grisette.Internal.TH.GADT.UnifiedOpCommon
--- Copyright   :   (c) Sirui Lu 2024
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Internal.TH.GADT.UnifiedOpCommon
-  ( UnaryOpUnifiedConfig (..),
-    defaultUnaryOpUnifiedFun,
-  )
-where
-
-import Grisette.Internal.TH.GADT.Common (DeriveConfig (evalModeConfig))
-import Grisette.Internal.TH.GADT.UnaryOpCommon
-  ( UnaryOpFunConfig (genUnaryOpFun),
-  )
-import Grisette.Internal.Unified.Util (withMode)
-import Language.Haskell.TH
-  ( Exp (VarE),
-    Kind,
-    Name,
-    Q,
-    Type (AppT, ArrowT, StarT, VarT),
-    appE,
-    clause,
-    funD,
-    newName,
-    normalB,
-    varE,
-    varP,
-  )
-
--- | Default implementation for the derivation rules for a unified operation.
-defaultUnaryOpUnifiedFun :: [Name] -> Type -> (Type, Kind) -> Q (Maybe Exp)
-defaultUnaryOpUnifiedFun funNames modeTy (ty, kind) =
-  case kind of
-    StarT ->
-      Just
-        <$> [|
-          $(varE $ head funNames) @($(return modeTy))
-            @($(return ty))
-          |]
-    AppT (AppT ArrowT StarT) StarT ->
-      Just
-        <$> [|
-          $(varE $ funNames !! 1) @($(return modeTy))
-            @($(return ty))
-          |]
-    AppT (AppT (AppT ArrowT StarT) StarT) StarT ->
-      Just
-        <$> [|
-          $(varE $ funNames !! 2) @($(return modeTy))
-            @($(return ty))
-          |]
-    _ -> return Nothing
-
--- | Configuration for the derivation rules for a unified operation.
-newtype UnaryOpUnifiedConfig = UnaryOpUnifiedConfig
-  {unifiedFun :: Type -> (Type, Kind) -> Q (Maybe Exp)}
-
-instance UnaryOpFunConfig UnaryOpUnifiedConfig where
-  genUnaryOpFun
-    deriveConfig
-    (UnaryOpUnifiedConfig {..})
-    funNames
-    n
-    extraVars
-    keptTypes
-    _
-    isVarUsedInFields
-    _ = do
-      modeTy <- case evalModeConfig deriveConfig of
-        [] -> return $ fst $ head extraVars
-        [(i, _)] -> return $ fst $ keptTypes !! i
-        _ -> fail "Unified classes does not support multiple evaluation modes"
-      let isTypeUsedInFields (VarT nm) = isVarUsedInFields nm
-          isTypeUsedInFields _ = False
-      exprs <-
-        traverse (unifiedFun modeTy) $
-          filter (isTypeUsedInFields . fst) keptTypes
-      rVar <- newName "r"
-      let rf =
-            foldl
-              ( \exp nextFun -> case nextFun of
-                  Nothing -> exp
-                  Just fun -> appE (return fun) exp
-              )
-              (return $ VarE rVar)
-              exprs
-      let instanceFunName = funNames !! n
-      funD
-        instanceFunName
-        [ clause
-            [varP rVar]
-            ( normalB
-                [|
-                  withMode @($(return modeTy)) $(rf) $(rf)
-                  |]
-            )
-            []
-        ]
diff --git a/src/Grisette/Internal/Unified/Class/UnifiedFiniteBits.hs b/src/Grisette/Internal/Unified/Class/UnifiedFiniteBits.hs
--- a/src/Grisette/Internal/Unified/Class/UnifiedFiniteBits.hs
+++ b/src/Grisette/Internal/Unified/Class/UnifiedFiniteBits.hs
@@ -135,7 +135,7 @@
   a
 symPopCount a =
   withMode @mode
-    (withBaseFiniteBits @mode @a (fromIntegral $ popCount a))
+    (withBaseFiniteBits @mode @a (0 * a + fromIntegral (popCount a)))
     ( withBaseFiniteBits @mode @a $
         withBaseITEOp @mode @a (SymFiniteBits.symPopCount a)
     )
@@ -149,7 +149,7 @@
   a
 symCountLeadingZeros a =
   withMode @mode
-    (withBaseFiniteBits @mode @a (fromIntegral $ countLeadingZeros a))
+    (withBaseFiniteBits @mode @a (0 * a + fromIntegral (countLeadingZeros a)))
     ( withBaseFiniteBits @mode @a $
         withBaseITEOp @mode @a (SymFiniteBits.symCountLeadingZeros a)
     )
@@ -163,7 +163,7 @@
   a
 symCountTrailingZeros a =
   withMode @mode
-    (withBaseFiniteBits @mode @a (fromIntegral $ countTrailingZeros a))
+    (withBaseFiniteBits @mode @a (0 * a + fromIntegral (countTrailingZeros a)))
     ( withBaseFiniteBits @mode @a $
         withBaseITEOp @mode @a (SymFiniteBits.symCountTrailingZeros a)
     )
diff --git a/src/Grisette/Internal/Unified/Util.hs b/src/Grisette/Internal/Unified/Util.hs
--- a/src/Grisette/Internal/Unified/Util.hs
+++ b/src/Grisette/Internal/Unified/Util.hs
@@ -83,6 +83,12 @@
     ((c ~ 'S, s ~ 'S) => r) ->
     r
 
+instance {-# INCOHERENT #-} (DecideEvalMode c) => EvalModeConvertible c c where
+  withModeConvertible con sym = withMode @c con sym
+  {-# INLINE withModeConvertible #-}
+  withModeConvertible' con _ sym = withMode @c con sym
+  {-# INLINE withModeConvertible' #-}
+
 instance {-# INCOHERENT #-} (DecideEvalMode s) => EvalModeConvertible 'C s where
   withModeConvertible con _ = con
   {-# INLINE withModeConvertible #-}
diff --git a/src/Grisette/SymPrim.hs b/src/Grisette/SymPrim.hs
--- a/src/Grisette/SymPrim.hs
+++ b/src/Grisette/SymPrim.hs
@@ -172,7 +172,7 @@
     SupportedPrim,
     SymRep (SymType),
     ConRep (ConType),
-    LinkedRep,
+    LinkedRep (..),
 
     -- * Extract symbolic values
     SomeSym (..),
@@ -208,6 +208,66 @@
     Model,
     ModelValuePair (..),
     ModelSymPair (..),
+
+    -- * Analysis on the terms
+    Term,
+    SomeTerm (..),
+    termSize,
+    someTermSize,
+    termsSize,
+    someTermsSize,
+    pattern SupportedTerm,
+    pattern SupportedTypedSymbol,
+    pattern SupportedConstantTypedSymbol,
+    pattern ConTerm,
+    pattern SymTerm,
+    pattern ForallTerm,
+    pattern ExistsTerm,
+    pattern NotTerm,
+    pattern OrTerm,
+    pattern AndTerm,
+    pattern EqTerm,
+    pattern DistinctTerm,
+    pattern ITETerm,
+    pattern AddNumTerm,
+    pattern NegNumTerm,
+    pattern MulNumTerm,
+    pattern AbsNumTerm,
+    pattern SignumNumTerm,
+    pattern LtOrdTerm,
+    pattern LeOrdTerm,
+    pattern AndBitsTerm,
+    pattern OrBitsTerm,
+    pattern XorBitsTerm,
+    pattern ComplementBitsTerm,
+    pattern ShiftLeftTerm,
+    pattern RotateLeftTerm,
+    pattern ShiftRightTerm,
+    pattern RotateRightTerm,
+    pattern BitCastTerm,
+    pattern BitCastOrTerm,
+    pattern BVConcatTerm,
+    pattern BVSelectTerm,
+    pattern BVExtendTerm,
+    pattern ApplyTerm,
+    pattern DivIntegralTerm,
+    pattern ModIntegralTerm,
+    pattern QuotIntegralTerm,
+    pattern RemIntegralTerm,
+    pattern FPTraitTerm,
+    pattern FdivTerm,
+    pattern RecipTerm,
+    pattern FloatingUnaryTerm,
+    pattern PowerTerm,
+    pattern FPUnaryTerm,
+    pattern FPBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPFMATerm,
+    pattern FromIntegralTerm,
+    pattern FromFPOrTerm,
+    pattern ToFPTerm,
+    pattern SubTerms,
   )
 where
 
@@ -263,21 +323,83 @@
     ModelValuePair (..),
     SymbolSet (..),
   )
+import Grisette.Internal.SymPrim.Prim.Pattern (pattern SubTerms)
+import Grisette.Internal.SymPrim.Prim.SomeTerm
+  ( SomeTerm (..),
+  )
 import Grisette.Internal.SymPrim.Prim.Term
   ( ConRep (..),
     IsSymbolKind (..),
-    LinkedRep,
+    LinkedRep (..),
     SomeTypedAnySymbol,
     SomeTypedConstantSymbol,
     SomeTypedSymbol (..),
     SupportedPrim,
     SymRep (..),
     SymbolKind (..),
+    Term,
     TypedAnySymbol,
     TypedConstantSymbol,
     TypedSymbol (..),
     typedAnySymbol,
     typedConstantSymbol,
+    pattern AbsNumTerm,
+    pattern AddNumTerm,
+    pattern AndBitsTerm,
+    pattern AndTerm,
+    pattern ApplyTerm,
+    pattern BVConcatTerm,
+    pattern BVExtendTerm,
+    pattern BVSelectTerm,
+    pattern BitCastOrTerm,
+    pattern BitCastTerm,
+    pattern ComplementBitsTerm,
+    pattern ConTerm,
+    pattern DistinctTerm,
+    pattern DivIntegralTerm,
+    pattern EqTerm,
+    pattern ExistsTerm,
+    pattern FPBinaryTerm,
+    pattern FPFMATerm,
+    pattern FPRoundingBinaryTerm,
+    pattern FPRoundingUnaryTerm,
+    pattern FPTraitTerm,
+    pattern FPUnaryTerm,
+    pattern FdivTerm,
+    pattern FloatingUnaryTerm,
+    pattern ForallTerm,
+    pattern FromFPOrTerm,
+    pattern FromIntegralTerm,
+    pattern ITETerm,
+    pattern LeOrdTerm,
+    pattern LtOrdTerm,
+    pattern ModIntegralTerm,
+    pattern MulNumTerm,
+    pattern NegNumTerm,
+    pattern NotTerm,
+    pattern OrBitsTerm,
+    pattern OrTerm,
+    pattern PowerTerm,
+    pattern QuotIntegralTerm,
+    pattern RecipTerm,
+    pattern RemIntegralTerm,
+    pattern RotateLeftTerm,
+    pattern RotateRightTerm,
+    pattern ShiftLeftTerm,
+    pattern ShiftRightTerm,
+    pattern SignumNumTerm,
+    pattern SupportedConstantTypedSymbol,
+    pattern SupportedTerm,
+    pattern SupportedTypedSymbol,
+    pattern SymTerm,
+    pattern ToFPTerm,
+    pattern XorBitsTerm,
+  )
+import Grisette.Internal.SymPrim.Prim.TermUtils
+  ( someTermSize,
+    someTermsSize,
+    termSize,
+    termsSize,
   )
 import Grisette.Internal.SymPrim.Quantifier
   ( existsFresh,
diff --git a/src/Grisette/TH.hs b/src/Grisette/TH.hs
--- a/src/Grisette/TH.hs
+++ b/src/Grisette/TH.hs
@@ -12,20 +12,42 @@
   ( -- * Convenient derivation of all instances relating to Grisette
     EvalModeConfig (..),
     DeriveConfig (..),
-    deriveGADT,
-    deriveGADTWith,
+    derive,
+    deriveWith,
     allClasses0,
     allClasses01,
     allClasses012,
     basicClasses0,
     noExistentialClasses0,
-    ordClasses0,
+    concreteOrdClasses0,
     basicClasses1,
     noExistentialClasses1,
-    ordClasses1,
+    concreteOrdClasses1,
     basicClasses2,
     noExistentialClasses2,
-    ordClasses2,
+    concreteOrdClasses2,
+    showClasses,
+    pprintClasses,
+    evalSymClasses,
+    extractSymClasses,
+    substSymClasses,
+    allSymsClasses,
+    eqClasses,
+    ordClasses,
+    symOrdClasses,
+    symEqClasses,
+    unifiedSymOrdClasses,
+    unifiedSymEqClasses,
+    mergeableClasses,
+    nfDataClasses,
+    hashableClasses,
+    toSymClasses,
+    toConClasses,
+    serialClasses,
+    simpleMergeableClasses,
+    unifiedSimpleMergeableClasses,
+    filterExactNumArgs,
+    filterLeqNumArgs,
 
     -- * Smart constructors that merges in a monad
     makePrefixedSmartCtor,
@@ -53,20 +75,45 @@
     makeUnifiedCtor,
     makeUnifiedCtorWith,
   )
-import Grisette.Internal.TH.GADT.Common (DeriveConfig (..), EvalModeConfig (..))
-import Grisette.Internal.TH.GADT.DeriveGADT
+import Grisette.Internal.TH.Derivation.Common
+  ( DeriveConfig (..),
+    EvalModeConfig (..),
+  )
+import Grisette.Internal.TH.Derivation.Derive
   ( allClasses0,
     allClasses01,
     allClasses012,
+    allSymsClasses,
     basicClasses0,
     basicClasses1,
     basicClasses2,
-    deriveGADT,
-    deriveGADTWith,
+    concreteOrdClasses0,
+    concreteOrdClasses1,
+    concreteOrdClasses2,
+    derive,
+    deriveWith,
+    eqClasses,
+    evalSymClasses,
+    extractSymClasses,
+    filterExactNumArgs,
+    filterLeqNumArgs,
+    hashableClasses,
+    mergeableClasses,
+    nfDataClasses,
     noExistentialClasses0,
     noExistentialClasses1,
     noExistentialClasses2,
-    ordClasses0,
-    ordClasses1,
-    ordClasses2,
+    ordClasses,
+    pprintClasses,
+    serialClasses,
+    showClasses,
+    simpleMergeableClasses,
+    substSymClasses,
+    symEqClasses,
+    symOrdClasses,
+    toConClasses,
+    toSymClasses,
+    unifiedSimpleMergeableClasses,
+    unifiedSymEqClasses,
+    unifiedSymOrdClasses,
   )
diff --git a/test/Grisette/Backend/LoweringTests.hs b/test/Grisette/Backend/LoweringTests.hs
--- a/test/Grisette/Backend/LoweringTests.hs
+++ b/test/Grisette/Backend/LoweringTests.hs
@@ -889,7 +889,7 @@
                     ("isNormal", FPIsNormal, SBV.fpIsNormal),
                     ("isSubnormal", FPIsSubnormal, SBV.fpIsSubnormal),
                     ("isPoint", FPIsPoint, SBV.fpIsPoint)
-                    ]
+                  ]
                 return $ testCase name $ do
                   testUnaryOpLowering @FP32 @Bool
                     unboundedConfig
@@ -1026,7 +1026,7 @@
                     ("sinh", sinh, FloatingSinh),
                     ("cosh", cosh, FloatingCosh),
                     ("tanh", tanh, FloatingTanh)
-                    ]
+                  ]
                 return $
                   testCase name $
                     testUnaryOpLowering @AlgReal @AlgReal
diff --git a/test/Grisette/Backend/TermRewritingGen.hs b/test/Grisette/Backend/TermRewritingGen.hs
--- a/test/Grisette/Backend/TermRewritingGen.hs
+++ b/test/Grisette/Backend/TermRewritingGen.hs
@@ -20,6 +20,7 @@
     GeneralSpec (..),
     DifferentSizeBVSpec (..),
     FixedSizedBVWithBoolSpec (..),
+    BoolWithFixedSizedBVSpec (..),
     BoolWithLIASpec (..),
     LIAWithBoolSpec (..),
     BoolWithNRASpec (..),
@@ -49,7 +50,6 @@
     shiftRightSpec,
     rotateLeftSpec,
     rotateRightSpec,
-    xorBitsSpec,
     fpTraitSpec,
     fdivSpec,
     recipSpec,
@@ -64,6 +64,13 @@
     bitCastOrSpec,
     fromFPOrSpec,
     toFPSpec,
+    bvconcatSpec,
+    bvselectSpec,
+    bvextendSpec,
+    andBitsSpec,
+    orBitsSpec,
+    xorBitsSpec,
+    complementBitsSpec,
     IEEEFPSpec (..),
     IEEEFPBoolOpSpec (..),
     FPRoundingModeSpec (..),
diff --git a/test/Grisette/Backend/TermRewritingTests.hs b/test/Grisette/Backend/TermRewritingTests.hs
--- a/test/Grisette/Backend/TermRewritingTests.hs
+++ b/test/Grisette/Backend/TermRewritingTests.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
@@ -16,6 +17,7 @@
 where
 
 import Data.Foldable (traverse_)
+import Data.Proxy (Proxy (Proxy))
 import GHC.TypeLits (KnownNat, type (<=))
 import Grisette
   ( AlgReal,
@@ -49,12 +51,13 @@
     z3,
   )
 import Grisette.Backend.TermRewritingGen
-  ( BoolOnlySpec,
+  ( BoolOnlySpec (BoolOnlySpec),
+    BoolWithFixedSizedBVSpec (BoolWithFixedSizedBVSpec),
     BoolWithLIASpec,
     DifferentSizeBVSpec,
     FPRoundingModeBoolOpSpec,
     FPRoundingModeSpec,
-    FixedSizedBVWithBoolSpec,
+    FixedSizedBVWithBoolSpec (FixedSizedBVWithBoolSpec),
     GeneralSpec,
     IEEEFPBoolOpSpec (IEEEFPBoolOpSpec),
     IEEEFPSpec,
@@ -71,9 +74,14 @@
       ),
     absNumSpec,
     addNumSpec,
+    andBitsSpec,
     andSpec,
     bitCastOrSpec,
     bitCastSpec,
+    bvconcatSpec,
+    bvextendSpec,
+    bvselectSpec,
+    complementBitsSpec,
     divIntegralSpec,
     eqvSpec,
     fpBinaryOpSpec,
@@ -88,12 +96,15 @@
     mulNumSpec,
     negNumSpec,
     notSpec,
+    orBitsSpec,
     orSpec,
     quotIntegralSpec,
     remIntegralSpec,
+    shiftLeftSpec,
     shiftRightSpec,
     signumNumSpec,
     toFPSpec,
+    xorBitsSpec,
   )
 import Grisette.Internal.Core.Data.Class.LogicalOp (LogicalOp ((.&&)))
 import Grisette.Internal.Core.Data.Class.SymEq (SymEq ((./=), (.==)))
@@ -114,23 +125,35 @@
     FPRoundingBinaryOp (FPAdd, FPDiv, FPMul, FPSub),
     FPRoundingUnaryOp (FPRoundToIntegral, FPSqrt),
     FPTrait (FPIsPositive),
+    PEvalBVTerm,
     PEvalBitCastOrTerm,
     PEvalBitCastTerm,
+    PEvalBitwiseTerm (pevalAndBitsTerm, pevalOrBitsTerm),
     PEvalIEEEFPConvertibleTerm,
+    PEvalShiftTerm,
     SupportedNonFuncPrim,
     Term,
+    andBitsTerm,
+    andTerm,
+    bvConcatTerm,
+    bvExtendTerm,
+    complementBitsTerm,
     conTerm,
+    eqTerm,
     fpTraitTerm,
     iteTerm,
     notTerm,
+    orBitsTerm,
+    orTerm,
     pformatTerm,
     ssymTerm,
+    xorBitsTerm,
   )
 import Grisette.Internal.SymPrim.SymFP (SymFP32)
 import Test.Framework (Test, TestName, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit (Assertion, assertFailure)
+import Test.HUnit (Assertion, assertFailure, (@?=))
 import Test.QuickCheck
   ( Arbitrary,
     elements,
@@ -245,11 +268,432 @@
           [-3 .. 3]
     ]
 
+bvConcatTest ::
+  forall bv.
+  ( forall n. (KnownNat n, 1 <= n) => SupportedNonFuncPrim (bv n),
+    forall n. (KnownNat n, 1 <= n) => PEvalShiftTerm (bv n),
+    forall n. (KnownNat n, 1 <= n) => Arbitrary (bv n),
+    Typeable bv,
+    PEvalBVTerm bv
+  ) =>
+  Test
+bvConcatTest =
+  testGroup (show (typeRep @bv) <> "_concat") $
+    ( do
+        (opName, opSpec, termOp) <-
+          [ ("and", andBitsSpec, andBitsTerm),
+            ("or", orBitsSpec, orBitsTerm),
+            ("xor", xorBitsSpec, xorBitsTerm)
+          ]
+        [ testCase (opName <> "(const,concat)") $ do
+            let lhs = conSpec 0x39 :: FixedSizedBVWithBoolSpec bv 8
+            let rhs =
+                  bvconcatSpec
+                    (symSpec "a" :: FixedSizedBVWithBoolSpec bv 4)
+                    (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+            let spec = opSpec lhs rhs
+            validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec,
+          testCase (opName <> "(concat,concat)") $ do
+            let lhs =
+                  bvconcatSpec
+                    (symSpec "a" :: FixedSizedBVWithBoolSpec bv 4)
+                    (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+            let rhs =
+                  bvconcatSpec
+                    (symSpec "c" :: FixedSizedBVWithBoolSpec bv 4)
+                    (symSpec "d" :: FixedSizedBVWithBoolSpec bv 4)
+            let spec@(FixedSizedBVWithBoolSpec _ r) = opSpec lhs rhs
+            let expected =
+                  ( bvConcatTerm
+                      (termOp (ssymTerm "a" :: Term (bv 4)) (ssymTerm "c"))
+                      (termOp (ssymTerm "b" :: Term (bv 4)) (ssymTerm "d"))
+                  )
+            r @?= expected
+            validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec
+          ]
+    )
+      ++ [ testCase "complement(concat)" $ do
+             let lhs =
+                   bvconcatSpec
+                     (symSpec "a" :: FixedSizedBVWithBoolSpec bv 4)
+                     (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+             let spec@(FixedSizedBVWithBoolSpec _ r) = complementBitsSpec lhs
+             let expected =
+                   bvConcatTerm
+                     (complementBitsTerm (ssymTerm "a" :: Term (bv 4)))
+                     (complementBitsTerm (ssymTerm "b" :: Term (bv 4)))
+             r @?= expected
+             validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec,
+           testCase "complement(sext)" $ do
+             let spec@(FixedSizedBVWithBoolSpec _ r) =
+                   complementBitsSpec
+                     ( bvextendSpec
+                         True
+                         (Proxy :: Proxy 8)
+                         (symSpec "a" :: FixedSizedBVWithBoolSpec bv 4)
+                     ) ::
+                     FixedSizedBVWithBoolSpec bv 8
+             let expected =
+                   bvExtendTerm
+                     True
+                     (Proxy :: Proxy 8)
+                     (complementBitsTerm (ssymTerm "a" :: Term (bv 4)))
+             r @?= expected
+             validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec,
+           testCase "and(leading_zero_then_all_one, b)" $ do
+             let spec =
+                   andBitsSpec
+                     (conSpec 0x1f)
+                     (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+             validateSpec @(FixedSizedBVWithBoolSpec bv 4) unboundedConfig spec,
+           testCase "and(leading_one_then_all_zero, b)" $ do
+             let spec =
+                   andBitsSpec
+                     (conSpec 0xf8)
+                     (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+             validateSpec @(FixedSizedBVWithBoolSpec bv 4) unboundedConfig spec,
+           testCase "or(leading_zero_then_all_one, b)" $ do
+             let spec =
+                   orBitsSpec
+                     (conSpec 0x1f)
+                     (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+             validateSpec @(FixedSizedBVWithBoolSpec bv 4) unboundedConfig spec,
+           testCase "or(leading_one_then_all_zero, b)" $ do
+             let spec =
+                   orBitsSpec
+                     (conSpec 0xf8)
+                     (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+             validateSpec @(FixedSizedBVWithBoolSpec bv 4) unboundedConfig spec,
+           testCase "select(sext)with_part_base" $ do
+             let spec =
+                   bvselectSpec
+                     (Proxy @2)
+                     (Proxy @4)
+                     ( bvextendSpec
+                         True
+                         (Proxy @8)
+                         (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4) ::
+                         FixedSizedBVWithBoolSpec bv 8
+                     ) ::
+                     FixedSizedBVWithBoolSpec bv 4
+             validateSpec @(FixedSizedBVWithBoolSpec bv 4) unboundedConfig spec,
+           testCase "ite(cond,concat(a,b),concat(c,d))" $ do
+             let spec@(FixedSizedBVWithBoolSpec _ r) =
+                   iteSpec
+                     (symSpec "cond" :: BoolWithFixedSizedBVSpec bv 4)
+                     ( bvconcatSpec
+                         (symSpec "a" :: FixedSizedBVWithBoolSpec bv 4)
+                         (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+                     )
+                     ( bvconcatSpec
+                         (symSpec "c" :: FixedSizedBVWithBoolSpec bv 4)
+                         (symSpec "d" :: FixedSizedBVWithBoolSpec bv 4)
+                     )
+             let expected =
+                   bvConcatTerm
+                     ( iteTerm
+                         (ssymTerm "cond" :: Term Bool)
+                         (ssymTerm "a" :: Term (bv 4))
+                         (ssymTerm "c" :: Term (bv 4))
+                     )
+                     ( iteTerm
+                         (ssymTerm "cond" :: Term Bool)
+                         (ssymTerm "b" :: Term (bv 4))
+                         (ssymTerm "d" :: Term (bv 4))
+                     )
+             r @?= expected
+             validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec
+         ]
+      ++ ( do
+             pos <- [True, False]
+             cvalue <- [0 :: Int, -1]
+             value <- [0 :: Int, -1]
+             let con = conSpec (fromIntegral value) :: FixedSizedBVWithBoolSpec bv 4
+             let sym = symSpec "b"
+             let t = if pos then con else sym
+             let f = if pos then sym else con
+             let spec =
+                   iteSpec
+                     ( eqvSpec
+                         (symSpec "c" :: FixedSizedBVWithBoolSpec bv 1)
+                         (conSpec $ fromIntegral cvalue) ::
+                         BoolWithFixedSizedBVSpec bv 1
+                     )
+                     t
+                     f
+             let ts = if pos then show value else "sym"
+             let fs = if pos then "sym" else show value
+             return
+               $ testCase
+                 ( "ite(bv1="
+                     <> show cvalue
+                     <> ","
+                     <> ts
+                     <> ","
+                     <> fs
+                     <> ")"
+                 )
+               $ validateSpec unboundedConfig spec
+         )
+      ++ ( do
+             let cond = symSpec "cond" :: BoolWithFixedSizedBVSpec bv 1
+             let condTerm = ssymTerm "cond" :: Term Bool
+             (opName, op, opSpec) <-
+               [ ("and", andBitsTerm, andBitsSpec),
+                 ("or", orBitsTerm, orBitsSpec),
+                 ("xor", xorBitsTerm, xorBitsSpec),
+                 ("ite", iteTerm condTerm, iteSpec cond)
+               ]
+             let name = opName <> "(sext,sext)"
+             let spec@(FixedSizedBVWithBoolSpec _ r) =
+                   opSpec
+                     ( bvextendSpec
+                         True
+                         (Proxy :: Proxy 8)
+                         (symSpec "a" :: FixedSizedBVWithBoolSpec bv 4)
+                     )
+                     ( bvextendSpec
+                         True
+                         (Proxy :: Proxy 8)
+                         (symSpec "b" :: FixedSizedBVWithBoolSpec bv 4)
+                     )
+             let expected =
+                   bvExtendTerm
+                     True
+                     (Proxy :: Proxy 8)
+                     ( op
+                         (ssymTerm "a" :: Term (bv 4))
+                         (ssymTerm "b" :: Term (bv 4))
+                     )
+             return $ testCase name $ do
+               r @?= expected
+               validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec
+         )
+      ++ ( do
+             let a = symSpec "a" :: FixedSizedBVWithBoolSpec bv 4
+             let b = symSpec "b" :: FixedSizedBVWithBoolSpec bv 4
+             let c = symSpec "c" :: FixedSizedBVWithBoolSpec bv 4
+             let cond = symSpec "cond" :: BoolWithFixedSizedBVSpec bv 1
+             (lhs, rhs, lhsName, rhsName) <-
+               [ (andBitsSpec a b, a, "(& a b)", "a"),
+                 (andBitsSpec a b, b, "(& a b)", "b"),
+                 (a, andBitsSpec a b, "a", "(& a b)"),
+                 (b, andBitsSpec a b, "b", "(& a b)"),
+                 (orBitsSpec a b, a, "(| a b)", "a"),
+                 (orBitsSpec a b, b, "(| a b)", "b"),
+                 (a, orBitsSpec a b, "a", "(| a b)"),
+                 (b, orBitsSpec a b, "b", "(| a b)"),
+                 (andBitsSpec a b, andBitsSpec a c, "(& a b)", "(& a c)"),
+                 (andBitsSpec a b, andBitsSpec c a, "(& a b)", "(& c a)"),
+                 (andBitsSpec a b, andBitsSpec b c, "(& a b)", "(& b c)"),
+                 (andBitsSpec a b, andBitsSpec c b, "(& a b)", "(& c b)"),
+                 (orBitsSpec a b, orBitsSpec a c, "(| a b)", "(| a c)"),
+                 (orBitsSpec a b, orBitsSpec c a, "(| a b)", "(| c a)"),
+                 (orBitsSpec a b, orBitsSpec b c, "(| a b)", "(| b c)"),
+                 (orBitsSpec a b, orBitsSpec c b, "(| a b)", "(| c b)")
+               ]
+             let spec = iteSpec cond lhs rhs
+             return $
+               testCase ("ite(cond," <> lhsName <> "," <> rhsName <> ")") $
+                 validateSpec @(FixedSizedBVWithBoolSpec bv 4) unboundedConfig spec
+         )
+      ++ ( do
+             trueBranch <- [True, False]
+             (opName, spec) <-
+               [("and", andBitsSpec), ("or", orBitsSpec)]
+             let iteName = "ite(cond,const,const)"
+             let name =
+                   opName
+                     <> "("
+                     <> (if trueBranch then iteName else "a")
+                     <> ","
+                     <> (if trueBranch then "b" else iteName)
+                     <> ")"
+             return $ testProperty name $ \a b -> ioProperty $ do
+               let ite =
+                     iteSpec
+                       (symSpec "cond" :: BoolWithFixedSizedBVSpec bv 4)
+                       (conSpec a :: FixedSizedBVWithBoolSpec bv 4)
+                       (conSpec b :: FixedSizedBVWithBoolSpec bv 4)
+               let s = symSpec "a" :: FixedSizedBVWithBoolSpec bv 4
+               let lhs = if trueBranch then ite else s
+               let rhs = if trueBranch then s else ite
+               let resSpec = spec lhs rhs
+               validateSpec unboundedConfig resSpec
+         )
+      ++ ( do
+             a <- [0, 1, 4, 7, 8, 9, 16]
+             (opName, opSpec) <-
+               [ ("shr", shiftRightSpec),
+                 ("shl", shiftLeftSpec)
+               ]
+             return $ testCase (opName <> "(bv8," <> show a <> ")") $ do
+               let spec =
+                     opSpec
+                       (symSpec "a" :: FixedSizedBVWithBoolSpec bv 8)
+                       (conSpec a)
+               validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec
+         )
+      ++ ( do
+             trueBranch <- [True, False]
+             innerTrueBranch <- [True, False]
+             let l = symSpec "l" :: FixedSizedBVWithBoolSpec bv 8
+             let r = symSpec "r" :: FixedSizedBVWithBoolSpec bv 8
+             let cond = symSpec "cond" :: BoolWithFixedSizedBVSpec bv 8
+             (absorbing, absorbingTerm, absorbingValueName, opName, opSpec, opTerm) <-
+               [ ( conSpec 0 :: FixedSizedBVWithBoolSpec bv 8,
+                   conTerm 0 :: Term (bv 8),
+                   "0",
+                   "and",
+                   andBitsSpec,
+                   andBitsTerm
+                 ),
+                 ( conSpec $ -1 :: FixedSizedBVWithBoolSpec bv 8,
+                   conTerm $ -1 :: Term (bv 8),
+                   "-1",
+                   "or",
+                   orBitsSpec,
+                   orBitsTerm
+                 )
+               ]
+             let condTerm = ssymTerm "cond" :: Term Bool
+             let lTerm = ssymTerm "l" :: Term (bv 8)
+             let rTerm = ssymTerm "r" :: Term (bv 8)
+
+             let (lhsName, lhs, lhsResultTerm)
+                   | trueBranch && innerTrueBranch = ("ite(cond," <> absorbingValueName <> ",l)", iteSpec cond absorbing l, absorbingTerm)
+                   | trueBranch && not innerTrueBranch = ("ite(cond,l," <> absorbingValueName <> ")", iteSpec cond l absorbing, opTerm lTerm rTerm)
+                   | otherwise = ("l", l, if innerTrueBranch then absorbingTerm else opTerm lTerm rTerm)
+             let (rhsName, rhs, rhsResultTerm)
+                   | trueBranch = ("r", r, if innerTrueBranch then opTerm lTerm rTerm else absorbingTerm)
+                   | innerTrueBranch = ("ite(cond," <> absorbingValueName <> ",r)", iteSpec cond absorbing r, opTerm lTerm rTerm)
+                   | otherwise = ("ite(cond,r," <> absorbingValueName <> ")", iteSpec cond r absorbing, absorbingTerm)
+             let spec@(FixedSizedBVWithBoolSpec _ rspec) = opSpec lhs rhs
+             return $ testCase (opName <> "(" <> lhsName <> "," <> rhsName <> ")") $ do
+               rspec @?= iteTerm condTerm lhsResultTerm rhsResultTerm
+               validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec
+         )
+      ++ ( do
+             innerTrueBranch <- [0 :: Int, -1]
+             let innerFalseBranch = -1 - innerTrueBranch
+             lhsIsExtend <- [True, False]
+             let extendName =
+                   "sext(ite(cond,"
+                     <> show innerTrueBranch
+                     <> ","
+                     <> show innerFalseBranch
+                     <> "))"
+             (opName, opSpec, opTerm) <-
+               [ ("and", andBitsSpec, pevalAndBitsTerm),
+                 ("or", orBitsSpec, pevalOrBitsTerm)
+               ]
+             let name =
+                   opName
+                     <> if lhsIsExtend then "(" <> extendName <> ",c)" else "(c," <> extendName <> ")"
+             return $
+               testCase name $
+                 do
+                   let extend =
+                         bvextendSpec
+                           True
+                           (Proxy :: Proxy 8)
+                           ( iteSpec
+                               (symSpec "cond" :: BoolWithFixedSizedBVSpec bv 1)
+                               (conSpec $ fromIntegral innerTrueBranch :: FixedSizedBVWithBoolSpec bv 4)
+                               (conSpec $ fromIntegral innerFalseBranch :: FixedSizedBVWithBoolSpec bv 4)
+                           ) ::
+                           FixedSizedBVWithBoolSpec bv 8
+                   let single = symSpec "c" :: FixedSizedBVWithBoolSpec bv 8
+                   let spec@(FixedSizedBVWithBoolSpec _ r) =
+                         if lhsIsExtend
+                           then opSpec extend single
+                           else opSpec single extend
+                   let expected =
+                         iteTerm
+                           (ssymTerm "cond" :: Term Bool)
+                           (opTerm (conTerm $ fromIntegral innerTrueBranch) (ssymTerm "c"))
+                           (opTerm (conTerm $ fromIntegral innerFalseBranch) (ssymTerm "c"))
+                   r @?= expected
+                   validateSpec @(FixedSizedBVWithBoolSpec bv 8) unboundedConfig spec
+         )
+
+bv1Test ::
+  forall bv.
+  ( SupportedNonFuncPrim (bv 1),
+    Num (bv 1),
+    Typeable bv,
+    PEvalBitwiseTerm (bv 1)
+  ) =>
+  Test
+bv1Test =
+  testGroup (show (typeRep @bv) <> " 1") $
+    ( do
+        (opName, op, v, bvop) <-
+          [ ("||", orSpec, 0, andBitsTerm),
+            ("||", orSpec, 1, orBitsTerm),
+            ("&&", andSpec, 0, orBitsTerm),
+            ("&&", andSpec, 1, andBitsTerm)
+          ]
+        let isV = "==" <> show v
+        let name = "(a" <> isV <> ")" <> opName <> "(b" <> isV <> ")"
+        let spec@(BoolWithFixedSizedBVSpec _ r) =
+              op
+                (eqvSpec (symSpec "a" :: FixedSizedBVWithBoolSpec bv 1) (conSpec v))
+                (eqvSpec (symSpec "b" :: FixedSizedBVWithBoolSpec bv 1) (conSpec v))
+        let expected =
+              eqTerm
+                ( bvop
+                    (ssymTerm "a" :: Term (bv 1))
+                    (ssymTerm "b")
+                )
+                (conTerm v)
+        return $ testCase name $ do
+          r @?= expected
+          validateSpec @(BoolWithFixedSizedBVSpec bv 1) unboundedConfig spec
+    )
+      ++ ( do
+             cond <- [0 :: bv 1, 1]
+             t <- [0 :: bv 1, 1]
+             let f = 1 - t
+             let name = "ite(a==" <> show cond <> "," <> show t <> "," <> show f <> ")"
+             let spec@(FixedSizedBVWithBoolSpec _ r) =
+                   iteSpec
+                     ( eqvSpec
+                         (symSpec "a" :: FixedSizedBVWithBoolSpec bv 1)
+                         (conSpec cond) ::
+                         BoolWithFixedSizedBVSpec bv 1
+                     )
+                     (conSpec t)
+                     (conSpec f)
+             let aTerm = ssymTerm "a" :: Term (bv 1)
+             let expected =
+                   if t == cond
+                     then aTerm
+                     else complementBitsTerm aTerm
+             return $ testCase name $ do
+               r @?= expected
+               validateSpec @(FixedSizedBVWithBoolSpec bv 1) unboundedConfig spec
+         )
+      ++ [ testCase "(a==b)==(a==c)" $ do
+             let spec@(BoolWithFixedSizedBVSpec _ r) =
+                   eqvSpec
+                     (eqvSpec (symSpec "a" :: FixedSizedBVWithBoolSpec bv 1) (symSpec "b") :: BoolWithFixedSizedBVSpec bv 1)
+                     (eqvSpec (symSpec "a" :: FixedSizedBVWithBoolSpec bv 1) (symSpec "c"))
+             validateSpec @(BoolWithFixedSizedBVSpec bv 1)
+               unboundedConfig
+               spec
+             r @?= eqTerm (ssymTerm "b" :: Term (bv 1)) (ssymTerm "c")
+         ]
+
 termRewritingTests :: Test
 termRewritingTests =
   testGroup
     "TermRewriting"
-    [ testGroup
+    [ bv1Test @WordN,
+      bv1Test @IntN,
+      bvConcatTest @WordN,
+      bvConcatTest @IntN,
+      testGroup
         "Bool only"
         [ testProperty "Bool only random test" $
             mapSize (`min` 10) $
@@ -279,7 +723,34 @@
                       )
                   )
                   (symSpec "xxx" :: BoolOnlySpec)
-              )
+              ),
+          testCase "And absortion" $ do
+            let spec@(BoolOnlySpec _ r) =
+                  andSpec
+                    (orSpec (symSpec "c") (orSpec (symSpec "b") (symSpec "a")))
+                    (andSpec (symSpec "a") (andSpec (symSpec "d") (symSpec "e")))
+            validateSpec @BoolOnlySpec
+              unboundedConfig
+              spec
+            r @?= andTerm (ssymTerm "a") (andTerm (ssymTerm "d") (ssymTerm "e")),
+          testCase "Or absorption" $ do
+            let spec@(BoolOnlySpec _ r) =
+                  orSpec
+                    (andSpec (symSpec "c") (andSpec (symSpec "b") (symSpec "a")))
+                    (orSpec (symSpec "a") (orSpec (symSpec "d") (symSpec "e")))
+            validateSpec @BoolOnlySpec
+              unboundedConfig
+              spec
+            r @?= orTerm (ssymTerm "a") (orTerm (ssymTerm "d") (ssymTerm "e")),
+          testCase "(a==b)==(a==c)" $ do
+            let spec@(BoolOnlySpec _ r) =
+                  eqvSpec
+                    (eqvSpec (symSpec "a" :: BoolOnlySpec) (symSpec "b") :: BoolOnlySpec)
+                    (eqvSpec (symSpec "a" :: BoolOnlySpec) (symSpec "c"))
+            validateSpec @BoolOnlySpec
+              unboundedConfig
+              spec
+            r @?= eqTerm (ssymTerm "b" :: Term Bool) (ssymTerm "c")
         ],
       testGroup
         "LIA"
@@ -567,8 +1038,8 @@
                     ]
               let ps =
                     [ fpBinaryOpSpec op l r :: IEEEFPSpec 4 4
-                      | l <- lst,
-                        r <- lst
+                    | l <- lst,
+                      r <- lst
                     ]
               traverse_ (validateSpec z3) ps,
           testGroup "RoundingOp" $ do
@@ -636,10 +1107,7 @@
               ( Arbitrary a,
                 PEvalBitCastTerm a b,
                 SupportedNonFuncPrim a,
-                SupportedNonFuncPrim b,
-                Show a,
-                Typeable a,
-                Typeable b
+                SupportedNonFuncPrim b
               ) =>
               Test
             bitCastCase = testProperty
@@ -658,11 +1126,7 @@
                 PEvalBitCastOrTerm a b,
                 RealFloat a,
                 SupportedNonFuncPrim a,
-                SupportedNonFuncPrim b,
-                Show b,
-                Show a,
-                Typeable b,
-                Typeable a
+                SupportedNonFuncPrim b
               ) =>
               Test
             fromFPCase = testProperty
@@ -681,10 +1145,7 @@
                 PEvalBitCastTerm a b,
                 RealFloat b,
                 SupportedNonFuncPrim a,
-                SupportedNonFuncPrim b,
-                Show a,
-                Typeable a,
-                Typeable b
+                SupportedNonFuncPrim b
               ) =>
               Test
             toFPCase = testProperty
@@ -762,9 +1223,7 @@
               ( ValidFP eb sb,
                 Arbitrary b,
                 PEvalIEEEFPConvertibleTerm b,
-                TermRewritingSpec spec b,
-                Show b,
-                Typeable b
+                TermRewritingSpec spec b
               ) =>
               Bool ->
               Test
@@ -833,9 +1292,7 @@
                 SupportedNonFuncPrim b,
                 LinkedRep b bs,
                 Solvable b bs,
-                SymEq bs,
-                Show b,
-                Typeable b
+                SymEq bs
               ) =>
               Test
             toFPCase = testProperty
diff --git a/test/Grisette/Core/Data/Class/PPrintTests.hs b/test/Grisette/Core/Data/Class/PPrintTests.hs
--- a/test/Grisette/Core/Data/Class/PPrintTests.hs
+++ b/test/Grisette/Core/Data/Class/PPrintTests.hs
@@ -616,40 +616,31 @@
             (arbitrary :: Gen (Maybe (Maybe Int))),
           propertyPFormatRead
             "Maybe (,)"
-            ( arbitrary :: Gen (Maybe (Int, Int))
-            ),
+            (arbitrary :: Gen (Maybe (Int, Int))),
           propertyPFormatRead
             "Maybe I5"
-            ( arbitrary :: Gen (Maybe (I5 Int))
-            ),
+            (arbitrary :: Gen (Maybe (I5 Int))),
           propertyPFormatRead
             "Maybe []"
-            ( arbitrary :: Gen (Maybe [Int])
-            ),
+            (arbitrary :: Gen (Maybe [Int])),
           propertyPFormatRead
             "Maybe Record"
-            ( arbitrary :: Gen (Maybe (Record Int Int))
-            ),
+            (arbitrary :: Gen (Maybe (Record Int Int))),
           propertyPFormatRead
             "(Maybe,Either)"
-            ( arbitrary :: Gen (Maybe Int, Either Int Int)
-            ),
+            (arbitrary :: Gen (Maybe Int, Either Int Int)),
           propertyPFormatRead
             "((,),(,))"
-            ( arbitrary :: Gen ((Int, Int), (Int, Int))
-            ),
+            (arbitrary :: Gen ((Int, Int), (Int, Int))),
           propertyPFormatRead
             "(I5,I5)"
-            ( arbitrary :: Gen (I5 Int, I5 Int)
-            ),
+            (arbitrary :: Gen (I5 Int, I5 Int)),
           propertyPFormatRead
             "([],[])"
-            ( arbitrary :: Gen ([Int], [Int])
-            ),
+            (arbitrary :: Gen ([Int], [Int])),
           propertyPFormatRead
             "(Record,Record)"
-            ( arbitrary :: Gen (Record Int Int, Record Int Int)
-            ),
+            (arbitrary :: Gen (Record Int Int, Record Int Int)),
           propertyPFormatRead "I5 (,)" (arbitrary :: Gen (I5 (Int, Int))),
           propertyPFormatRead "I5 I6" (arbitrary :: Gen (I5 (I6 Int))),
           propertyPFormatRead "I5 I5" (arbitrary :: Gen (I5 (I5 Int))),
@@ -661,41 +652,32 @@
             (arbitrary :: Gen (I5 (Record Int Int))),
           propertyPFormatRead
             "[Maybe]"
-            ( arbitrary :: Gen [Maybe Int]
-            ),
+            (arbitrary :: Gen [Maybe Int]),
           propertyPFormatRead
             "[(,)]"
-            ( arbitrary :: Gen [(Int, Int)]
-            ),
+            (arbitrary :: Gen [(Int, Int)]),
           propertyPFormatRead "[I5]" (arbitrary :: Gen [I5 Int]),
           propertyPFormatRead
             "[[]]"
-            ( arbitrary :: Gen [[Int]]
-            ),
+            (arbitrary :: Gen [[Int]]),
           propertyPFormatRead
             "[Record]"
-            ( arbitrary :: Gen [Record Int Int]
-            ),
+            (arbitrary :: Gen [Record Int Int]),
           propertyPFormatRead
             "Record Maybe Either"
-            ( arbitrary :: Gen (Record (Maybe Int) (Either Int Int))
-            ),
+            (arbitrary :: Gen (Record (Maybe Int) (Either Int Int))),
           propertyPFormatRead
             "Record (,) (,)"
-            ( arbitrary :: Gen (Record (Int, Int) (Int, Int))
-            ),
+            (arbitrary :: Gen (Record (Int, Int) (Int, Int))),
           propertyPFormatRead
             "Record I5 I6"
-            ( arbitrary :: Gen (Record (I5 Int) (I6 Int))
-            ),
+            (arbitrary :: Gen (Record (I5 Int) (I6 Int))),
           propertyPFormatRead
             "Record []"
-            ( arbitrary :: Gen (Record [Int] [Int])
-            ),
+            (arbitrary :: Gen (Record [Int] [Int])),
           propertyPFormatRead
             "Record Record"
-            ( arbitrary :: Gen (Record (Record Int Int) (Record Int Int))
-            ),
+            (arbitrary :: Gen (Record (Record Int Int) (Record Int Int))),
           testPPrint1
             "Identity"
             0
diff --git a/test/Grisette/Core/Data/Class/TryMergeTests.hs b/test/Grisette/Core/Data/Class/TryMergeTests.hs
--- a/test/Grisette/Core/Data/Class/TryMergeTests.hs
+++ b/test/Grisette/Core/Data/Class/TryMergeTests.hs
@@ -158,7 +158,7 @@
                     (\x -> mrgSingle $ x + 1),
                 testMerged = mrgSingle $ symIte "a" ("b" + 1) ("c" + 1)
               }
-            ]
+          ]
         case test of
           TryMergeInstanceTest name unmerged merged ->
             [ testCase name $ do
diff --git a/test/Grisette/Core/TH/DerivationData.hs b/test/Grisette/Core/TH/DerivationData.hs
--- a/test/Grisette/Core/TH/DerivationData.hs
+++ b/test/Grisette/Core/TH/DerivationData.hs
@@ -19,8 +19,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-
--- {-# OPTIONS_GHC -ddump-splices -ddump-to-file -ddump-file-prefix=derivation #-}
+{-# OPTIONS_GHC -ddump-splices -ddump-to-file -ddump-file-prefix=derivation #-}
 
 module Grisette.Core.TH.DerivationData
   ( T (..),
@@ -34,11 +33,14 @@
     Ambiguous (..),
     replaceVVVShown,
     gggToVVV,
+    Serializable (..),
   )
 where
 
 import Control.DeepSeq (NFData, NFData1, NFData2)
 import Control.Monad.Identity (Identity (Identity))
+import Data.Binary (Binary)
+import Data.Bytes.Serial (Serial)
 import Data.Functor.Classes
   ( Eq1 (liftEq),
     Eq2,
@@ -50,6 +52,7 @@
 import Data.Hashable (Hashable)
 import Data.Hashable.Lifted (Hashable1, Hashable2)
 import Data.Maybe (fromJust)
+import Data.Serialize (Serialize)
 import qualified Data.Text as T
 import Data.Typeable (Proxy, Typeable)
 import GHC.Generics (Generic)
@@ -59,6 +62,7 @@
     AllSyms2,
     BasicSymPrim,
     Default (Default),
+    DeriveConfig (unconstrainedPositions),
     EvalSym,
     EvalSym1,
     EvalSym2,
@@ -72,6 +76,7 @@
     PPrint1,
     PPrint2,
     SimpleMergeable,
+    Solvable (con),
     SubstSym,
     SubstSym1,
     SubstSym2,
@@ -88,11 +93,13 @@
     Union,
     allClasses0,
     allClasses012,
-    deriveGADT,
-    deriveGADTWith,
+    derive,
+    deriveWith,
+    (.&&),
+    (.||),
   )
 import Grisette.Core.TH.PartialEvalMode (PartialEvalMode)
-import Grisette.Internal.TH.GADT.Common
+import Grisette.Internal.TH.Derivation.Common
   ( DeriveConfig
       ( bitSizePositions,
         evalModeConfig,
@@ -111,15 +118,30 @@
     GetWordN,
     UnifiedSimpleMergeable,
   )
-import Test.QuickCheck (Arbitrary, oneof)
+import Test.QuickCheck (Arbitrary, oneof, sized)
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 
+newtype Skipped a b c = Skipped b
+
+deriveWith
+  (mempty {unconstrainedPositions = [0, 2]})
+  [''Skipped]
+  allClasses012
+
+data Empty a b c
+
+derive [''Empty] allClasses012
+
+data EmptyWithMode (mode :: EvalModeTag) a b c
+
+derive [''EmptyWithMode] allClasses012
+
 data T mode n a
   = T (GetBool mode) [GetWordN mode n] [a] (GetData mode (T mode n a))
   | TNil
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADTWith
+deriveWith
   ( mempty
       { evalModeConfig =
           [(0, EvalModeConstraints [''EvalModeBV, ''EvalModeBase])],
@@ -146,7 +168,7 @@
 
 newtype X mode = X [GetBool mode]
 
-deriveGADTWith
+deriveWith
   ( mempty
       { evalModeConfig = [(0, EvalModeConstraints [''EvalModeBase])]
       }
@@ -161,7 +183,7 @@
     d :: Maybe Int
   }
 
-deriveGADTWith
+deriveWith
   ( mempty
       { needExtraMergeableUnderEvalMode = True
       }
@@ -171,7 +193,7 @@
 
 data Basic = Basic0 | Basic1 Int | Basic2 String [Int]
 
-deriveGADT [''Basic] allClasses0
+derive [''Basic] allClasses0
 
 data Extra mode n eb sb a where
   Extra ::
@@ -185,7 +207,7 @@
     Extra mode n eb sb a
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADTWith
+deriveWith
   ( mempty
       { evalModeConfig = [(0, EvalModeConstraints [''PartialEvalMode])],
         bitSizePositions = [1],
@@ -238,7 +260,7 @@
     f a ->
     Expr g b
 
-deriveGADT
+derive
   [''Expr]
   [ ''Mergeable,
     ''Mergeable1,
@@ -264,11 +286,11 @@
 instance (Eq1 f) => Eq1 (Expr f) where
   liftEq = undefined
 
-deriveGADT [''Expr] [''Hashable, ''Hashable1]
+derive [''Expr] [''Hashable, ''Hashable1]
 
 data P a b = P a | Q Int
 
-deriveGADT
+derive
   [''P]
   [ ''Mergeable,
     ''Mergeable1,
@@ -321,7 +343,7 @@
 
 infixr 5 :|
 
-deriveGADT
+derive
   [''GGG]
   [ ''Show,
     ''Show1,
@@ -396,7 +418,7 @@
 instance Eq (Ambiguous x) where
   (==) = undefined
 
-deriveGADT
+derive
   [''Ambiguous]
   [ ''AllSyms,
     ''Mergeable,
@@ -415,7 +437,7 @@
       (GetData mode (SimpleMergeableType mode n x))
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADTWith
+deriveWith
   ( mempty
       { evalModeConfig =
           [(0, EvalModeConstraints [''EvalModeBV, ''EvalModeBase])],
@@ -426,3 +448,21 @@
   [''SimpleMergeableType]
   ([''SimpleMergeable, ''UnifiedSimpleMergeable] ++ allClasses0)
 #endif
+
+data Serializable a
+  = Se1 a
+  | Se2 SymBool
+  deriving (Show, Eq)
+
+instance (Arbitrary a) => Arbitrary (Serializable a) where
+  arbitrary = oneof [Se1 <$> arbitrary, Se2 <$> sized bool]
+    where
+      bool n | n <= 0 = do
+        b <- arbitrary
+        oneof [return (con b), return "a", return "b"]
+      bool n = do
+        l <- bool (n `div` 2)
+        r <- bool (n `div` 2)
+        oneof [return (l .|| r), return (l .&& r), return l]
+
+derive [''Serializable] [''Serial, ''Serialize, ''Binary]
diff --git a/test/Grisette/Core/TH/DerivationTest.hs b/test/Grisette/Core/TH/DerivationTest.hs
--- a/test/Grisette/Core/TH/DerivationTest.hs
+++ b/test/Grisette/Core/TH/DerivationTest.hs
@@ -13,6 +13,9 @@
 
 module Grisette.Core.TH.DerivationTest (derivationTest) where
 
+import Data.Bytes.Get (runGetS)
+import Data.Bytes.Put (runPutS)
+import Data.Bytes.Serial (Serial (deserialize, serialize))
 import Data.Functor.Classes (showsPrec1, showsPrec2)
 import qualified Data.Text as T
 import GHC.TypeLits (KnownNat, type (<=))
@@ -37,6 +40,7 @@
 import Grisette.Core.TH.DerivationData
   ( Extra (Extra),
     GGG,
+    Serializable,
     gggToVVV,
     replaceVVVShown,
   )
@@ -155,6 +159,11 @@
           symCompare1 g1 g2 === (g1 `symCompare` g2),
       testProperty "GADT SymOrd2 and SymOrd are consistent" $
         \(g1 :: GGG (GGG Int String) [Int]) g2 ->
-          symCompare2 g1 g2 === (g1 `symCompare` g2)
+          symCompare2 g1 g2 === (g1 `symCompare` g2),
+      testProperty "Serialize" $ do
+        \(s :: Serializable Int) ->
+          let bs = runPutS (serialize s)
+              s' = runGetS deserialize bs
+           in Right s === s'
     ]
       ++ derivationExtraTest
diff --git a/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs b/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs
--- a/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs
+++ b/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs
@@ -244,8 +244,7 @@
   let actual = runStateT (mrgIfPropagatedStrategy (ssymBool "c") a b) (ssymBool "d")
   let expected =
         mrgSingle
-          ( mrgIte (ssymBool "c") ((), ssymBool "x") ((), ssymBool "y")
-          )
+          (mrgIte (ssymBool "c") ((), ssymBool "x") ((), ssymBool "y"))
   unionSize actual @?= 1
   actual @?=~ expected
 
diff --git a/test/Grisette/Lib/Data/FoldableTests.hs b/test/Grisette/Lib/Data/FoldableTests.hs
--- a/test/Grisette/Lib/Data/FoldableTests.hs
+++ b/test/Grisette/Lib/Data/FoldableTests.hs
@@ -154,7 +154,7 @@
               ("mrgMapM_", mrgMapM_, mrgMapM_),
               ("mrgFor_", flip mrgFor_, flip mrgFor_),
               ("mrgForM_", flip mrgForM_, flip mrgForM_)
-              ]
+            ]
           [ testGroup
               name
               [ testCase "semantics" $ do
@@ -187,7 +187,7 @@
           (name, func0, func1) <-
             [ ("mrgSequence_", mrgSequence_, mrgSequence_),
               ("mrgSequenceA_", mrgSequenceA_, mrgSequenceA_)
-              ]
+            ]
           [ testGroup
               name
               [ testCase "semantics" $ do
diff --git a/test/Grisette/Lib/Data/ListTests.hs b/test/Grisette/Lib/Data/ListTests.hs
--- a/test/Grisette/Lib/Data/ListTests.hs
+++ b/test/Grisette/Lib/Data/ListTests.hs
@@ -638,8 +638,7 @@
                     Union [SymInteger]
             let expected =
                   mrgIf
-                    ( aint ./= bint .|| aint ./= cint .|| aint ./= dint
-                    )
+                    (aint ./= bint .|| aint ./= cint .|| aint ./= dint)
                     ( return
                         [ symIte (aint ./= bint) cint bint,
                           symIte (aint ./= bint .|| aint ./= cint) dint cint
diff --git a/test/Grisette/Lib/Data/TraversableTests.hs b/test/Grisette/Lib/Data/TraversableTests.hs
--- a/test/Grisette/Lib/Data/TraversableTests.hs
+++ b/test/Grisette/Lib/Data/TraversableTests.hs
@@ -44,7 +44,7 @@
               ("mrgMapM", mrgMapM, mrgMapM),
               ("mrgFor", flip mrgFor, flip mrgFor),
               ("mrgForM", flip mrgForM, flip mrgForM)
-              ]
+            ]
           return $
             testGroup
               name
@@ -87,7 +87,7 @@
           (name, func0, func1) <-
             [ ("mrgSequenceA", mrgSequenceA, mrgSequenceA),
               ("mrgSequence", mrgSequence, mrgSequence)
-              ]
+            ]
           return $
             testGroup
               name
@@ -140,7 +140,7 @@
                 \f s t -> mrgForAccumM s t f,
                 \f s t -> mrgForAccumM s t f
               )
-              ]
+            ]
           return $
             testGroup
               name
diff --git a/test/Grisette/SymPrim/FPTests.hs b/test/Grisette/SymPrim/FPTests.hs
--- a/test/Grisette/SymPrim/FPTests.hs
+++ b/test/Grisette/SymPrim/FPTests.hs
@@ -482,16 +482,16 @@
             let operand = [fpNaN :: FP32, 1]
             let operands =
                   [ (a, b, c)
-                    | a <- operand,
-                      b <- operand,
-                      c <- operand,
-                      fpIsNaN a || fpIsNaN b || fpIsNaN c
+                  | a <- operand,
+                    b <- operand,
+                    c <- operand,
+                    fpIsNaN a || fpIsNaN b || fpIsNaN c
                   ]
             traverse_ (\(o, r, (a, b, c)) -> SameFPObj (o r a b c) @?= fpNaN) $
               [ (o, r, (a, b, c))
-                | o <- op,
-                  r <- roundingMode,
-                  (a, b, c) <- operands
+              | o <- op,
+                r <- roundingMode,
+                (a, b, c) <- operands
               ],
           testCase "fpAdd" $ do
             let v = 60 :: FP 4 4
diff --git a/test/Grisette/SymPrim/Prim/BVTests.hs b/test/Grisette/SymPrim/Prim/BVTests.hs
--- a/test/Grisette/SymPrim/Prim/BVTests.hs
+++ b/test/Grisette/SymPrim/Prim/BVTests.hs
@@ -149,7 +149,7 @@
                     (Proxy @4)
                     (bitCastTerm @(WordN 2) @(IntN 2) (ssymTerm "a"))
               }
-            ]
+          ]
         return $ testCase name $ do
           let actual = pevalBitCastTerm term
           actual @?= expected,
@@ -193,7 +193,7 @@
                     (Proxy @4)
                     (bitCastTerm @(IntN 2) @(WordN 2) (ssymTerm "a"))
               }
-            ]
+          ]
         return $ testCase name $ do
           let actual = pevalBitCastTerm term
           actual @?= expected,
@@ -411,7 +411,7 @@
                       (Proxy @1)
                       (ssymTerm "a" :: Term (WordN 4))
               }
-            ]
+          ]
         return . testCase name $
           pevalBVSelectTerm ix w term @?= expected,
       testGroup "pevalBVExtendTerm" $ do
@@ -473,7 +473,7 @@
                 bvExtendExpected =
                   bvExtendTerm True (Proxy @6) (ssymTerm "a" :: Term (WordN 2))
               }
-            ]
+          ]
         return . testCase name $
           pevalBVExtendTerm signed pr term @?= expected,
       testGroup "pevalBVConcatTerm" $ do
@@ -494,8 +494,7 @@
                 bvConcatTestExpected =
                   bvConcatTerm
                     (conTerm 29 :: Term (WordN 7))
-                    ( ssymTerm "b" :: Term (WordN 3)
-                    )
+                    (ssymTerm "b" :: Term (WordN 3))
               },
             BVConcatTest
               { bvConcatTestName = "[c1 (s c2)] -> (c1 (s c2))",
@@ -549,8 +548,7 @@
                     (conTerm 3 :: Term (WordN 4))
                     ( bvConcatTerm
                         (ssymTerm "a" :: Term (WordN 4))
-                        ( conTerm 5 :: Term (WordN 3)
-                        )
+                        (conTerm 5 :: Term (WordN 3))
                     )
               },
             BVConcatTest
@@ -710,8 +708,7 @@
                             (ssymTerm "a" :: Term (WordN 4))
                             (conTerm 83 :: Term (WordN 8))
                         )
-                        ( ssymTerm "b" :: Term (WordN 4)
-                        )
+                        (ssymTerm "b" :: Term (WordN 4))
                     )
                     (conTerm 7 :: Term (WordN 4))
               },
@@ -769,8 +766,7 @@
                         (ssymTerm "a" :: Term (WordN 4))
                         ( bvConcatTerm
                             (conTerm 87 :: Term (WordN 8))
-                            ( ssymTerm "b" :: Term (WordN 4)
-                            )
+                            (ssymTerm "b" :: Term (WordN 4))
                         )
                     )
               },
@@ -851,8 +847,7 @@
                             (ssymTerm "a" :: Term (WordN 4))
                             (conTerm 5 :: Term (WordN 4))
                         )
-                        ( ssymTerm "b" :: Term (WordN 3)
-                        )
+                        (ssymTerm "b" :: Term (WordN 3))
                     )
               },
             BVConcatTest
@@ -924,7 +919,7 @@
                     (ssymTerm "a" :: Term (WordN 4))
                     (ssymTerm "b" :: Term (WordN 3))
               }
-            ]
+          ]
         return . testCase name $
           pevalBVConcatTerm lhs rhs @?= expected
     ]
diff --git a/test/Grisette/SymPrim/Prim/BitsTests.hs b/test/Grisette/SymPrim/Prim/BitsTests.hs
--- a/test/Grisette/SymPrim/Prim/BitsTests.hs
+++ b/test/Grisette/SymPrim/Prim/BitsTests.hs
@@ -7,6 +7,7 @@
 module Grisette.SymPrim.Prim.BitsTests (bitsTests) where
 
 import Data.Bits (Bits (rotateL, rotateR), FiniteBits)
+import Data.Data (Proxy (Proxy))
 import Grisette (IntN, SupportedPrim, WordN)
 import Grisette.Internal.SymPrim.Prim.Term
   ( PEvalBitwiseTerm
@@ -25,6 +26,9 @@
       ),
     Term,
     andBitsTerm,
+    bvConcatTerm,
+    bvExtendTerm,
+    bvSelectTerm,
     complementBitsTerm,
     conTerm,
     orBitsTerm,
@@ -38,7 +42,7 @@
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit ((@=?))
+import Test.HUnit ((@?=))
 import Test.QuickCheck (Property, discard, ioProperty)
 
 bitsTests :: Test
@@ -51,30 +55,30 @@
             pevalAndBitsTerm
               (conTerm 3 :: Term (WordN 4))
               (conTerm 5)
-              @=? conTerm 1,
+              @?= conTerm 1,
           testCase "On zeroBits" $ do
             pevalAndBitsTerm
               (conTerm 0 :: Term (WordN 4))
               (ssymTerm "a")
-              @=? conTerm 0
+              @?= conTerm 0
             pevalAndBitsTerm
               (ssymTerm "a")
               (conTerm 0 :: Term (WordN 4))
-              @=? conTerm 0,
+              @?= conTerm 0,
           testCase "On all one bits" $ do
             pevalAndBitsTerm
               (conTerm 15 :: Term (WordN 4))
               (ssymTerm "a")
-              @=? ssymTerm "a"
+              @?= ssymTerm "a"
             pevalAndBitsTerm
               (ssymTerm "a")
               (conTerm 15 :: Term (WordN 4))
-              @=? ssymTerm "a",
+              @?= ssymTerm "a",
           testCase "On symbolic" $ do
             pevalAndBitsTerm
               (ssymTerm "a" :: Term (WordN 4))
               (ssymTerm "b")
-              @=? andBitsTerm
+              @?= andBitsTerm
                 (ssymTerm "a" :: Term (WordN 4))
                 (ssymTerm "b" :: Term (WordN 4))
         ],
@@ -84,30 +88,30 @@
             pevalOrBitsTerm
               (conTerm 3 :: Term (WordN 4))
               (conTerm 5)
-              @=? conTerm 7,
+              @?= conTerm 7,
           testCase "On zeroBits" $ do
             pevalOrBitsTerm
               (conTerm 0 :: Term (WordN 4))
               (ssymTerm "a")
-              @=? ssymTerm "a"
+              @?= ssymTerm "a"
             pevalOrBitsTerm
               (ssymTerm "a")
               (conTerm 0 :: Term (WordN 4))
-              @=? ssymTerm "a",
+              @?= ssymTerm "a",
           testCase "On all one bits" $ do
             pevalOrBitsTerm
               (conTerm 15 :: Term (WordN 4))
               (ssymTerm "a")
-              @=? conTerm 15
+              @?= conTerm 15
             pevalOrBitsTerm
               (ssymTerm "a")
               (conTerm 15 :: Term (WordN 4))
-              @=? conTerm 15,
+              @?= conTerm 15,
           testCase "On symbolic" $ do
             pevalOrBitsTerm
               (ssymTerm "a" :: Term (WordN 4))
               (ssymTerm "b")
-              @=? orBitsTerm
+              @?= orBitsTerm
                 (ssymTerm "a" :: Term (WordN 4))
                 (ssymTerm "b" :: Term (WordN 4))
         ],
@@ -117,142 +121,171 @@
             pevalXorBitsTerm
               (conTerm 3 :: Term (WordN 4))
               (conTerm 5)
-              @=? conTerm 6,
+              @?= conTerm 6,
           testCase "On zeroBits" $ do
             pevalXorBitsTerm
               (conTerm 0 :: Term (WordN 4))
               (ssymTerm "a")
-              @=? ssymTerm "a"
+              @?= ssymTerm "a"
             pevalXorBitsTerm
               (ssymTerm "a")
               (conTerm 0 :: Term (WordN 4))
-              @=? ssymTerm "a",
+              @?= ssymTerm "a",
           testCase "On all one bits" $ do
             pevalXorBitsTerm
               (conTerm 15 :: Term (WordN 4))
               (ssymTerm "a")
-              @=? pevalComplementBitsTerm (ssymTerm "a")
+              @?= pevalComplementBitsTerm (ssymTerm "a")
             pevalXorBitsTerm
               (ssymTerm "a")
               (conTerm 15 :: Term (WordN 4))
-              @=? pevalComplementBitsTerm (ssymTerm "a"),
+              @?= pevalComplementBitsTerm (ssymTerm "a"),
           testCase "On single complement" $ do
             pevalXorBitsTerm
               (pevalComplementBitsTerm $ ssymTerm "a" :: Term (WordN 4))
               (ssymTerm "b")
-              @=? pevalComplementBitsTerm (pevalXorBitsTerm (ssymTerm "a") (ssymTerm "b"))
+              @?= pevalComplementBitsTerm (pevalXorBitsTerm (ssymTerm "a") (ssymTerm "b"))
             pevalXorBitsTerm
               (ssymTerm "a" :: Term (WordN 4))
               (pevalComplementBitsTerm $ ssymTerm "b")
-              @=? pevalComplementBitsTerm (pevalXorBitsTerm (ssymTerm "a") (ssymTerm "b")),
+              @?= pevalComplementBitsTerm (pevalXorBitsTerm (ssymTerm "a") (ssymTerm "b")),
           testCase "On both complement" $ do
             pevalXorBitsTerm
               (pevalComplementBitsTerm $ ssymTerm "a" :: Term (WordN 4))
               (pevalComplementBitsTerm $ ssymTerm "b")
-              @=? pevalXorBitsTerm (ssymTerm "a") (ssymTerm "b"),
+              @?= pevalXorBitsTerm (ssymTerm "a") (ssymTerm "b"),
           testCase "On symbolic" $ do
             pevalXorBitsTerm
               (ssymTerm "a" :: Term (WordN 4))
               (ssymTerm "b")
-              @=? xorBitsTerm
+              @?= xorBitsTerm
                 (ssymTerm "a" :: Term (WordN 4))
                 (ssymTerm "b" :: Term (WordN 4))
         ],
       testGroup
         "ComplementBits"
         [ testCase "On concrete" $ do
-            pevalComplementBitsTerm (conTerm 5 :: Term (WordN 4)) @=? conTerm 10,
+            pevalComplementBitsTerm (conTerm 5 :: Term (WordN 4)) @?= conTerm 10,
           testCase "On complement" $ do
-            pevalComplementBitsTerm (pevalComplementBitsTerm (ssymTerm "a") :: Term (WordN 4)) @=? ssymTerm "a",
+            pevalComplementBitsTerm (pevalComplementBitsTerm (ssymTerm "a") :: Term (WordN 4)) @?= ssymTerm "a",
           testCase "On symbolic" $ do
             pevalComplementBitsTerm (ssymTerm "a" :: Term (WordN 4))
-              @=? complementBitsTerm (ssymTerm "a" :: Term (WordN 4))
+              @?= complementBitsTerm (ssymTerm "a" :: Term (WordN 4))
         ],
       testGroup
         "ShiftLeft"
         [ testCase "On concrete" $ do
-            pevalShiftLeftTerm (conTerm 15 :: Term (WordN 4)) (conTerm 2) @=? conTerm 12
-            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm 2) @=? conTerm 12,
+            pevalShiftLeftTerm (conTerm 15 :: Term (WordN 4)) (conTerm 2) @?= conTerm 12
+            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm 2) @?= conTerm 12,
           testCase "shift 0" $ do
-            pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 0) @=? ssymTerm "a"
-            pevalShiftLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 0) @=? ssymTerm "a",
+            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,
+            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)
+              @?= shiftLeftTerm (conTerm 15) (conTerm $ -1)
             pevalShiftLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
-              @=? shiftLeftTerm (conTerm 15) (conTerm $ -8),
+              @?= shiftLeftTerm (conTerm 15) (conTerm $ -8),
           testCase "shift symbolic" $ do
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (ssymTerm "b")
+              @?= shiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (ssymTerm "b"),
+          testCase "shift symbolic by concrete" $ do
             pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
-              @=? shiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2),
+              @?= bvConcatTerm
+                (bvSelectTerm (Proxy @0) (Proxy @2) (ssymTerm "a" :: Term (WordN 4)))
+                (conTerm 0 :: Term (WordN 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
+            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 128)) (conTerm maxBound) @?= conTerm 0
+            pevalShiftLeftTerm (conTerm 15 :: Term (WordN 128)) (conTerm maxBound) @?= conTerm 0
         ],
       testGroup
         "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,
+            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,
+            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",
+            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 (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" $ do
             pevalShiftRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5)
-              @=? shiftRightTerm (ssymTerm "a") (conTerm 5)
+              @?= bvExtendTerm
+                True
+                (Proxy @4)
+                ( bvSelectTerm
+                    (Proxy @3)
+                    (Proxy @1)
+                    (ssymTerm "a" :: Term (IntN 4))
+                )
             pevalShiftRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4)
-              @=? shiftRightTerm (ssymTerm "a") (conTerm 4),
+              @?= bvExtendTerm
+                True
+                (Proxy @4)
+                ( bvSelectTerm
+                    (Proxy @3)
+                    (Proxy @1)
+                    (ssymTerm "a" :: Term (IntN 4))
+                ),
           testCase "shift negative amount is undefined on for IntN" $ do
             pevalShiftRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -1)
-              @=? shiftRightTerm (conTerm 15) (conTerm $ -1)
+              @?= shiftRightTerm (conTerm 15) (conTerm $ -1)
             pevalShiftRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
-              @=? shiftRightTerm (conTerm 15) (conTerm $ -8),
+              @?= shiftRightTerm (conTerm 15) (conTerm $ -8),
           testCase "shift symbolic" $ do
+            pevalShiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (ssymTerm "b")
+              @?= shiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (ssymTerm "b"),
+          testCase "shift symbolic by concrete" $ do
             pevalShiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
-              @=? shiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2),
+              @?= bvConcatTerm
+                (conTerm 0 :: Term (WordN 2))
+                (bvSelectTerm (Proxy @2) (Proxy @2) (ssymTerm "a" :: Term (WordN 4)))
+            pevalShiftRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 2)
+              @?= bvExtendTerm
+                True
+                (Proxy @4)
+                (bvSelectTerm (Proxy @2) (Proxy @2) (ssymTerm "a" :: Term (IntN 4))),
           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
+            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
-            pevalRotateLeftTerm (conTerm 0b10100101 :: Term (WordN 8)) (conTerm 2) @=? conTerm 0b10010110
-            pevalRotateLeftTerm (conTerm 0b10100101 :: Term (IntN 8)) (conTerm 2) @=? conTerm 0b10010110,
+            pevalRotateLeftTerm (conTerm 0b10100101 :: Term (WordN 8)) (conTerm 2) @?= conTerm 0b10010110
+            pevalRotateLeftTerm (conTerm 0b10100101 :: Term (IntN 8)) (conTerm 2) @?= conTerm 0b10010110,
           testCase "rotate 0" $ do
-            pevalRotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 0) @=? ssymTerm "a"
-            pevalRotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 0) @=? ssymTerm "a",
+            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"
+              @?= ssymTerm "a"
             pevalRotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4)
-              @=? ssymTerm "a",
+              @?= 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)
+              @?= rotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 1)
             pevalRotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5)
-              @=? rotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 1),
+              @?= 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)
+              @?= rotateLeftTerm (conTerm 15) (conTerm $ -1)
             pevalRotateLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
-              @=? rotateLeftTerm (conTerm 15) (conTerm $ -8),
+              @?= rotateLeftTerm (conTerm 15) (conTerm $ -8),
           testCase "rotate symbolic" $ do
             pevalRotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
-              @=? rotateLeftTerm (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)
+            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"
@@ -277,29 +310,29 @@
           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",
+            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"
+              @?= ssymTerm "a"
             pevalRotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4)
-              @=? ssymTerm "a",
+              @?= 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)
+              @?= rotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 1)
             pevalRotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5)
-              @=? rotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 1),
+              @?= 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)
+              @?= rotateRightTerm (conTerm 15) (conTerm $ -1)
             pevalRotateRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
-              @=? rotateRightTerm (conTerm 15) (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),
+              @?= 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)
+            pevalRotateRightTerm (conTerm 15 :: Term (IntN 128)) (conTerm maxBound) @?= conTerm (rotateL 15 1)
+            pevalRotateRightTerm (conTerm 15 :: Term (WordN 128)) (conTerm maxBound) @?= conTerm (rotateL 15 1)
         ]
     ]
 
@@ -311,4 +344,4 @@
 concreteSmallRotateRightCorrect _ b | b < 0 = discard
 concreteSmallRotateRightCorrect a b = ioProperty $ do
   pevalRotateRightTerm (conTerm a) (conTerm b)
-    @=? conTerm (rotateR a (fromIntegral b))
+    @?= conTerm (rotateR a (fromIntegral b))
diff --git a/test/Grisette/SymPrim/SomeBVTests.hs b/test/Grisette/SymPrim/SomeBVTests.hs
--- a/test/Grisette/SymPrim/SomeBVTests.hs
+++ b/test/Grisette/SymPrim/SomeBVTests.hs
@@ -484,7 +484,7 @@
                     (UnionSingle $ bv 4 5)
                     (UnionSingle $ bv 5 4)
                 )
-                ]
+              ]
             return $ testCase name $ do
               let actual =
                     mrgIf "cond" (return l) (return r) :: Union SomeIntN
@@ -515,7 +515,7 @@
                     (UnionSingle $ ssymBV 4 "a")
                     (UnionSingle $ ssymBV 5 "b")
                 )
-                ]
+              ]
             return $ testCase name $ do
               let actual =
                     mrgIf "cond" (return l) (return r) :: Union SomeSymIntN
diff --git a/test/Grisette/SymPrim/SymPrimConstraintTests.hs b/test/Grisette/SymPrim/SymPrimConstraintTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/SymPrim/SymPrimConstraintTests.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+
+module Grisette.SymPrim.SymPrimConstraintTests
+  ( symBool,
+    symInteger,
+    symWordN8,
+    symIntN8,
+    symFP32,
+    symAlgReal,
+    someSymWordN,
+    someSymIntN,
+    bool,
+    integer,
+    wordN8,
+    intN8,
+    fp32,
+    algReal,
+    someWordN,
+    someIntN,
+  )
+where
+
+import Grisette
+  ( AlgReal,
+    BasicSymPrim,
+    FP32,
+    IntN8,
+    Prim,
+    SomeSymWordN,
+    SymAlgReal,
+    SymBool,
+    SymFP32,
+    SymIntN8,
+    SymInteger,
+    SymPrim,
+    SymWordN8,
+    WordN8,
+  )
+import Grisette.Internal.SymPrim.SomeBV (SomeIntN, SomeSymIntN, SomeWordN)
+
+data BasicSymPrimType a where
+  BasicSymPrimType :: (BasicSymPrim a) => BasicSymPrimType a
+
+symBool :: BasicSymPrimType SymBool
+symBool = BasicSymPrimType
+
+symInteger :: BasicSymPrimType SymInteger
+symInteger = BasicSymPrimType
+
+symWordN8 :: BasicSymPrimType SymWordN8
+symWordN8 = BasicSymPrimType
+
+symIntN8 :: BasicSymPrimType SymIntN8
+symIntN8 = BasicSymPrimType
+
+symFP32 :: BasicSymPrimType SymFP32
+symFP32 = BasicSymPrimType
+
+symAlgReal :: BasicSymPrimType SymAlgReal
+symAlgReal = BasicSymPrimType
+
+data SymPrimType a where
+  SymPrimType :: (SymPrim a) => SymPrimType a
+
+someSymWordN :: SymPrimType SomeSymWordN
+someSymWordN = SymPrimType
+
+someSymIntN :: SymPrimType SomeSymIntN
+someSymIntN = SymPrimType
+
+data PrimType a where
+  PrimType :: (Prim a) => PrimType a
+
+bool :: PrimType Bool
+bool = PrimType
+
+integer :: PrimType Integer
+integer = PrimType
+
+wordN8 :: PrimType WordN8
+wordN8 = PrimType
+
+intN8 :: PrimType IntN8
+intN8 = PrimType
+
+fp32 :: PrimType FP32
+fp32 = PrimType
+
+algReal :: PrimType AlgReal
+algReal = PrimType
+
+someWordN :: PrimType SomeWordN
+someWordN = PrimType
+
+someIntN :: PrimType SomeIntN
+someIntN = PrimType
diff --git a/test/Grisette/Unified/UnifiedClassesTest.hs b/test/Grisette/Unified/UnifiedClassesTest.hs
--- a/test/Grisette/Unified/UnifiedClassesTest.hs
+++ b/test/Grisette/Unified/UnifiedClassesTest.hs
@@ -32,12 +32,12 @@
     SymWordN,
     Union,
     WordN,
-    deriveGADTWith,
+    deriveWith,
     mrgReturn,
     symAnd,
   )
 import qualified Grisette
-import Grisette.Internal.TH.GADT.Common
+import Grisette.Internal.TH.Derivation.Common
   ( DeriveConfig
       ( bitSizePositions,
         evalModeConfig,
@@ -97,7 +97,7 @@
   | XNil
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADTWith
+deriveWith
   ( mempty
       { evalModeConfig =
           [(0, EvalModeConstraints [''EvalModeBV, ''EvalModeBase])],
diff --git a/test/Grisette/Unified/UnifiedConstructorTest.hs b/test/Grisette/Unified/UnifiedConstructorTest.hs
--- a/test/Grisette/Unified/UnifiedConstructorTest.hs
+++ b/test/Grisette/Unified/UnifiedConstructorTest.hs
@@ -42,11 +42,11 @@
     Union,
     allClasses0,
     allClasses01,
-    deriveGADT,
-    deriveGADTWith,
+    derive,
+    deriveWith,
     mrgReturn,
   )
-import Grisette.Internal.TH.GADT.Common
+import Grisette.Internal.TH.Derivation.Common
   ( DeriveConfig (evalModeConfig, needExtraMergeableUnderEvalMode),
     EvalModeConfig (EvalModeConstraints),
   )
@@ -60,7 +60,7 @@
   | T1
 
 #if MIN_VERSION_base(4,16,0)
-deriveGADTWith
+deriveWith
   ( mempty
       { evalModeConfig = [(0, EvalModeConstraints [''EvalModeBase])],
         needExtraMergeableUnderEvalMode = True
@@ -86,12 +86,12 @@
 
 data TNoMode a = TNoMode0 Bool a (TNoMode a) | TNoMode1
 
-deriveGADT [''TNoMode] allClasses01
+derive [''TNoMode] allClasses01
 makeNamedUnifiedCtor [] ["tNoMode0", "tNoMode1"] ''TNoMode
 
 data TNoArg = TNoArg
 
-deriveGADT [''TNoArg] allClasses0
+derive [''TNoArg] allClasses0
 makePrefixedUnifiedCtor [] "mk" ''TNoArg
 
 #if MIN_VERSION_base(4,16,0)