diff --git a/.github/workflows/ci.dhall b/.github/workflows/ci.dhall
index cc4837a8..f6d57ef9 100644
--- a/.github/workflows/ci.dhall
+++ b/.github/workflows/ci.dhall
@@ -4,12 +4,11 @@ in    haskellCi.generalCi
         haskellCi.matrixSteps
         ( Some
             { ghc =
-              [ haskellCi.GHC.GHC902
+              [ haskellCi.GHC.GHC947
+              , haskellCi.GHC.GHC902
               , haskellCi.GHC.GHC8107
-              , haskellCi.GHC.GHC884
-              , haskellCi.GHC.GHC865
               ]
-            , cabal = [ haskellCi.Cabal.Cabal34 ]
+            , cabal = [ haskellCi.Cabal.Cabal310 ]
             }
         )
         // { on = [ haskellCi.Event.push
diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
index 56beccd2..ae6467e7 100644
--- a/.github/workflows/ci.yaml
+++ b/.github/workflows/ci.yaml
@@ -4,7 +4,7 @@ jobs:
     steps:
       - uses: "actions/checkout@v3"
       - id: setup-haskell-cabal
-        uses: "haskell/actions/setup@v2"
+        uses: "haskell-actions/setup@v2"
         with:
           cabal-version: "${{ matrix.cabal }}"
           enable-stack: false
@@ -17,7 +17,7 @@ jobs:
             cp cabal.project.local.ci cabal.project.local
           fi
       - name: freeze
-        run: cabal freeze
+        run: cabal freeze --enable-tests --enable-benchmarks
       - uses: "actions/cache@v3"
         with:
           key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
@@ -35,12 +35,11 @@ jobs:
     strategy:
       matrix:
         cabal:
-          - '3.4'
+          - '3.10'
         ghc:
+          - '9.4.7'
           - '9.0.2'
           - '8.10.7'
-          - '8.8.4'
-          - '8.6.5'
 name: Haskell CI
 on:
   - push
diff --git a/.github/workflows/ormolu.yaml b/.github/workflows/ormolu.yaml
index f5f14211..a38ea8d2 100644
--- a/.github/workflows/ormolu.yaml
+++ b/.github/workflows/ormolu.yaml
@@ -1,4 +1,5 @@
 # FUTUREWORK: add this to `ci.dhall`?
+# TODO(srk): ^^
 
 name: Ormolu
 on:
@@ -6,18 +7,18 @@ on:
 
 jobs:
   ormolu:
-    runs-on: ubuntu-18.04
+    runs-on: ubuntu-latest
     steps:
-      - uses: "actions/checkout@v1"
+      - uses: "actions/checkout@v3"
 
-      - uses: "actions/setup-haskell@v1.1.4"
+      - uses: "haskell-actions/setup@v2"
         id: setup-haskell-cabal
         with:
           cabal-version: "${{ matrix.cabal }}"
           enable-stack: false
           ghc-version: "${{ matrix.ghc }}"
 
-      - uses: "actions/cache@v2"
+      - uses: "actions/cache@v3"
         name: Cache
         with:
           key: "${{ runner.os }}"
@@ -46,6 +47,6 @@ jobs:
     strategy:
       matrix:
         cabal:
-          - '3.2'
+          - '3.10'
         ghc:
-          - '8.10.1'
+          - '9.4.7'
diff --git a/.gitignore b/.gitignore
index 9d9f548a..f7ee3196 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,6 +10,11 @@
 *.stl
 !tests/golden/*.stl
 *.svg
+*.ascii.stl
+*.asciistl
+*.three.js
+*.threejs
+*.obj
 # Generated by the build process
 cabal.project.local
 Setup
@@ -36,3 +41,8 @@ Examples/example[0-9][0-9]
 /.settings
 /.project
 stack.yaml.lock
+/attic/
+# direnv
+.envrc
+.ghci
+.ghci_history
diff --git a/Graphics/Implicit/Canon.hs b/Graphics/Implicit/Canon.hs
new file mode 100644
index 00000000..c455a172
--- /dev/null
+++ b/Graphics/Implicit/Canon.hs
@@ -0,0 +1,348 @@
+{- ORMOLU_DISABLE -}
+-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
+-- Copyright 2014 2015 2016, 2017, 2018, Julia Longtin (julial@turinglace.com)
+-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
+-- Released under the GNU AGPLV3+, see LICENSE
+
+-- | This module implements canonicalization pass that
+-- * eliminates identities
+-- * merges consecutive transformations like transform . transform into one
+-- * prevents invalid transformations like scaling by zero that would
+--   otherwise result in NaNs down the pipe
+-- * turns degenerate objects into empty space (i.e. circle 0, cube (pure 0))
+
+{-# LANGUAGE Rank2Types #-}
+-- pattern Shared
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Graphics.Implicit.Canon
+  ( canonicalize2
+  , canonicalize3
+  , fmapObj2
+  , fmapObj3
+  , fmapSharedObj
+  , rewriteUntilIrreducible
+  , EqObj((=^=))
+  ) where
+
+import Linear
+  ( V2(V2)
+  , V3(V3)
+  , V4(V4)
+  )
+
+import Prelude
+  ( Bool
+      ( False
+      , True
+      )
+  , Either(Left)
+  , Eq((==))
+  , Maybe(Just)
+  , Num
+      ( (*)
+      , (+)
+      )
+  , Ord((<))
+  , length
+  , ($)
+  , (&&)
+  , (<$>)
+  )
+
+import Graphics.Implicit.Definitions
+  ( ExtrudeMScale
+      ( C1
+      , C2
+      , Fn
+      )
+  , SharedObj
+      ( Complement
+      , DifferenceR
+      , EmbedBoxedObj
+      , Empty
+      , Full
+      , IntersectR
+      , Mirror
+      , Outset
+      , Scale
+      , Shell
+      , Translate
+      , UnionR
+      , WithRounding
+      )
+  , SymbolicObj2
+      ( Circle
+      , Polygon
+      , Rotate2
+      , Shared2
+      , Square
+      , Transform2
+      )
+  , SymbolicObj3
+      ( Cube
+      , Cylinder
+      , Extrude
+      , ExtrudeM
+      , ExtrudeOnEdgeOf
+      , Rotate3
+      , RotateExtrude
+      , Shared3
+      , Sphere
+      , Transform3
+      )
+  , hasZeroComponent
+  )
+import {-# SOURCE #-} Graphics.Implicit.Primitives
+  ( Object(_Shared)
+  , emptySpace
+  , fullSpace
+  )
+
+import Control.Lens
+  ( preview
+  , (#)
+  )
+
+-- | A pattern that abstracts over 'Shared2' and 'Shared3'.
+-- Can't be in hs-boot https://gitlab.haskell.org/ghc/ghc/-/issues/14478
+-- so we duplicate it here
+pattern Shared :: (Object obj f a) => SharedObj obj f a -> obj
+pattern Shared v <- (preview _Shared -> Just v)
+  where
+    Shared v = _Shared # v
+
+-- | Map over @SharedObj@ and its underlying objects
+--
+-- This resembles bimap from Bifunctor but the structure
+-- of SharedObj doesn't allow us to define Bifunctor instance
+-- as we need to map over the first type argument (obj) and not f and a.
+fmapSharedObj
+  :: forall obj f a
+   . (Object obj f a)
+  => (obj -> obj)
+  -> (obj -> obj)
+  -> obj
+  -> obj
+fmapSharedObj _ g (Shared Empty) = g emptySpace
+fmapSharedObj _ g (Shared Full) = g fullSpace
+fmapSharedObj f g (Shared (Complement o)) = g $ Shared $ Complement (f o)
+fmapSharedObj f g (Shared (UnionR r os)) = g $ Shared $ UnionR r $ f <$> os
+fmapSharedObj f g (Shared (DifferenceR r o os)) = g $ Shared $ DifferenceR r (f o) $ f <$> os
+fmapSharedObj f g (Shared (IntersectR r os)) = g $ Shared $ IntersectR r $ f <$> os
+fmapSharedObj f g (Shared (Translate by o)) = g $ Shared $ Translate by (f o)
+fmapSharedObj f g (Shared (Scale by o)) = g $ Shared $ Scale by (f o)
+fmapSharedObj f g (Shared (Mirror by o)) = g $ Shared $ Mirror by (f o)
+fmapSharedObj f g (Shared (Outset by o)) = g $ Shared $ Outset by (f o)
+fmapSharedObj f g (Shared (Shell by o)) = g $ Shared $ Shell by (f o)
+fmapSharedObj _ g (Shared (EmbedBoxedObj fun)) = g $ Shared $ EmbedBoxedObj fun
+fmapSharedObj f g (Shared (WithRounding r o)) = g $ Shared $ WithRounding r (f o)
+fmapSharedObj f _ o = f o
+
+-- | Map over @SymbolicObj2@ and its underlying shared objects
+--
+-- This function is co-recursive with @fmapSharedObj@ to achieve
+-- deep mapping over objects nested in @Shared2@ constructor
+fmapObj2
+  :: (SymbolicObj2 -> SymbolicObj2) -- ^ SymbolicObj2 transformation
+  -> (SymbolicObj3 -> SymbolicObj3) -- ^ SymbolicObj3 transformation
+  -> (forall obj f a . (Object obj f a) => obj -> obj) -- ^ Shared2|3 transformation
+  -> SymbolicObj2
+  -> SymbolicObj2
+fmapObj2 f _ _ (Square v)       = f $ Square v
+fmapObj2 f _ _ (Circle r)       = f $ Circle r
+fmapObj2 f _ _ (Polygon ps)     = f $ Polygon ps
+fmapObj2 f g s (Rotate2 r o)    = f $ Rotate2 r (fmapObj2 f g s o)
+fmapObj2 f g s (Transform2 m o) = f $ Transform2 m (fmapObj2 f g s o)
+fmapObj2 f g s (Shared2 o)      = fmapSharedObj (fmapObj2 f g s) s (Shared2 o)
+
+-- | Map over @SymbolicObj3@ and its underlying shared objects
+--
+-- This function is co-recursive with @fmapSharedObj@ to achieve
+-- deep mapping over objects nested in @Shared3@ constructor
+fmapObj3
+  :: (SymbolicObj3 -> SymbolicObj3) -- ^ SymbolicObj3 transformation
+  -> (SymbolicObj2 -> SymbolicObj2) -- ^ SymbolicObj2 transformation
+  -> (forall obj f a . (Object obj f a) => obj -> obj) -- ^ Shared2|3 transformation
+  -> SymbolicObj3
+  -> SymbolicObj3
+fmapObj3 f _ _ (Cube v) = f $ Cube v
+fmapObj3 f _ _ (Sphere r) = f $ Sphere r
+fmapObj3 f _ _ (Cylinder r1 r2 h) = f $ Cylinder r1 r2 h
+fmapObj3 f g s (Rotate3 q o) = f $ Rotate3 q (fmapObj3 f g s o)
+fmapObj3 f g s (Transform3 m o) = f $ Transform3 m (fmapObj3 f g s o)
+fmapObj3 f g s (Extrude o2 h) = f $ Extrude (fmapObj2 g f s o2) h
+fmapObj3 f g s (ExtrudeM twist sc tr o2 h) = f (ExtrudeM twist sc tr (fmapObj2 g f s o2) h)
+fmapObj3 f g s (RotateExtrude angle tr rot o2) = f (RotateExtrude angle tr rot (fmapObj2 g f s o2))
+fmapObj3 f g s (ExtrudeOnEdgeOf o2a o2b) = f (ExtrudeOnEdgeOf (fmapObj2 g f s o2a) (fmapObj2 g f s o2b))
+fmapObj3 f g s (Shared3 o) = fmapSharedObj (fmapObj3 f g s) s (Shared3 o)
+
+-- | We have to define our own variant of Eq
+-- which compares objects when possible
+-- and returns True when we cannot compare
+-- things like functions
+class EqObj a where
+  (=^=) :: a -> a -> Bool
+
+instance EqObj a => EqObj [a] where
+  []     =^= []     = True
+  (x:xs) =^= (y:ys) = x =^= y && xs =^= ys
+  _xs    =^= _ys    = False
+
+instance (EqObj obj , Eq (f a)) => EqObj (SharedObj obj f a) where
+  Empty =^= Empty = True
+  Full =^= Full = True
+  Complement a =^= Complement b = a =^= b
+  UnionR r1 a =^= UnionR r2 b = r1 == r2 && a =^= b
+  DifferenceR r1 a x =^= DifferenceR r2 b y = r1 == r2 && a =^= b && x =^= y
+  IntersectR r1 a =^= IntersectR r2 b = r1 == r2 && a =^= b
+  Translate x a =^= Translate y b = x == y && a =^= b
+  Scale x a =^= Scale y b = x == y && a =^= b
+  Mirror x a =^= Mirror y b = x == y && a =^= b
+  Outset x a =^= Outset y b = x == y && a =^= b
+  Shell x a =^= Shell y b = x == y && a =^= b
+  EmbedBoxedObj (_fA, a) =^= EmbedBoxedObj (_fB, b) = a == b
+  WithRounding x a =^= WithRounding y b = x == y && a =^= b
+  _ =^= _ = False
+
+instance EqObj ExtrudeMScale where
+  C1 x =^= C1 y = x == y
+  C2 x =^= C2 y = x == y
+  Fn _ =^= Fn _ = True
+  _ =^= _ = False
+
+instance EqObj SymbolicObj2 where
+  Square a =^= Square b = a == b
+  Circle a =^= Circle b = a == b
+  Polygon a =^= Polygon b = a == b
+  Rotate2 x a =^= Rotate2 y b = x == y && a =^= b
+  Transform2 x a =^= Transform2 y b = x == y && a =^= b
+  Shared2 a =^= Shared2 b = a =^= b
+  _ =^= _ = False
+
+instance EqObj SymbolicObj3 where
+  Cube a =^= Cube b = a == b
+  Sphere a =^= Sphere b = a == b
+  Cylinder r1a r2a ha =^= Cylinder r1b r2b hb = r1a == r1b && r2a == r2b && ha == hb
+  Rotate3 x a =^= Rotate3 y b = x == y && a =^= b
+  Transform3 x a =^= Transform3 y b = x == y && a =^= b
+  Extrude a x =^= Extrude b y = x == y && a =^= b
+
+  ExtrudeM (Left twa) ma (Left ta) a (Left ha)
+    =^=
+    ExtrudeM (Left twb) mb (Left tb) b (Left hb)
+      = twa == twb && ma =^= mb && ta == tb && ha == hb && a =^= b
+  ExtrudeM {} =^= ExtrudeM {} = True
+
+  RotateExtrude ra (Left ta) (Left rota) a
+    =^=
+    RotateExtrude rb (Left tb) (Left rotb) b
+      = ra == rb && ta == tb && rota == rotb && a =^= b
+  RotateExtrude {} =^= RotateExtrude {} = True
+
+  ExtrudeOnEdgeOf a x =^= ExtrudeOnEdgeOf b y = a =^= b && x =^= y
+  Shared3 a =^= Shared3 b = a =^= b
+  _ =^= _ = False
+
+-- | Rewrite the object tree until it cannot be reduced further
+rewriteUntilIrreducible
+  :: ( Object obj f a
+     , EqObj obj)
+  => (obj -> obj) -- ^ SymbolicObjN transformation
+  -> obj
+  -> obj
+rewriteUntilIrreducible fRew ast =
+  let
+    step = fRew ast
+  in
+    if step =^= ast
+    then step
+    else rewriteUntilIrreducible fRew step
+
+-- | Canonicalize @SymbolicObj2@ tree
+canonicalize2 :: SymbolicObj2 -> SymbolicObj2
+canonicalize2 = rewriteUntilIrreducible $ fmapObj2 canon2 canon3 canonShared
+
+-- | Canonicalize @SymbolicObj3@ tree
+canonicalize3 :: SymbolicObj3 -> SymbolicObj3
+canonicalize3 = rewriteUntilIrreducible $ fmapObj3 canon3 canon2 canonShared
+
+{-# ANN canon2 "HLint: ignore Use record patterns" #-}
+{-# ANN canon3 "HLint: ignore Use record patterns" #-}
+
+-- | Rewrite rules for @SymbolicObj2@
+canon2 :: SymbolicObj2 -> SymbolicObj2
+canon2 (Square v) | hasZeroComponent v = emptySpace
+canon2 (Circle 0) = emptySpace
+canon2 (Polygon ps) | length ps < 3 = emptySpace
+canon2 (Rotate2 0 o) = o
+-- TOOD(srk): this "fixes" (more like hides) the problem
+-- with polygon under rotation described in #449
+-- so we keep it disabled for now
+-- needs import Data.Fixed (mod') and Prelude (pi)
+-- canon2 (Rotate2 θ o) | θ `mod'` (2*pi) == 0 = o
+
+-- ignore if zeroes, TODO(srk): produce warning
+-- TODO(srk): produce warning and ignore if we get a non-invertible matrix
+canon2 (Transform2
+         (V3 (V3 x _ _)
+             (V3 _ y _)
+             (V3 _ _ _)
+         )
+         o) | hasZeroComponent (V2 x y) = o
+canon2 x = x
+
+-- | Rewrite rules for @SymbolicObj3@
+canon3 :: SymbolicObj3 -> SymbolicObj3
+canon3 (Cube v) | hasZeroComponent v = emptySpace
+canon3 (Sphere 0) = emptySpace
+canon3 (Cylinder 0 _ _) = emptySpace
+canon3 (Extrude _o2 0) = emptySpace
+canon3 (Rotate3 0 o) = o
+canon3 (RotateExtrude 0 _t _r _o) = emptySpace
+canon3 (RotateExtrude _theta _t _r (Shared Empty)) = emptySpace
+-- ignore if zeroes, TODO(srk): produce warning
+-- TODO(srk): produce warning and ignore if we get a non-invertible matrix
+canon3 (Transform3
+         (V4 (V4 x _ _ _)
+             (V4 _ y _ _)
+             (V4 _ _ z _)
+             (V4 _ _ _ _)
+         )
+         o) | hasZeroComponent (V3 x y z) = o
+canon3 x = x
+
+-- | Rewrite rules for @SharedObj@
+canonShared
+  :: forall obj f a
+   . (Object obj f a)
+  => obj
+  -> obj
+canonShared (Shared (Scale 1 o)) = o
+canonShared (Shared (Scale v1 (Shared (Scale v2 o)))) = Shared $ Scale (v1 * v2) o
+canonShared (Shared (Scale _ s@(Shared Empty))) = s
+canonShared (Shared (Scale _ s@(Shared Full))) = s
+-- ignore if zeroes, TODO(srk): produce warning
+canonShared (Shared (Scale s o)) | hasZeroComponent s = o
+canonShared (Shared (Translate 0 o)) = o
+canonShared (Shared (Translate _ s@(Shared Empty))) = s
+canonShared (Shared (Translate _ s@(Shared Full))) = s
+canonShared (Shared (Translate v1 (Shared (Translate v2 o)))) = Shared $ Translate (v1 + v2) o
+
+canonShared (Shared (Mirror _ (Shared Empty))) = emptySpace
+canonShared (Shared (Mirror _ (Shared Full))) = fullSpace
+canonShared (Shared (Outset 0 s)) = s
+canonShared (Shared (Outset 0 (Shared Empty))) = emptySpace
+canonShared (Shared (Outset 0 (Shared Full))) = fullSpace
+canonShared (Shared (Outset v1 (Shared (Outset v2 o)))) = Shared $ Outset (v1 + v2) o
+canonShared (Shared (Shell _ (Shared Full))) = fullSpace
+canonShared (Shared (Shell _ (Shared Empty))) = emptySpace
+canonShared (Shared (Shell _ (Shared Full))) = fullSpace
+canonShared (Shared (UnionR _ [])) = emptySpace
+canonShared (Shared (UnionR _ [s])) = s
+canonShared (Shared (DifferenceR _ s [])) = s
+canonShared (Shared (DifferenceR _ (Shared Empty) _)) = emptySpace
+canonShared (Shared (IntersectR _ [])) = emptySpace
+canonShared (Shared (IntersectR _ [s])) = s
+canonShared x = x
diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs
index 1b093a59..a1096e37 100644
--- a/Graphics/Implicit/Definitions.hs
+++ b/Graphics/Implicit/Definitions.hs
@@ -13,6 +13,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+-- required by makeWrapped
+{-# LANGUAGE TypeOperators #-}
 
 -- Definitions of the types used when modeling, and a few operators.
 module Graphics.Implicit.Definitions (
@@ -70,12 +72,13 @@ module Graphics.Implicit.Definitions (
     toScaleFn,
     isScaleID,
     quaternionToEuler,
+    hasZeroComponent,
     )
 where
 
 import GHC.Generics (Generic)
 
-import Prelude (Ord, Eq, atan2, asin, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac, (&&), isNaN, (||))
+import Prelude (Foldable, Functor(fmap), (.), Num, Ord, Eq, atan2, asin, pi, (>=), signum, abs, (+), (-), RealFloat, (==), ($), flip, Semigroup((<>)), Monoid (mempty), Double, Either(Left, Right), Bool(True, False), (*), (/), fromIntegral, Float, realToFrac, (&&), RealFloat(isNaN), (||), or)
 
 import Graphics.Implicit.FastIntUtil as F (Fastℕ(Fastℕ), fromFastℕ, toFastℕ)
 
@@ -259,7 +262,7 @@ instance (Show obj, Show (f a)) => Show (SharedObj obj f a) where
      Mirror vec obj          -> showCon "mirror"       @| vec @| obj
      Outset r obj            -> showCon "outset"       @| r   @| obj
      Shell r obj             -> showCon "shell"        @| r   @| obj
-     EmbedBoxedObj _         -> showCon "implicit"     @| Blackhole
+     EmbedBoxedObj (_, box)  -> showCon "implicit"     @| Blackhole @| box
      WithRounding r obj      -> showCon "withRounding" @| r   @| obj
 
 ------------------------------------------------------------------------------
@@ -304,7 +307,7 @@ instance Show SymbolicObj2 where
     Circle r         -> showCon "circle"     @| r
     Polygon ps       -> showCon "polygon"    @| ps
     Rotate2 v obj    -> showCon "rotate"     @| v     @| obj
-    Transform2 m obj -> showCon "transform2" @| m     @| obj
+    Transform2 m obj -> showCon "transform"  @| m     @| obj
     Shared2 obj   -> flip showsPrec obj
 
 -- | Semigroup under 'Graphic.Implicit.Primitives.union'.
@@ -355,7 +358,7 @@ instance Show SymbolicObj3 where
     Cylinder h r1 r2 ->
       showCon "cylinder2" @| r1 @| r2 @| h
     Rotate3 qd s -> showCon "rotate3" @| quaternionToEuler qd @| s
-    Transform3 m s -> showCon "transform3" @| show m @| s
+    Transform3 m s -> showCon "transform3" @| m @| s
     Extrude s d2 -> showCon "extrude" @| s @| d2
     ExtrudeM edfdd e ep_ddfdp_dd s edfp_ddd ->
       showCon "extrudeM" @|| edfdd @| e @|| ep_ddfdp_dd @| s @|| edfp_ddd
@@ -412,7 +415,7 @@ isScaleID _ = False
 -- | Convert a 'Quaternion' to its constituent euler angles.
 --
 -- From https://en.wikipedia.org/wiki/Conversion_between_quaternions_and_Euler_angles#Source_code_2
-quaternionToEuler :: RealFloat a => Quaternion a -> (a, a, a)
+quaternionToEuler :: RealFloat a => Quaternion a -> V3 a
 quaternionToEuler (Quaternion w (V3 x y z))=
   let sinr_cosp = 2 * (w * x + y * z)
       cosr_cosp = 1 - 2 * (x * x + y * y)
@@ -424,5 +427,11 @@ quaternionToEuler (Quaternion w (V3 x y z))=
               else asin sinp
       roll = atan2 sinr_cosp cosr_cosp
       yaw = atan2 siny_cosp cosy_cosp
-   in (roll, pitch, yaw)
-
+   in V3 roll pitch yaw
+
+-- | Returns True if any component of a foldable functor is zero
+hasZeroComponent
+    :: (Foldable f, Functor f, Num a, Eq a)
+    => f a
+    -> Bool
+hasZeroComponent =  or . fmap (==0)
diff --git a/Graphics/Implicit/Export/Render/HandleSquares.hs b/Graphics/Implicit/Export/Render/HandleSquares.hs
index 7e6a348c..db6a87b7 100644
--- a/Graphics/Implicit/Export/Render/HandleSquares.hs
+++ b/Graphics/Implicit/Export/Render/HandleSquares.hs
@@ -3,6 +3,8 @@
 -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
 -- Released under the GNU AGPLV3+, see LICENSE
 
+{-# LANGUAGE LambdaCase #-}
+
 module Graphics.Implicit.Export.Render.HandleSquares (mergedSquareTris) where
 
 import Prelude((+), foldMap, (<>), ($), fmap, concat, (.), (==), compare, error, otherwise, concatMap)
@@ -71,15 +73,33 @@ mergedSquareTris sqTris =
         squaresFromTris = [ Sq x y z q | Sq x y z q <- sqTris ]
 
         -- Collect squares that are on the same plane.
-        planeAligned = groupWith (\(Sq basis z _ _) -> (basis,z)) squaresFromTris
+        planeAligned = groupWith
+          (\case
+            (Sq basis z _ _) -> (basis,z)
+            (Tris _) -> error "Unexpected Tris"
+          ) squaresFromTris
+
         -- For each plane:
         -- Select for being the same range on X and then merge them on Y
         -- Then vice versa.
         joined :: [[TriSquare]]
         joined = fmap
-            ( concatMap joinXaligned . groupWith (\(Sq _ _ xS _) -> xS)
-            . concatMap joinYaligned . groupWith (\(Sq _ _ _ yS) -> yS)
-            . concatMap joinXaligned . groupWith (\(Sq _ _ xS _) -> xS))
+            ( concatMap joinXaligned . groupWith
+                (\case
+                  (Sq _ _ xS _) -> xS
+                  (Tris _) -> error "Unexpected Tris"
+                )
+            . concatMap joinYaligned . groupWith
+                (\case
+                  (Sq _ _ _ yS) -> yS
+                  (Tris _) -> error "Unexpected Tris"
+                )
+            . concatMap joinXaligned . groupWith
+                (\case
+                  (Sq _ _ xS _) -> xS
+                  (Tris _) -> error "Unexpected Tris"
+                )
+            )
             planeAligned
         -- Merge them back together, and we have the desired reult!
         finishedSquares = concat joined
@@ -94,7 +114,10 @@ joinXaligned :: [TriSquare] -> [TriSquare]
 joinXaligned quads@((Sq b z xS _):_) =
     let
         orderedQuads = sortBy
-            (\(Sq _ _ _ (V2 ya _)) (Sq _ _ _ (V2 yb _)) -> compare ya yb)
+            (\i j -> case (i, j) of
+                (Sq _ _ _ (V2 ya _), Sq _ _ _ (V2 yb _)) -> compare ya yb
+                _ -> error "Unexpected Tris"
+            )
             quads
         mergeAdjacent (pres@(Sq _ _ _ (V2 y1a y2a)) : next@(Sq _ _ _ (V2 y1b y2b)) : others)
           | y2a == y1b = mergeAdjacent (Sq b z xS (V2 y1a y2b) : others)
@@ -110,7 +133,10 @@ joinYaligned :: [TriSquare] -> [TriSquare]
 joinYaligned quads@((Sq b z _ yS):_) =
     let
         orderedQuads = sortBy
-            (\(Sq _ _ (V2 xa _) _) (Sq _ _ (V2 xb _) _) -> compare xa xb)
+            (\i j -> case (i, j) of
+                (Sq _ _ (V2 xa _) _, Sq _ _ (V2 xb _) _) -> compare xa xb
+                _ -> error "Unexpected Tris"
+            )
             quads
         mergeAdjacent (pres@(Sq _ _ (V2 x1a x2a) _) : next@(Sq _ _ (V2 x1b x2b) _) : others)
           | x2a == x1b = mergeAdjacent (Sq b z (V2 x1a x2b) yS : others)
diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs
index 700eac25..811988fd 100644
--- a/Graphics/Implicit/Export/SymbolicFormats.hs
+++ b/Graphics/Implicit/Export/SymbolicFormats.hs
@@ -112,7 +112,7 @@ buildShared (WithRounding r obj) | r == 0 = build obj
 
 buildShared(UnionR _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
 buildShared(IntersectR _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
-buildShared(DifferenceR _ _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
+buildShared(DifferenceR {}) = error "cannot provide roundness when exporting openscad; unsupported in target format."
 buildShared(Outset _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
 buildShared(Shell _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
 buildShared(EmbedBoxedObj _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
@@ -133,7 +133,7 @@ buildS3 (Cylinder h r1 r2) = callNaked "cylinder" [
                              , bf h
                              ] []
 buildS3 (Rotate3 q obj) =
-  let (x,y,z) = quaternionToEuler q
+  let (V3 x y z) = quaternionToEuler q
    in call "rotate" [bf (rad2deg x), bf (rad2deg y), bf (rad2deg z)] [buildS3 obj]
 
 buildS3 (Transform3 m obj) =
@@ -178,11 +178,10 @@ buildS2 (Rotate2 r obj)     = call "rotate" [bf (rad2deg r)] [buildS2 obj]
 
 buildS2 (Transform2 m obj) =
     let toM44 (V3 (V3 a b c) (V3 d e f) (V3 g h i)) =
-          (V4 (V4 a b c 0)
-              (V4 d e f 0)
-              (V4 g h i 0)
-              (V4 0 0 0 1)
-          )
+          V4 (V4 a b c 0)
+             (V4 d e f 0)
+             (V4 g h i 0)
+             (V4 0 0 0 1)
     in
     call "multmatrix"
       ((\x -> "["<>x<>"]") . fold . intersperse "," . fmap bf . toList <$> toList (toM44 m))
diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs b/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs
index d1ceb2cf..5ed3e9e9 100644
--- a/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs
+++ b/Graphics/Implicit/ExtOpenScad/Eval/Expr.hs
@@ -3,10 +3,6 @@
 -- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
 -- Released under the GNU AGPLV3+, see LICENSE
 
--- allow us to specify what package to import what module from.
--- We don't actually care, but when we compile our haskell examples, we do.
-{-# LANGUAGE PackageImports #-}
-
 -- Allow us to use string literals for Text
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -130,7 +126,7 @@ evalExpr' (Var (Symbol name)) = do
   Input (VarLookup varlookup) spos <- ask
   (ExprState namestack) <- get
   let v = lookup (Symbol name) varlookup
-      n = elem (unpack name) namestack
+      n = unpack name `elem` namestack
   case (v, n) of
     (_, True) -> pure $ \l ->
       let m = foldr
@@ -190,4 +186,4 @@ evalExpr' (LamE pats fexpr) = do
             Just xs -> f (xss <> xs)
             Nothing -> OError "Pattern match failed"
     fval <- evalExpr' fexpr
-    pure $ foldr ($) fval fparts
\ No newline at end of file
+    pure $ foldr ($) fval fparts
diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs b/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs
index e3e5f731..5c5efd7c 100644
--- a/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs
+++ b/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs
@@ -85,6 +85,7 @@ computation A2 =
 --
 --  We consider it to be a list of computables which
 --  are in turn StatementI s.
+{-# ANN suite "HLint: ignore Functor law" #-}
 suite :: GenParser Char st [StatementI]
 suite = (
     removeNoOps . (:[]) <$> computation A1
diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs
index d69aa9e3..7c88de08 100644
--- a/Graphics/Implicit/ExtOpenScad/Primitives.hs
+++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs
@@ -554,8 +554,8 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \_ children -> do
 -- This is a shim for scad, which expects this function to operate in degrees.
 rotateExtrudeDegrees
     :: ℝ                     -- Angle to sweep to (in degs)
-    -> (Either ℝ2 (ℝ -> ℝ2)) -- translate
-    -> (Either ℝ  (ℝ -> ℝ )) -- rotate
+    -> Either ℝ2 (ℝ -> ℝ2)   -- translate
+    -> Either ℝ  (ℝ -> ℝ )   -- rotate
     -> SymbolicObj2          -- object to extrude
     -> SymbolicObj3
 rotateExtrudeDegrees totalRot translateArg rotateArg =
diff --git a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs
index b1f08ab1..0ee1d8f1 100644
--- a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs
+++ b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs
@@ -8,8 +8,6 @@
 
 {-# LANGUAGE ScopedTypeVariables #-}
 
-{-# LANGUAGE TypeSynonymInstances #-}
-
 -- Allow us to use string literals for Text
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE InstanceSigs #-}
@@ -84,7 +82,7 @@ instance OTypeMirror Text where
     fromOObj (OString str) = Just str
     fromOObj _ = Nothing
     toOObj :: Text -> OVal
-    toOObj a = OString a
+    toOObj = OString
 
 instance (OTypeMirror a) => OTypeMirror (Maybe a) where
     fromOObj a = Just $ fromOObj a
@@ -170,8 +168,8 @@ oTypeStr (OList          _ ) = "List"
 oTypeStr (OString        _ ) = "String"
 oTypeStr (OFunc          _ ) = "Function"
 oTypeStr (OIO            _ ) = "IO"
-oTypeStr (OUModule   _ _ _ ) = "User Defined Module"
-oTypeStr (ONModule   _ _ _ ) = "Built-in Module"
+oTypeStr (OUModule {}      ) = "User Defined Module"
+oTypeStr (ONModule {}      ) = "Built-in Module"
 oTypeStr (OVargsModule _ _ ) = "VargsModule"
 oTypeStr (OError         _ ) = "Error"
 oTypeStr (OObj2          _ ) = "2D Object"
diff --git a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs
index e73b9f68..6b09ed8b 100644
--- a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs
+++ b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs
@@ -75,4 +75,4 @@ warnC = addMessage Warning
 
 -- Get the ScadOpts from the Reader in ImplicitCadM
 scadOptions :: StateC ScadOpts
-scadOptions = ask
\ No newline at end of file
+scadOptions = ask
diff --git a/Graphics/Implicit/MathUtil.hs b/Graphics/Implicit/MathUtil.hs
index 1e80c9b4..0574f2b7 100644
--- a/Graphics/Implicit/MathUtil.hs
+++ b/Graphics/Implicit/MathUtil.hs
@@ -52,7 +52,7 @@ rmax ::
     -> ℝ  -- ^ first number to round maximum
     -> ℝ  -- ^ second number to round maximum
     -> ℝ  -- ^ resulting number
-rmax r x y = if abs (x-y) < r && r /= 0
+rmax r x y = if r /= 0 && abs (x-y) < r
                 then y - r*sin(pi/4-asin((x-y)/r/sqrt 2)) + r
                 else max x y
 
@@ -64,7 +64,7 @@ rmin ::
     -> ℝ  -- ^ first number to round minimum
     -> ℝ  -- ^ second number to round minimum
     -> ℝ  -- ^ resulting number
-rmin r x y = if abs (x-y) < r && r /= 0
+rmin r x y = if r /= 0 && abs (x-y) < r
     then y + r*sin(pi/4+asin((x-y)/r/sqrt 2)) - r
     else min x y
 
diff --git a/Graphics/Implicit/ObjectUtil/GetBox2.hs b/Graphics/Implicit/ObjectUtil/GetBox2.hs
index 9bfd1c61..a86c5459 100644
--- a/Graphics/Implicit/ObjectUtil/GetBox2.hs
+++ b/Graphics/Implicit/ObjectUtil/GetBox2.hs
@@ -36,8 +36,8 @@ getBox2 (Rotate2 θ symbObj) =
      in pointsBox $ fmap rotate $ corners $ getBox2 symbObj
 getBox2 (Transform2 m symbObj) =
     let box = getBox2 symbObj
-        augment (V2 x y) = (V3 x y 1)
-        normalize (V3 x y w) = (V2 (x/w) (y/w))
+        augment (V2 x y) = V3 x y 1
+        normalize (V3 x y w) = V2 (x/w) (y/w)
      in pointsBox $ normalize . (m Linear.!*) . augment <$> corners box
 getBox2 (Shared2 obj) = getBoxShared obj
 
diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs b/Graphics/Implicit/ObjectUtil/GetImplicit2.hs
index 2d976efd..293f0386 100644
--- a/Graphics/Implicit/ObjectUtil/GetImplicit2.hs
+++ b/Graphics/Implicit/ObjectUtil/GetImplicit2.hs
@@ -69,8 +69,8 @@ getImplicit2 ctx (Transform2 m symbObj) =
     \vin ->
     let
         obj = getImplicit2 ctx symbObj
-        augment (V2 x y) = (V3 x y 1)
-        normalize (V3 x y w) = (V2 (x/w) (y/w))
+        augment (V2 x y) = V3 x y 1
+        normalize (V3 x y w) = V2 (x/w) (y/w)
     in
-        obj $ (normalize . ((Linear.inv33 m) Linear.!*) . augment $ vin)
+        obj (normalize . (Linear.inv33 m Linear.!*) . augment $ vin)
 getImplicit2 ctx (Shared2 obj) = getImplicitShared ctx obj
diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs
index 154b7134..04a2b338 100644
--- a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs
+++ b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs
@@ -41,7 +41,7 @@ getImplicit3 _ (Cylinder h r1 r2) = \(V3 x y z) ->
 getImplicit3 ctx (Rotate3 q symbObj) =
     getImplicit3 ctx symbObj . Linear.rotate (Linear.conjugate q)
 getImplicit3 ctx (Transform3 m symbObj) =
-    getImplicit3 ctx symbObj . Linear.normalizePoint . ((Linear.inv44 m) Linear.!*) . Linear.point
+    getImplicit3 ctx symbObj . Linear.normalizePoint . (Linear.inv44 m Linear.!*) . Linear.point
 -- 2D Based
 getImplicit3 ctx (Extrude symbObj h) =
     let
diff --git a/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs b/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
index d02e8286..b4d63f9d 100644
--- a/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
+++ b/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
@@ -51,12 +51,8 @@ getImplicitShared _ Empty = const infty
 getImplicitShared _ Full = const $ -infty
 getImplicitShared ctx (Complement symbObj) =
   negate . getImplicit' ctx symbObj
-getImplicitShared ctx (UnionR _ []) =
-  getImplicitShared @obj ctx Empty
 getImplicitShared ctx (UnionR r symbObjs) = \p ->
   rminimum r $ fmap (flip (getImplicit' ctx) p) symbObjs
-getImplicitShared ctx (IntersectR _ []) =
-  getImplicitShared @obj ctx Full
 getImplicitShared ctx (IntersectR r symbObjs) = \p ->
   rmaximum r $ fmap (flip (getImplicit' ctx) p) symbObjs
 getImplicitShared ctx (DifferenceR _ symbObj []) =
diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
index 52f01b74..ae9bfa52 100644
--- a/Graphics/Implicit/Primitives.hs
+++ b/Graphics/Implicit/Primitives.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- A module exporting all of the primitives, and some operations on them.
 module Graphics.Implicit.Primitives (
@@ -50,11 +51,11 @@ module Graphics.Implicit.Primitives (
                                      withRounding,
                                      _Shared,
                                      pattern Shared,
-                                     Object
-                                    ) where
+                                     Object(Space, canonicalize)) where
 
-import Prelude(Applicative, Eq, Num, abs, (<), otherwise, id, Num, (+), (-), (*), (/), (.), negate, Bool(True, False), Maybe(Just, Nothing), Either, fmap, ($), (**), sqrt)
+import Prelude(Applicative, Eq, Foldable, Num, abs, (<), otherwise, Num, (+), (-), (*), (/), (.), negate, Bool(True, False), Maybe(Just, Nothing), Either, fmap, ($), (**), sqrt)
 
+import Graphics.Implicit.Canon (canonicalize2, canonicalize3)
 import Graphics.Implicit.Definitions (ObjectContext, ℝ, ℝ2, ℝ3, Box2,
                                       SharedObj(Empty,
                                                 Full,
@@ -98,13 +99,13 @@ import Graphics.Implicit.MathUtil   (pack)
 import Graphics.Implicit.ObjectUtil (getBox2, getBox3, getImplicit2, getImplicit3)
 import Linear (M33, M44, V2(V2),V3(V3), axisAngle, Quaternion)
 import Control.Lens (prism', Prism', preview, (#))
+import Data.Kind (Type)
 
 -- $ 3D Primitives
 
 sphere ::
     ℝ                  -- ^ Radius of the sphere
     -> SymbolicObj3    -- ^ Resulting sphere
-
 sphere = Sphere
 
 -- | A rectangular prism
@@ -112,7 +113,6 @@ rect3
     :: ℝ3             -- ^ Bottom.. corner
     -> ℝ3             -- ^ Top right... corner
     -> SymbolicObj3   -- ^ Resuting cube
-
 rect3 xyz1 xyz2 = translate xyz1 $ Cube $ xyz2 - xyz1
 
 -- | A cube
@@ -130,8 +130,6 @@ cylinder2 ::
     -> ℝ                -- ^ Second radius of the cylinder
     -> ℝ                -- ^ Height of the cylinder
     -> SymbolicObj3     -- ^ Resulting cylinder
-
-cylinder2 _ _ 0 = emptySpace  -- necessary to prevent a NaN
 cylinder2 r1 r2 h
   | h < 0 = mirror (V3 0 0 1) $ cylinder2 r1 r2 (abs h)
   | otherwise = Cylinder h r1 r2
@@ -140,14 +138,13 @@ cylinder ::
     ℝ                   -- ^ Radius of the cylinder
     -> ℝ                -- ^ Height of the cylinder
     -> SymbolicObj3     -- ^ Resulting cylinder
-
 cylinder r = cylinder2 r r
 
 cone ::
     ℝ                   -- ^ Radius of the cylinder
     -> ℝ                -- ^ Height of the cylinder
     -> SymbolicObj3     -- ^ Resulting cylinder
-cone r h = cylinder2 0 r h
+cone = cylinder2 0
 
 torus :: ℝ -> ℝ -> SymbolicObj3 -- Major radius, minor radius
 torus r1 r2 = implicit
@@ -166,7 +163,6 @@ ellipsoid a b c = implicit
 circle ::
     ℝ               -- ^ radius of the circle
     -> SymbolicObj2 -- ^ resulting circle
-
 circle   = Circle
 
 -- | A rectangle
@@ -174,7 +170,6 @@ rect
     :: ℝ2           -- ^ Bottom left corner
     -> ℝ2           -- ^ Top right corner
     -> SymbolicObj2 -- ^ Resulting square
-
 rect xy1 xy2 = translate xy1 $ Square $ xy2 - xy1
 
 -- | A square
@@ -189,7 +184,6 @@ square True  size = translate (fmap (negate . (/ 2)) size) $ Square size
 polygon
     :: [ℝ2]          -- ^ Verticies of the polygon
     -> SymbolicObj2  -- ^ Resulting polygon
-
 polygon = Polygon
 
 -- $ Shared Operations
@@ -202,10 +196,16 @@ polygon = Polygon
 class ( Applicative f
       , Eq a
       , Eq (f a)
+      , Foldable f
       , Num a
       , Num (f a))
       => Object obj f a | obj -> f a
       where
+
+    -- | Type representing a space this object belongs to.
+    -- V3 for 3D objects, V2 for 2D
+    type Space obj :: Type -> Type
+
     -- | A 'Prism'' for including 'SharedObj's in @obj@. Prefer using 'Shared'
     -- instead of this.
     _Shared :: Prism' obj (SharedObj obj f a)
@@ -221,6 +221,10 @@ class ( Applicative f
         -> obj         -- ^ Object to get implicit function of
         -> (f a -> a)  -- ^ Implicit function
 
+    -- | Canonicalization function used to rewrite / normalize
+    -- abstract syntax tree representing an object
+    canonicalize :: obj -> obj
+
 -- | Get the implicit function for an object
 getImplicit
     :: Object obj f a
@@ -240,10 +244,6 @@ translate
     => f a  -- ^ Vector to translate by
     -> obj  -- ^ Object to translate
     -> obj  -- ^ Resulting object
-translate 0 s = s
-translate _ s@(Shared Empty) = s
-translate _ s@(Shared Full) = s
-translate v1 (Shared (Translate v2 s)) = translate (v1 + v2) s
 translate v s = Shared $ Translate v s
 
 -- | Scale an object
@@ -252,9 +252,6 @@ scale
     => f a  -- ^ Amount to scale by
     -> obj  -- ^ Object to scale
     -> obj  -- ^ Resulting scaled object
-scale 1 s = s
-scale _ s@(Shared Empty) = s
-scale v1 (Shared (Scale v2 s)) = scale (v1 * v2) s
 scale v s = Shared $ Scale v s
 
 -- | Complement an Object
@@ -288,7 +285,6 @@ fullSpace = Shared Full
 -- the current object-rounding value set in 3D will not apply to extruded 2D
 -- shapes.
 withRounding :: Object obj f a => ℝ -> obj -> obj
-withRounding 0 = id
 withRounding r = Shared . WithRounding r
 
 -- | Mirror an object across the hyperplane whose normal is a given
@@ -298,8 +294,6 @@ mirror
     => f a  -- ^ Vector defining the hyperplane
     -> obj  -- ^ Object to mirror
     -> obj  -- ^ Resulting object
-mirror _ s@(Shared Empty) = s
-mirror _ s@(Shared Full) = s
 mirror v s = Shared $ Mirror v s
 
 -- | Outset of an object.
@@ -308,10 +302,6 @@ outset
     => ℝ     -- ^ distance to outset
     -> obj   -- ^ object to outset
     -> obj   -- ^ resulting object
-outset 0 s = s
-outset _ s@(Shared Empty) = s
-outset _ s@(Shared Full) = s
-outset v1 (Shared (Outset v2 s)) = outset (v1 + v2) s
 outset v s = Shared $ Outset v s
 
 -- | Make a shell of an object.
@@ -320,8 +310,6 @@ shell
     => ℝ     -- ^ width of shell
     -> obj   -- ^ object to take shell of
     -> obj   -- ^ resulting shell
-shell _ s@(Shared Empty) = s
-shell _ s@(Shared Full) = s
 shell v s = Shared $ Shell v s
 
 -- | Rounded union
@@ -330,8 +318,6 @@ unionR
     => ℝ      -- ^ The radius (in mm) of rounding
     -> [obj]  -- ^ objects to union
     -> obj    -- ^ Resulting object
-unionR _ [] = Shared Empty
-unionR _ [s] = s
 unionR r ss = Shared $ UnionR r ss
 
 -- | Rounded difference
@@ -341,8 +327,6 @@ differenceR
     -> obj   -- ^ Base object
     -> [obj] -- ^ Objects to subtract from the base
     -> obj   -- ^ Resulting object
-differenceR _ s [] = s
-differenceR _ s@(Shared Empty) _ = s
 differenceR r s ss = Shared $ DifferenceR r s ss
 {-# INLINABLE differenceR #-}
 
@@ -352,8 +336,6 @@ intersectR
     => ℝ     -- ^ The radius (in mm) of rounding
     -> [obj] -- ^ Objects to intersect
     -> obj   -- ^ Resulting object
-intersectR _ [] = Shared Full
-intersectR _ [s] = s
 intersectR r ss = Shared $ IntersectR r ss
 
 implicit
@@ -364,18 +346,22 @@ implicit
 implicit a b = Shared $ EmbedBoxedObj (a, b)
 
 instance Object SymbolicObj2 V2 ℝ where
+  type Space SymbolicObj2 = V2
   _Shared = prism' Shared2 $ \case
     Shared2 x -> Just x
     _         -> Nothing
-  getBox       = getBox2
-  getImplicit' = getImplicit2
+  getBox       = getBox2 . canonicalize
+  getImplicit' ctx = getImplicit2 ctx . canonicalize
+  canonicalize = canonicalize2
 
 instance Object SymbolicObj3 V3 ℝ where
+  type Space SymbolicObj3 = V3
   _Shared = prism' Shared3 $ \case
     Shared3 x -> Just x
     _         -> Nothing
-  getBox       = getBox3
-  getImplicit' = getImplicit3
+  getBox       = getBox3 . canonicalize
+  getImplicit' ctx = getImplicit3 ctx . canonicalize
+  canonicalize = canonicalize3
 
 union :: Object obj f a => [obj] -> obj
 union = unionR 0
@@ -413,9 +399,7 @@ rotateExtrude
     -> Either ℝ  (ℝ -> ℝ )  -- ^ rotate
     -> SymbolicObj2         -- ^ object to extrude
     -> SymbolicObj3
-rotateExtrude 0 _ _ _ = emptySpace
-rotateExtrude _ _ _ (Shared Empty) = emptySpace
-rotateExtrude theta t r obj = RotateExtrude theta t r obj
+rotateExtrude = RotateExtrude
 
 extrudeOnEdgeOf :: SymbolicObj2 -> SymbolicObj2 -> SymbolicObj3
 extrudeOnEdgeOf = ExtrudeOnEdgeOf
@@ -423,7 +407,6 @@ extrudeOnEdgeOf = ExtrudeOnEdgeOf
 -- | Rotate a 3D object via an Euler angle, measured in radians, along the
 -- world axis.
 rotate3 :: ℝ3 -> SymbolicObj3 -> SymbolicObj3
-rotate3 0 = id
 rotate3 (V3 pitch roll yaw)
   = Rotate3
   $ axisAngle (V3 0 0 1) yaw
@@ -442,7 +425,6 @@ rotate3V
     -> ℝ3  -- ^ Axis of rotation
     -> SymbolicObj3
     -> SymbolicObj3
-rotate3V 0 _ = id
 rotate3V w xyz = Rotate3 $ axisAngle xyz w
 
 -- | Transform a 3D object using a 4x4 matrix representing affine transformation
diff --git a/Graphics/Implicit/Primitives.hs-boot b/Graphics/Implicit/Primitives.hs-boot
index fe69ec83..472b9903 100644
--- a/Graphics/Implicit/Primitives.hs-boot
+++ b/Graphics/Implicit/Primitives.hs-boot
@@ -2,12 +2,17 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 
-module Graphics.Implicit.Primitives (Object(getBox, getImplicit'), getImplicit) where
+-- due to GHC 8.7.10 (and lesser) warning about Space
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+
+module Graphics.Implicit.Primitives (Object(getBox, getImplicit', Space, _Shared), getImplicit, emptySpace, fullSpace) where
 
 import Graphics.Implicit.Definitions (ObjectContext, SymbolicObj2, SymbolicObj3, SharedObj, ℝ)
 import Control.Lens (Prism')
-import Prelude (Applicative, Eq, Num)
+import Data.Kind (Type)
+import Prelude (Applicative, Eq, Foldable, Num)
 import Linear (V2, V3)
 
 -- See the non-source version of "Graphics.Implicit.Primitives" for
@@ -15,16 +20,21 @@ import Linear (V2, V3)
 class ( Applicative f
       , Eq a
       , Eq (f a)
+      , Foldable f
       , Num a
-      , Num (f a))
+      , Num (f a)
+      )
       => Object obj f a | obj -> f a
   where
+    type Space obj :: Type -> Type
     _Shared :: Prism' obj (SharedObj obj f a)
     getBox       :: obj -> (f a, f a)
     getImplicit' :: ObjectContext -> obj -> (f a -> a)
+    canonicalize :: obj -> obj
 
 getImplicit :: Object obj f a => obj -> (f a -> a)
 
 instance Object SymbolicObj2 V2 ℝ
 instance Object SymbolicObj3 V3 ℝ
 
+emptySpace, fullSpace :: Object obj f a => obj
diff --git a/cabal.project b/cabal.project
index 11052369..e6fdbadb 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,8 +1 @@
 packages: .
-
--- for GHC9+, until
--- * https://github.com/snapframework/snap-server/issues/141
--- * https://github.com/snapframework/io-streams-haproxy/pull/24
-allow-newer:
-    snap-server:base
-  , io-streams-haproxy:base
diff --git a/cabal.project.local.ci b/cabal.project.local.ci
index 704806fa..b5533ff7 100644
--- a/cabal.project.local.ci
+++ b/cabal.project.local.ci
@@ -1,4 +1,8 @@
 flags: +implicitsnap
 
 package implicit
-  ghc-options: -fspecialise-aggressively -Werror
+  ghc-options:
+    -fspecialise-aggressively
+    -Wunused-packages
+    -Wno-all-missed-specialisations
+    -Werror
diff --git a/default.nix b/default.nix
index 29b7410b..2589f8eb 100644
--- a/default.nix
+++ b/default.nix
@@ -1,4 +1,4 @@
-{ rev ? "c542baa0c894796c92a8173dead027f3b952c22e"
+{ rev ? "679cadfdfed2b90311a247b2d6ef6dfd3d6cab73"
 , withImplicitSnap ? false
 , pkgs ?
     if ((rev == "") || (rev == "default") || (rev == "local"))
diff --git a/implicit.cabal b/implicit.cabal
index 69451d55..9dd23e53 100644
--- a/implicit.cabal
+++ b/implicit.cabal
@@ -98,6 +98,7 @@ Library
 
     Exposed-modules:
                     Graphics.Implicit
+                    Graphics.Implicit.Canon
                     Graphics.Implicit.Definitions
                     Graphics.Implicit.Primitives
                     Graphics.Implicit.Export
@@ -217,6 +218,7 @@ Test-suite test-implicit
                   base,
                   bytestring,
                   hspec,
+                  HUnit,
                   implicit,
                   text,
                   parsec,
@@ -230,6 +232,7 @@ Test-suite test-implicit
                   ParserSpec.Expr
                   ParserSpec.Statement
                   ParserSpec.Util
+                  RewriteSpec
                   ExecSpec.Expr
                   ExecSpec.Util
                   MessageSpec.Message
diff --git a/layout/ormolu.version b/layout/ormolu.version
index 473b31b4..934346d8 100644
--- a/layout/ormolu.version
+++ b/layout/ormolu.version
@@ -1 +1 @@
-0.1.4.1
+0.7.3.0
diff --git a/programs/Benchmark.hs b/programs/Benchmark.hs
index c839be94..f51f2425 100644
--- a/programs/Benchmark.hs
+++ b/programs/Benchmark.hs
@@ -14,13 +14,11 @@ import Criterion.Main (Benchmark, bgroup, bench, nf, nfAppIO, defaultMain)
 
 -- The parts of ImplicitCAD we know how to benchmark.
 import Graphics.Implicit (union, circle, sphere, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1), writeDXF2, writeSVG, writePNG2, writeSTL, writeBinSTL, unionR, translate, difference, extrudeM, rect3, withRounding)
-import Graphics.Implicit.Definitions (defaultObjectContext)
+-- The default object context and variables defining distance and counting in our world.
+import Graphics.Implicit.Definitions (defaultObjectContext, ℝ, Fastℕ)
 import Graphics.Implicit.Export.SymbolicObj2 (symbolicGetContour)
 import Graphics.Implicit.Export.SymbolicObj3 (symbolicGetMesh)
 
--- The variables defining distance and counting in our world.
-import Graphics.Implicit.Definitions (ℝ, Fastℕ)
-
 -- Vectors.
 import Linear(V2(V2), V3(V3))
 
diff --git a/programs/docgen.hs b/programs/docgen.hs
index f8073385..97f0460e 100644
--- a/programs/docgen.hs
+++ b/programs/docgen.hs
@@ -21,7 +21,7 @@ isExample _ = False
 
 -- | Return true if the argument is of type ArgumentDoc.
 isArgument :: DocPart -> Bool
-isArgument (ArgumentDoc _ _ _) = True
+isArgument (ArgumentDoc {}) = True
 isArgument _ = False
 
 -- | Return true if the argument is of type Branch.
@@ -52,8 +52,9 @@ dumpPrimitive (Symbol moduleName) moduleDocList level = do
     else
     do
       putStrLn "#Examples:\n"
-      forM_ examples $ \(ExampleDoc example) ->
-        putStrLn $ "   * `" <> example <> "`"
+      forM_ examples $ \x -> case x of
+        (ExampleDoc example) -> putStrLn $ "   * `" <> example <> "`"
+        _ -> error $ "Unexpected " <> show x <> " in examples"
       putStrLn ""
 
   if null arguments
@@ -70,26 +71,30 @@ dumpPrimitive (Symbol moduleName) moduleDocList level = do
             putStrLn "#Arguments:\n"
           else
             putStrLn "#Shared Arguments:\n"
-      forM_ arguments $ \(ArgumentDoc (Symbol name) posfallback description) ->
-        case (posfallback, description) of
-          (Nothing, "") ->
-            putStrLn $ "   * `" <> unpack name  <> "`"
-          (Just fallback, "") ->
-            putStrLn $ "   * `" <> unpack name <> " = " <> fallback <> "`"
-          (Nothing, _) -> do
-            putStrLn $ "   * `" <> unpack name <> "`"
-            putStrLn $ "     " <> description
-          (Just fallback, _) -> do
-            putStrLn $ "   * `" <> unpack name <> " = " <> fallback <> "`"
-            putStrLn $ "     " <> description
+      forM_ arguments $ \x -> case x of
+        (ArgumentDoc (Symbol name) posfallback description) ->
+          case (posfallback, description) of
+            (Nothing, "") ->
+              putStrLn $ "   * `" <> unpack name  <> "`"
+            (Just fallback, "") ->
+              putStrLn $ "   * `" <> unpack name <> " = " <> fallback <> "`"
+            (Nothing, _) -> do
+              putStrLn $ "   * `" <> unpack name <> "`"
+              putStrLn $ "     " <> description
+            (Just fallback, _) -> do
+              putStrLn $ "   * `" <> unpack name <> " = " <> fallback <> "`"
+              putStrLn $ "     " <> description
+        _ -> error $ "Unexpected " <> show x <> " in arguments"
       putStrLn ""
 
   if null syntaxes
     then
       return ()
     else
-      forM_ syntaxes $ \(Branch syntax) ->
-        dumpPrimitive (Symbol $ pack $ "Syntax " <> show (level+1)) syntax (level+1)
+      forM_ syntaxes $ \x -> case x of
+        (Branch syntax) ->
+          dumpPrimitive (Symbol $ pack $ "Syntax " <> show (level+1)) syntax (level+1)
+        _ -> error $ "Unexpected " <> show x <> " in syntaxes"
 
 -- | Our entrypoint. Generate one document describing all of our primitives.
 main :: IO ()
diff --git a/programs/extopenscad.hs b/programs/extopenscad.hs
index 9a3bc0b8..6a05090a 100644
--- a/programs/extopenscad.hs
+++ b/programs/extopenscad.hs
@@ -184,7 +184,7 @@ run rawargs = do
     let res = fromMaybe (estimateResolution s) (resolution args)
         basename = fst (splitExtension $ inputFile args)
         -- If we don't know the format -- it will be 2D/3D default (stl)
-        posDefExt = fromMaybe "stl" (formatExtension <$> format)
+        posDefExt = maybe "stl" formatExtension format
 
     case (obj2s, obj3s) of
       ([], obj:objs) -> do
diff --git a/tests/ExecSpec/Expr.hs b/tests/ExecSpec/Expr.hs
index 9fbe875e..7c359bf8 100644
--- a/tests/ExecSpec/Expr.hs
+++ b/tests/ExecSpec/Expr.hs
@@ -6,7 +6,7 @@
 module ExecSpec.Expr (exprExec) where
 
 -- Be explicit about what we import.
-import Prelude (($), (==), length, Bool (False), (<=), (&&), (<>), show)
+import Prelude (($), (==), length, null, Bool (False), (<=), (&&), (<>), show)
 
 -- Hspec, for writing specs.
 import Test.Hspec (describe, Spec, it, shouldSatisfy, expectationFailure)
@@ -68,7 +68,7 @@ exprExec = do
       case runExpr "rands(1,2,0)" False of
         (OIO m, _) -> do
           OList l <- m
-          shouldSatisfy l $ \l' -> length l' == 0
+          shouldSatisfy l $ \l' -> null l'
         _ -> expectationFailure "Not an OIO"
       case runExpr "rands(1,1,1)" False of
         (OIO m, _) -> do
diff --git a/tests/ExecSpec/Util.hs b/tests/ExecSpec/Util.hs
index 1118d168..27d6f555 100644
--- a/tests/ExecSpec/Util.hs
+++ b/tests/ExecSpec/Util.hs
@@ -44,4 +44,4 @@ vect :: [ℝ] -> OVal
 vect =  list . map num
 
 io :: IO OVal -> OVal
-io = OIO
\ No newline at end of file
+io = OIO
diff --git a/tests/GoldenSpec/Spec.hs b/tests/GoldenSpec/Spec.hs
index 3e8af85a..5832b174 100644
--- a/tests/GoldenSpec/Spec.hs
+++ b/tests/GoldenSpec/Spec.hs
@@ -4,8 +4,9 @@
 
 module GoldenSpec.Spec (spec) where
 
-import GoldenSpec.Util (golden, goldenAllFormats)
+import GoldenSpec.Util (golden, goldenAllFormats, goldenFormat2)
 import Graphics.Implicit
+import Graphics.Implicit.Export.OutputFormat (OutputFormat (PNG))
 import Prelude
 import Test.Hspec ( describe, Spec )
 import Graphics.Implicit.Primitives (torus, ellipsoid, cone)
@@ -193,4 +194,27 @@ spec = describe "golden tests" $ do
       (C1 1)
       (Left 0)
       (union [circle 10])
-      $ Left 40
\ No newline at end of file
+      $ Left 40
+
+  -- These two should be equal, but internally when sampled at (V2 (-1) 0)
+  -- the sign of the SDF differs yet they both get rendered correctly.
+  let funPoly = polygon [V2 0 0, V2 0 (-0.1), V2 (-2) 0, V2 0 (-1)]
+      rotFunPoly = rotate (2*pi) funPoly
+  --
+  -- > getImplicit funPoly (V2 (-1) 0)
+  -- -4.993761694389224e-2
+  -- > getBox funPoly
+  -- (V2 (-2.0) (-1.0),V2 0.0 0.0)
+  --
+  -- vs
+  --
+  -- > getImplicit rotFunPoly (V2 (-1) 0))
+  -- 4.9937616943891996e-2
+  -- > getBox rotFunPoly
+  -- (V2 (-2.0000000000000004) (-1.0),V2 0.0 4.898587196589413e-16)
+  --
+  -- TODO(srk): investigate, see also #449
+
+  describe "2d" $ do
+    goldenFormat2 PNG "troublesome-polygon" 1 funPoly
+    goldenFormat2 PNG "troublesome-polygon-under-rotation" 1 rotFunPoly
diff --git a/tests/GoldenSpec/Util.hs b/tests/GoldenSpec/Util.hs
index 6550e0b3..5c0c6c71 100644
--- a/tests/GoldenSpec/Util.hs
+++ b/tests/GoldenSpec/Util.hs
@@ -2,17 +2,18 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase   #-}
 
-module GoldenSpec.Util (golden, goldenAllFormats, goldenFormat) where
+module GoldenSpec.Util (golden, goldenAllFormats, goldenFormat, goldenFormat2) where
 
-import Control.Monad (forM_)
+import Control.Monad (forM_, unless)
 import Control.Monad.IO.Class (liftIO)
-import Graphics.Implicit (SymbolicObj3)
-import Graphics.Implicit.Export (export3)
+import Graphics.Implicit (SymbolicObj2, SymbolicObj3)
+import Graphics.Implicit.Export (export2, export3)
 import Graphics.Implicit.Export.OutputFormat (OutputFormat (ASCIISTL), formats3D, formatExtension)
 import Prelude (IO, FilePath, Bool (True, False), String, Double, pure, (==), (>>=), (<>), ($), show)
-import System.Directory (getTemporaryDirectory, doesFileExist)
+import System.Directory (getTemporaryDirectory, doesFileExist, removeFile)
 import System.IO (hClose, openTempFile)
-import Test.Hspec (describe, it, shouldBe, SpecWith)
+import Test.Hspec (describe, it, SpecWith)
+import Test.HUnit (assertFailure)
 import Data.ByteString (readFile, writeFile)
 
 -- | Construct a golden test for rendering the given 'SymbolicObj3' at the
@@ -28,7 +29,7 @@ goldenAllFormats name resolution sym = do
     $ forM_ formats3D
     $ \fmt -> goldenFormat fmt name resolution sym
 
--- | Construct a golden test for rendering the given 'SymbolicObj3' at the
+-- | Construct a golden test for rendering the given 'SymbolicObj2|3' at the
 -- specified resolution. On the first run of this test, it will render the
 -- object and cache the results. Subsequent test runs will compare their result
 -- to the cached one. This is valuable for ensuring mesh generation doesn't
@@ -37,25 +38,64 @@ goldenAllFormats name resolution sym = do
 -- The objects are cached under @tests/golden/@, with the given name. Deleting
 -- this file is sufficient to update the test if changes in the mesh generation
 -- are intended.
-goldenFormat :: OutputFormat -> String -> Double -> SymbolicObj3 -> SpecWith ()
-goldenFormat fmt name resolution sym = it (name <> " (golden, format: " <> show fmt <> ")") $ do
-  (res, cached) <- liftIO $ do
-    temp_fp <- getTemporaryFilePath "golden"
+goldenFormat'
+  :: (   OutputFormat
+      -> Double
+      -> FilePath
+      -> a
+      -> IO ()
+     )
+  -> OutputFormat
+  -> String
+  -> Double
+  -> a
+  -> SpecWith ()
+goldenFormat' exportFn fmt name resolution sym = it (name <> " (golden, format: " <> show fmt <> ")") $ do
+  (okay, goldenFp, tempFp) <- liftIO $ do
+    tempFp <- getTemporaryFilePath "golden"
     -- Output the rendered mesh
-    export3 fmt resolution temp_fp sym
-    !res <- readFile temp_fp
-    let golden_fp = "./tests/golden/" <> name <> "." <> formatExtension fmt
+    exportFn fmt resolution tempFp sym
+    !res <- readFile tempFp
+    let goldenFp = "./tests/golden/" <> name <> "." <> formatExtension fmt
     -- Check if the cached results already exist.
-    doesFileExist golden_fp >>= \case
+    doesFileExist goldenFp >>= \case
       True  -> pure ()
       -- If not, save the mesh we just created in the cache.
-      False -> writeFile golden_fp res
-    !cached <- readFile golden_fp
-    pure (res, cached)
-  -- Finally, ceck if the two meshes are equal.
-  if res == cached
-    then pure ()
-    else False `shouldBe` True
+      False -> writeFile goldenFp res
+    !cached <- readFile goldenFp
+    -- Finally, ceck if the two meshes are equal.
+    if res == cached
+      then do
+        removeFile tempFp
+        pure (True, goldenFp, tempFp)
+      else
+        pure (False, goldenFp, tempFp)
+
+  unless okay
+    $ assertFailure
+    $ "Object doesn't match its golden preimage,"
+    <> " temporary file preserved at "
+    <> tempFp
+    <> " compare with original at "
+    <> goldenFp
+
+-- | Test for @SymbolicObj3@
+goldenFormat
+  :: OutputFormat
+  -> String
+  -> Double
+  -> SymbolicObj3
+  -> SpecWith ()
+goldenFormat = goldenFormat' export3
+
+-- | Test for @SymbolicObj2@
+goldenFormat2
+  :: OutputFormat
+  -> String
+  -> Double
+  -> SymbolicObj2
+  -> SpecWith ()
+goldenFormat2 = goldenFormat' export2
 
 ------------------------------------------------------------------------------
 -- | Get a temporary filepath with the desired extension. On unix systems, this
@@ -71,4 +111,3 @@ getTemporaryFilePath ext = do
   (fp, h) <- openTempFile tempdir "implicit-golden"
   hClose h
   pure $ fp <> "." <> ext
-
diff --git a/tests/Graphics/Implicit/Test/Instances.hs b/tests/Graphics/Implicit/Test/Instances.hs
index f5a286df..7bac9cac 100644
--- a/tests/Graphics/Implicit/Test/Instances.hs
+++ b/tests/Graphics/Implicit/Test/Instances.hs
@@ -5,16 +5,26 @@
 
 {-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE UndecidableInstances   #-}
 {-# LANGUAGE DefaultSignatures      #-}
 {-# LANGUAGE GADTs                  #-}
+{-# LANGUAGE TypeOperators          #-}
+-- type (~)
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+-- Polymorphic makeTestResult
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Graphics.Implicit.Test.Instances (Observe, observe, (=~=)) where
+module Graphics.Implicit.Test.Instances (Observe, observe, (=~=), arbitraryNonZeroV) where
 
-import Prelude (abs, fmap, Bounded, Double, Enum, Show, Ord, Eq, (==), pure, Int, Double, (.), ($), (<), div, (<*>), (<$>), (+), (<>), (<=))
+import Prelude (Applicative, (.), not, abs, fmap, Bool(False, True), Bounded, Double, Integer, fromIntegral, (*), (/), (^), round, Enum, Show(show), unlines, Ord, compare, Eq, (==), pure, RealFloat(isNaN), Int, Double, ($), (<), div, (<*>), (<$>), (+), (<>), (<=))
+#if MIN_VERSION_base(4,17,0)
+import Prelude (type(~))
+#endif
 
 import Graphics.Implicit
     ( square,
@@ -43,7 +53,7 @@ import Graphics.Implicit.Definitions
       SharedObj(Outset, Translate, Scale, UnionR, IntersectR,
                 DifferenceR, Shell, WithRounding) )
 
-import Graphics.Implicit.Primitives ( getImplicit )
+import Graphics.Implicit.Primitives ( getImplicit, Object(Space) )
 
 import qualified Test.QuickCheck
 import Test.QuickCheck
@@ -53,19 +63,60 @@ import Test.QuickCheck
       oneof,
       scale,
       sized,
+      suchThat,
       vectorOf,
       Gen,
       Positive(getPositive),
+      NonZero(getNonZero),
       Property)
 
-import Linear (V2(V2), V3(V3), V4(V4), Quaternion, axisAngle)
+import Linear (V2(V2), V3(V3), V4(V4), M33, det33, M44, det44, Epsilon, nearZero, Quaternion, axisAngle)
 
-data Insidedness = Inside | Outside | Surface
-  deriving (Eq, Ord, Show, Enum, Bounded)
+data Insidedness = Inside | Outside | Surface | NaNFail
+  deriving (Ord, Show, Enum, Bounded)
 
-insidedness :: Double -> Insidedness
+insidedness :: (RealFloat a) => a -> Insidedness
 insidedness 0 = Surface
-insidedness x = if x < 0 then Inside else Outside
+insidedness x | isNaN x = NaNFail
+insidedness x | x < 0 = Inside
+insidedness _ = Outside
+
+-- Explicitely allow matching the three cases
+-- so NaNFail never passes Eq (similar to an actual NaNs
+-- that are never equal)
+instance Eq Insidedness where
+  Inside == Inside = True
+  Outside == Outside = True
+  Surface == Surface = True
+  _ == _ = False
+
+data TestResult obj a = TestResult {
+    trInsidedness   :: Insidedness
+  , trSampledValue  :: a
+  , trSampledObject :: obj
+  , trSampledAt     :: (Space obj) a
+  }
+
+instance
+  ( Show obj
+  , Show a
+  , Show (Space obj a)
+  )
+  => Show (TestResult obj a)
+  where
+  show TestResult{..} = unlines
+    [ ""
+    , "TestResult:"
+    , "  | " <> show trInsidedness
+    , "  | " <> show trSampledObject
+    , "  | Sampled at " <> show trSampledAt <> " returns " <> show trSampledValue
+    ]
+
+instance Eq a => Eq (TestResult obj a) where
+  (==) ta tb = trInsidedness ta == trInsidedness tb
+
+instance Ord a => Ord (TestResult obj a) where
+  compare ta tb = trInsidedness ta `compare` trInsidedness tb
 
 ------------------------------------------------------------------------------
 instance Arbitrary SymbolicObj2 where
@@ -75,7 +126,7 @@ instance Arbitrary SymbolicObj2 where
     then oneof small
     else oneof $
         [ rotate <$> arbitrary <*> decayArbitrary 2
-        , transform <$> arbitrary <*> decayArbitrary 2
+        , transform <$> arbitraryInvertibleM33 <*> decayArbitrary 2
         , Shared2 <$> arbitrary
         ] <> small
     where
@@ -84,7 +135,8 @@ instance Arbitrary SymbolicObj2 where
         , square  <$> arbitrary <*> arbitrary
         , polygon <$> do
             n <- choose (3, 10)
-            vectorOf n arbitrary
+            -- TODO(srk): this is a hack until #449 is solved
+            vectorOf n ((*100) <$> (V2 <$> arbitraryPos <*> arbitraryPos))
         , pure fullSpace
         , pure emptySpace
         ]
@@ -98,7 +150,7 @@ instance Arbitrary SymbolicObj3 where
     else oneof $
         [ rotate3    <$> arbitrary        <*> decayArbitrary 2
         , rotate3V   <$> arbitrary        <*> arbitrary        <*> decayArbitrary 2
-        , transform3 <$> arbitrary        <*> decayArbitrary 2
+        , transform3 <$> arbitraryInvertibleM44 <*> decayArbitrary 2
         , extrude    <$> decayArbitrary 2 <*> arbitraryPos
         , Shared3    <$> arbitrary
         ] <> small
@@ -182,17 +234,65 @@ instance Observe () Double Double
 a =~= b = Test.QuickCheck.property $ \test -> observe test a Test.QuickCheck.=== observe test b
 infix 4 =~=
 
+makeTestResult
+  :: forall obj f a
+   . ( RealFloat a
+     , Object obj f a
+     , Quantizable a
+     , f ~ Space obj
+     )
+  => obj
+  -> Space obj a
+  -> TestResult obj a
+makeTestResult obj sampleAt =
+  let
+    fun = getImplicit obj
+    sampledVal = quantize epsilon $ fun sampleAt
+  in
+    TestResult
+      { trInsidedness = insidedness sampledVal
+      , trSampledValue = sampledVal
+      , trSampledObject = obj
+      , trSampledAt = sampleAt
+      }
+
 ------------------------------------------------------------------------------
 -- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at
 -- all points (up to an error term of 'epsilon')
-instance Observe (ℝ2, ()) Insidedness SymbolicObj2 where
-  observe p = insidedness . observe p . getImplicit
+instance Observe (ℝ2, ()) (TestResult SymbolicObj2 Double) SymbolicObj2 where
+  observe (sampledAt, _) obj = makeTestResult obj sampledAt
 
 ------------------------------------------------------------------------------
 -- | Two 'SymbolicObj3's are the same if their 'getImplicit' functions agree at
 -- all points (up to an error term of 'epsilon')
-instance Observe (ℝ3, ()) Insidedness SymbolicObj3 where
-  observe p = insidedness . observe p . getImplicit
+instance Observe (ℝ3, ()) (TestResult SymbolicObj3 Double) SymbolicObj3 where
+  observe (sampledAt, _) obj = makeTestResult obj sampledAt
+
+------------------------------------------------------------------------------
+-- | The number of decimal points we need to agree to assume two 'Double's are
+-- equal.
+epsilon :: Int
+epsilon = 10
+
+------------------------------------------------------------------------------
+-- | Types which can truncate their decimal points to a certain number of
+-- digits.
+class Quantizable a where
+  quantize
+      :: Int  -- ^ The number of decimal points to keep
+      -> a
+      -> a
+
+instance Quantizable a => Quantizable [a] where
+  quantize n = fmap (quantize n)
+
+instance Quantizable a => Quantizable (b -> a) where
+  quantize n = fmap (quantize n)
+
+instance Quantizable Double where
+  quantize n r =
+    let pow = 10 ^ n :: Double
+    in fromIntegral @Integer (round (r * pow)) / pow
 
 -- | Generate a small list of 'Arbitrary' elements, splitting the current
 -- complexity budget between all of them.
@@ -209,6 +309,43 @@ arbitraryPos = getPositive <$> arbitrary
 arbitraryV3 :: Gen ℝ3
 arbitraryV3 = fmap abs <$> arbitrary
 
+-- | Generate arbitrary vector that has no zero components
+arbitraryNonZeroV
+  :: ( Arbitrary (f (NonZero a))
+     , Applicative f
+     )
+  => Gen (f a)
+arbitraryNonZeroV = fmap getNonZero <$> arbitrary
+
+-- | Generate arbitrary invertible 3x3 matrix, representing
+-- affine transformation matrix in 2D space. The last vector is fixed
+-- to @V3 0 0 1@ so it doesn't result in NaNs when normalized from
+-- homogeneous coordinates.
+--
+-- Inspired by InvertibleM33 from linear-tests package
+-- https://github.com/minimapletinytools/linear-tests/blob/master/src/Linear/Matrix/Arbitrary.hs
+arbitraryInvertibleM33
+  :: ( Arbitrary a
+     , Epsilon a
+     )
+  => Gen (M33 a)
+arbitraryInvertibleM33 =
+  (V3 <$> arbitrary <*> arbitrary <*> pure (V3 0 0 1))
+    `suchThat` (not . nearZero . det33)
+
+-- | Generate arbitrary invertible 4x4 matrix, representing
+-- affine transformation matrix in 3D space. The last vector is fixed
+-- to @V4 0 0 0 1@ so it doesn't result in NaNs when normalized from
+-- homogeneous coordinates.
+arbitraryInvertibleM44
+  :: ( Arbitrary a
+     , Epsilon a
+     )
+  => Gen (M44 a)
+arbitraryInvertibleM44 =
+  (V4 <$> arbitrary <*> arbitrary <*> arbitrary <*> pure (V4 0 0 0 1))
+    `suchThat` (not . nearZero . det44)
+
 -- | Split the complexity budget by a factor of @n@.
 decayArbitrary :: Arbitrary a => Int -> Gen a
 decayArbitrary n = scale (`div` n) arbitrary
diff --git a/tests/Graphics/Implicit/Test/Utils.hs b/tests/Graphics/Implicit/Test/Utils.hs
index 39c516a6..cf5a5301 100644
--- a/tests/Graphics/Implicit/Test/Utils.hs
+++ b/tests/Graphics/Implicit/Test/Utils.hs
@@ -4,6 +4,7 @@ module Graphics.Implicit.Test.Utils (randomGroups) where
 import Prelude (drop, (<*>), (<$>), take, length, pure)
 import Test.QuickCheck ( choose, Gen )
 
+{-# ANN randomGroups "HLint: ignore Redundant <$>" #-}
 randomGroups :: [a] -> Gen [[a]]
 randomGroups [] = pure []
 randomGroups as = do
diff --git a/tests/ImplicitSpec.hs b/tests/ImplicitSpec.hs
index 7a63987d..d998a90a 100644
--- a/tests/ImplicitSpec.hs
+++ b/tests/ImplicitSpec.hs
@@ -9,7 +9,7 @@
 module ImplicitSpec (spec) where
 
 import Prelude (Fractional, fmap, pure, negate, (+),  Show, Monoid, mempty, (*), (/), (<>), (-), (/=), ($), (.), pi, id)
-import Test.Hspec (describe, Spec)
+import Test.Hspec (describe, parallel, Spec)
 import Graphics.Implicit
     ( difference,
       rotate,
@@ -27,26 +27,26 @@ import Graphics.Implicit
       differenceR,
       translate,
       withRounding,
+      unionR,
+      intersectR,
+      extrude,
+      cylinder2,
+      mirror,
       Object )
 import Graphics.Implicit.Primitives (rotateQ)
-import Test.QuickCheck (Arbitrary(arbitrary), suchThat, forAll)
+import Test.QuickCheck (Arbitrary(arbitrary), suchThat, forAll, NonZero)
 import Data.Foldable ( for_ )
 import Test.Hspec.QuickCheck (prop)
 import Linear (V2(V2), V3(V3), V4(V4), (^*))
 import qualified Linear
-import Graphics.Implicit (unionR)
-import Graphics.Implicit (intersectR)
-import Graphics.Implicit (extrude)
-import Graphics.Implicit (cylinder2)
-import Graphics.Implicit (mirror)
-import Graphics.Implicit.Test.Instances (Observe, (=~=))
+import Graphics.Implicit.Test.Instances (Observe, (=~=), arbitraryNonZeroV)
 
 ------------------------------------------------------------------------------
 -- Tests showing equivalencies between algebraic formulations of symbolic
 -- objects, in both 2d and 3d. Equality is observational, based on random
 -- sampling of the underlying 'getImplicit' function.
 spec :: Spec
-spec = do
+spec = parallel $ do
   describe "symbolic obj 2" $ do
     idempotenceSpec  @SymbolicObj2
     identitySpec     @SymbolicObj2
@@ -81,6 +81,7 @@ type TestInfrastructure obj f a test outcome =
   , Show (f a)
   , Arbitrary obj
   , Arbitrary (f a)
+  , Arbitrary (f (NonZero a))
   , Fractional (f a)
   )
 
@@ -139,7 +140,7 @@ inverseSpec = describe "inverses" $ do
       =~= id
 
   prop "scale inverse" $
-    forAll (arbitrary `suchThat` (/= 0)) $ \xyz ->
+    forAll arbitraryNonZeroV $ \xyz ->
       scale @obj xyz . scale (1 / xyz)
       =~= id
 
@@ -248,7 +249,7 @@ transform3dSpec = describe "3d transform" $ do
     =~= translate tr . rotateQ quat
 
   prop "scale"
-    $ forAll (arbitrary `suchThat` (/= 0)) $ \s@(V3 x y z) ->
+    $ forAll arbitraryNonZeroV $ \s@(V3 x y z) ->
     transform3
       (V4 (V4 x 0 0 0)
           (V4 0 y 0 0)
@@ -323,9 +324,11 @@ homomorphismSpec = describe "homomorphism" $ do
     translate @obj xyz2 . translate xyz1
       =~= translate (xyz1 + xyz2)
 
-  prop "scale" $ \xyz1 xyz2 ->
-    scale @obj xyz2 . scale xyz1
-      =~= scale (xyz1 * xyz2)
+  prop "scale" $
+    forAll arbitraryNonZeroV $ \xyz1 ->
+      forAll arbitraryNonZeroV $ \xyz2 ->
+        scale @obj xyz2 . scale xyz1
+          =~= scale (xyz1 * xyz2)
 
   prop "withRounding/unionR" $ \r_obj r_combo ->
     withRounding @obj r_obj . unionR r_combo
diff --git a/tests/Main.hs b/tests/Main.hs
index b5247116..6d862a09 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -25,24 +25,28 @@ import PropertySpec (propSpec)
 
 import qualified GoldenSpec.Spec as Golden
 import qualified ImplicitSpec as Implicit
+import qualified RewriteSpec as Rewrite
 import qualified TesselationSpec as Tesselation
 
 main :: IO ()
 main = hspec $ do
   -- run the golden tests to ensure we haven't broken mesh generation
   describe "golden tests" Golden.spec
-  -- run tests against the expression parsing engine.
-  describe "expression parsing" exprSpec
-  -- and now, against the statement parsing engine.
-  describe "statements parsing" statementSpec
-  -- run tests against the expression execution engine. single statements.
-  describe "expression execution" exprExec
-  -- run tests against the evaluation engine, checking for messages.
-  describe "program execution" programExec
-
-  -- Generate data to be evaluated, and ensure the properties hold.
-  describe "property tests" propSpec
+
+  describe "extopenscad tests" $ do
+    -- run tests against the expression parsing engine.
+    describe "expression parsing" exprSpec
+    -- and now, against the statement parsing engine.
+    describe "statements parsing" statementSpec
+    -- run tests against the expression execution engine. single statements.
+    describe "expression execution" exprExec
+    -- run tests against the evaluation engine, checking for messages.
+    describe "program execution" programExec
+
+    -- Generate data to be evaluated, and ensure the properties hold.
+    describe "property tests" propSpec
 
   Implicit.spec
   Tesselation.spec
+  Rewrite.spec
 
diff --git a/tests/RewriteSpec.hs b/tests/RewriteSpec.hs
new file mode 100644
index 00000000..d212b366
--- /dev/null
+++ b/tests/RewriteSpec.hs
@@ -0,0 +1,203 @@
+{- ORMOLU_DISABLE -}
+-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
+-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
+-- Released under the GNU AGPLV3+, see LICENSE
+
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeApplications #-}
+
+module RewriteSpec (spec) where
+
+import Prelude
+  ( Bool(True)
+  , Double
+  , Eq((==))
+  , Show
+  , flip
+  , id
+  , pure
+  , ($)
+  , (.)
+  )
+
+import qualified Test.Hspec
+import Test.Hspec
+  ( Expectation
+  , Spec
+  , describe
+  , it
+  )
+
+import Linear
+  ( V2(V2)
+  , V3(V3)
+  )
+
+import Graphics.Implicit.Canon
+  ( EqObj((=^=))
+  , canonicalize2
+  , canonicalize3
+  , fmapObj2
+  , fmapObj3
+  , fmapSharedObj
+  , rewriteUntilIrreducible
+  )
+
+import Graphics.Implicit.Definitions
+  ( SharedObj(Translate)
+  , SymbolicObj2(Square)
+  , SymbolicObj3(Cube)
+  )
+
+import Graphics.Implicit.Primitives
+  ( Object
+  , circle
+  , cube
+  , emptySpace
+  , extrude
+  , fullSpace
+  , implicit
+  , pattern Shared
+  , rotate
+  , rotate3
+  , scale
+  , sphere
+  , square
+  , translate
+  )
+
+newtype WrapEq a = WrapEq a
+  deriving Show
+
+instance (EqObj a) => Eq (WrapEq a) where
+  WrapEq a == WrapEq b = a =^= b
+
+-- | shouldBe wrapper so we compare using EqObj
+shouldBe :: (Show a, EqObj a) => a -> a -> Expectation
+shouldBe a b = WrapEq a `Test.Hspec.shouldBe` WrapEq b
+
+-- | Rewrite translations to scale
+testRewShared :: Object obj f a => obj -> obj
+testRewShared (Shared (Translate v o)) = scale v o
+testRewShared x = x
+
+sharedSample :: SymbolicObj2
+sharedSample = translate 1 emptySpace
+
+sharedExpected :: SymbolicObj2
+sharedExpected = scale 1 fullSpace
+
+-- | Rewrite squares to circles
+testRew2 :: SymbolicObj2 -> SymbolicObj2
+testRew2 (Square (V2 x _)) = circle x
+testRew2 x = x
+
+sym2Sample :: SymbolicObj2
+sym2Sample =
+  translate 1
+    . rotate 3
+    $ square True 1
+
+sym2Expected :: SymbolicObj2
+sym2Expected =
+  scale 1
+    . rotate 3.0
+    . scale (-0.5)
+    $ circle 1
+
+-- | Rewrite cubes to spheres
+testRew3 :: SymbolicObj3 -> SymbolicObj3
+testRew3 (Cube (V3 x _ _)) = sphere x
+testRew3 x = x
+
+sym3Sample :: SymbolicObj3
+sym3Sample =
+  translate 1
+    . rotate3 0
+    $ cube True 10
+
+sym3Expected :: SymbolicObj3
+sym3Expected =
+  scale 1
+    . rotate3 0
+    . scale (-5)
+    $ sphere 10
+
+sym32Sample :: SymbolicObj3
+sym32Sample =
+  translate 1
+    . rotate3 0
+    $ extrude sym2Sample 2
+
+sym32Expected :: SymbolicObj3
+sym32Expected =
+  scale 1
+    . rotate3 0
+    $ extrude sym2Expected 2
+
+spec :: Spec
+spec =
+  describe "fmap for objects" $ do
+    describe "fmapSharedObj" $ do
+      it "preserves identity" $
+        fmapSharedObj id id sharedSample `shouldBe` sharedSample
+
+      it "maps over tree" $
+        fmapSharedObj (pure fullSpace) testRewShared sharedSample `shouldBe` sharedExpected
+
+    describe "fmapObj2" $ do
+      it "preserves identity" $
+        fmapObj2 id id id sym2Sample `shouldBe` sym2Sample
+
+      it "testRew2 id testRewShared" $
+        fmapObj2 testRew2 id testRewShared sym2Sample `shouldBe` sym2Expected
+
+    describe "fmapObj3" $ do
+      it "identity" $
+        fmapObj3 id id id sym3Sample `shouldBe` sym3Sample
+
+      it "testRew3 id testRewShared" $
+        fmapObj3 testRew3 id testRewShared sym3Sample `shouldBe` sym3Expected
+
+      it "testRew3 testRew2 testRewShared" $
+        fmapObj3 testRew3 testRew2 testRewShared sym32Sample `shouldBe` sym32Expected
+
+    describe "rewriteUntilIrreducible" $ do
+      describe "terminates" $ do
+        it "simple" $
+          rewriteUntilIrreducible id sym32Sample `shouldBe` sym32Sample
+
+        it "handles implicit" $
+          rewriteUntilIrreducible
+            id
+            (implicit @SymbolicObj2 @V2 @Double (\(V2 x _) -> x) (1, 1))
+          `shouldBe` implicit (\(V2 x _) -> x) (1, 1)
+
+    describe "canonicalize2" $ do
+      let c2 = canonicalize2
+
+      it "eliminates identities" $
+        c2 (translate 0 $ rotate 0 $ circle 1) `shouldBe` circle 1
+
+      it "eliminates identities after merging" $
+        c2 (translate 1 $ scale 0 $ translate (-1) $ circle 1) `shouldBe` circle 1
+
+    describe "canonicalize3" $ do
+      let c3 = canonicalize3
+
+      it "eliminates identities" $
+        c3 (translate 0 $ scale 0 $ sphere 1) `shouldBe` sphere 1
+
+      it "eliminates identities after merging" $
+        c3 (translate 1 $ scale 0 $ translate (-1) $ sphere 1) `shouldBe` sphere 1
+
+      it "handles 2D as well" $
+        c3 (translate 1
+             $ scale 0
+             $ translate (-1)
+             $ flip extrude 1
+               $ translate 1
+               $ scale 0
+               $ translate (-1)
+               $ circle 1
+           ) `shouldBe` extrude (circle 1) 1
diff --git a/tests/TesselationSpec.hs b/tests/TesselationSpec.hs
index 3324fc22..5c1d2cf9 100644
--- a/tests/TesselationSpec.hs
+++ b/tests/TesselationSpec.hs
@@ -1,10 +1,7 @@
 {- ORMOLU_DISABLE -}
-{-# LANGUAGE BangPatterns     #-}
-{-# LANGUAGE DeriveGeneric    #-}
 {-# LANGUAGE ImplicitPrelude  #-}
 {-# LANGUAGE TupleSections    #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns     #-}
 
 module TesselationSpec (spec) where
 
diff --git a/tests/golden/troublesome-polygon-under-rotation.png b/tests/golden/troublesome-polygon-under-rotation.png
new file mode 100644
index 00000000..55e9025c
Binary files /dev/null and b/tests/golden/troublesome-polygon-under-rotation.png differ
diff --git a/tests/golden/troublesome-polygon.png b/tests/golden/troublesome-polygon.png
new file mode 100644
index 00000000..c90ffbc5
Binary files /dev/null and b/tests/golden/troublesome-polygon.png differ