Split the Ast file into multiple sub files.

Make some more changes to the generic implementation of EasySwitchStage.

12 files changed, 1031 insertions, 750 deletions

diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
index 8680790..7ef12da 100644
--- a/src/Language/Fiddle/Ast.hs
+++ b/src/Language/Fiddle/Ast.hs
@@ -1,570 +1,24 @@
 {-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE IncoherentInstances #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Language.Fiddle.Ast where
+module Language.Fiddle.Ast (module X) where
 
+import Data.Coerce
 import Data.Functor.Identity
 import Data.Kind (Type)
 import Data.List.NonEmpty
 import Data.Proxy
 import Data.Text (Text)
 import Data.Traversable
+import Data.Type.Bool
+import Data.Type.Equality
 import Data.Typeable
+import Data.Void (Void, absurd)
 import GHC.Generics
+import qualified GHC.TypeError as TypeError
 import GHC.TypeLits
-
--- The Kind types should have for SyntaxTrees.
---
--- A synatx tree kind should take as parameters, an applicative functor for the
--- first argument. This applicative functor allows errors and warnings to be
--- contained to their deferred regions during compilation, so more errors may be
--- reported an once.
---
--- The second argument is the annotation type. Every syntax tree element has an
--- annotation. When initially parsing, this annotation is a list of comments
--- that came before the element and the source position of the element.
-type SynTreeKind = (Type -> Type) -> Type -> Type
-
--- The Type of number during each stage of compilation. When in the first stage,
--- numbers are just strings like anything else. In later stages, numbers get
--- parsed into actual integers. This makes it easier to process later.
-type family NumberType (a :: Stage) :: Type where
-  NumberType Stage1 = Text
-  NumberType Stage2 = Integer
-  NumberType Stage3 = Integer
-
--- The type that represents an import statement. In the early stages of
--- compilation, this is just a string representing the import path, but in later
--- stages of compilation, this actually gets replaced by an abstract
--- representation of the imported material.
-type family ImportType (stage :: Stage) :: SynTreeKind where
-  ImportType Stage1 = ImportStatement
-  ImportType Stage2 = ImportStatement
-  ImportType Stage3 = ImportStatement
-
--- Type-level constraint to determine if a stage is less than some natural
--- ordinal. Used to bound parts of the AST in multiple stages.
-type StageLessThan stage (n :: Natural) = (CmpNat (StageNumber stage) n ~ LT)
-
--- A Name is multiple identifiers separated by dots. It's the way of namespaces
--- to different packages.
-data Name f a where
-  Name :: NonEmpty (Identifier f a) -> a -> Name f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
--- [[packed, rust: name="field_name"]]
-data Directive f a where
-  Directive :: f (DirectiveBody f a) -> a -> Directive f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data DirectiveBody f a where
-  DirectiveBody :: [DirectiveElement f a] -> a -> DirectiveBody f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data DirectiveElement f a where
-  -- <key>
-  DirectiveElementKey ::
-    Maybe (Identifier f a) -> Identifier f a -> a -> DirectiveElement f a
-  -- (<backend>:)? <key>=<value>
-  DirectiveElementKeyValue ::
-    Maybe (Identifier f a) ->
-    Identifier f a ->
-    DirectiveExpression f a ->
-    a ->
-    DirectiveElement f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data DirectiveExpression f a where
-  DirectiveString :: Text -> a -> DirectiveExpression f a
-  DirectiveNumber :: Text -> a -> DirectiveExpression f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data Directed t f a where
-  Directed :: [Directive f a] -> t f a -> a -> Directed t f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-mapDirected :: (t f a -> t' f a) -> Directed t f a -> Directed t' f a
-mapDirected fn (Directed dr tfa a) = Directed dr (fn tfa) a
-
-mapDirectedM ::
-  (Monad m) => (t f a -> m (t' f a)) -> Directed t f a -> m (Directed t' f a)
-mapDirectedM fn (Directed dr tfa a) = Directed dr <$> fn tfa <*> pure a
-
-asDirected :: (Annotated t) => t f a -> Directed t f a
-asDirected tfa = Directed [] tfa (annot tfa)
-
-undirected :: Directed t f a -> t f a
-undirected (Directed _ tfa _) = tfa
-
--- Stage of compilation. Parts of the AST maybe un unavailable with other stages
--- as compilation simplifies the AST.
-data Stage = Stage1 | Stage2 | Stage3
-  deriving (Typeable)
-
--- Root of the parse tree. Just contains a list of declarations.
-data FiddleUnit (stage :: Stage) (f :: Type -> Type) a where
-  FiddleUnit :: [Directed (FiddleDecl stage) f a] -> a -> FiddleUnit stage f a
-  deriving (Generic, Annotated, Typeable)
-
-deriving instance (Alter (ImportType stage)) => Alter (FiddleUnit stage)
-
--- Just an identifier.
-data Identifier f a = Identifier !Text a
-  deriving (Generic, Annotated, Alter, Typeable)
-
--- Expression.
-data Expression stage f a where
-  -- Just a string. Parsing the number comes in stage2.
-  LitNum :: NumberType stage -> a -> Expression stage f a
-  Var :: Identifier f a -> a -> Expression stage f a
-
--- Wrapper class because using a type family like "ImportType" means I cannot
--- derive classes. I'd rather only derive for this class than have to derive for
--- the whole PackageBody class.
-data ImportTypeWrapper stage f a where
-  ImportTypeWrapper :: ImportType stage f a -> ImportTypeWrapper stage f a
-
-instance (Alter (ImportType stage)) => Alter (ImportTypeWrapper stage) where
-  alter ffn fn (ImportTypeWrapper st) =
-    ImportTypeWrapper <$> alter ffn fn st
-
-data ImportStatement f a where
-  ImportStatement :: Text -> Maybe (ImportList f a) -> a -> ImportStatement f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data ImportList f a where
-  ImportList :: [Identifier f a] -> a -> ImportList f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
--- Top-level declarations.
-data FiddleDecl (stage :: Stage) (f :: Type -> Type) a where
-  {-
-   - An option is a key/value pair.
-   - option <ident> <ident>;
-   -}
-  OptionDecl ::
-    Identifier f a ->
-    Identifier f a ->
-    a ->
-    FiddleDecl stage f a
-  ImportDecl ::
-    ImportType stage f a ->
-    a ->
-    FiddleDecl stage f a
-  UsingDecl ::
-    Name f a -> a -> FiddleDecl stage f a
-  {- Package Statement. Package Name, Package body -}
-  PackageDecl ::
-    Name f a ->
-    f (PackageBody stage f a) ->
-    a ->
-    FiddleDecl stage f a
-  {- location <identifier> = <expr>. -}
-  LocationDecl ::
-    Identifier f a ->
-    Expression stage f a ->
-    a ->
-    FiddleDecl stage f a
-  {- bits <identifier> : <type> -}
-  BitsDecl ::
-    Identifier f a ->
-    BitType stage f a ->
-    a ->
-    FiddleDecl stage f a
-  {- objtype <identifier> : <type> -}
-  ObjTypeDecl ::
-    Identifier f a ->
-    f (ObjTypeBody stage f a) ->
-    a ->
-    FiddleDecl stage f a
-  {- object <ident> at <expr> : <type> -}
-  ObjectDecl ::
-    Identifier f a ->
-    Expression stage f a ->
-    ObjType stage f a ->
-    a ->
-    FiddleDecl stage f a
-  deriving (Generic, Annotated, Typeable)
-
-deriving instance (Alter (ImportType stage)) => Alter (FiddleDecl stage)
-
-data ObjTypeBody (stage :: Stage) (f :: Type -> Type) a where
-  ObjTypeBody ::
-    BodyType f a ->
-    [Directed (ObjTypeDecl stage) f a] ->
-    a ->
-    ObjTypeBody stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data ObjType stage f a where
-  -- { <body> }
-  -- Anonymous types are only allowed in stage1. Stage2 should have them be
-  -- de-anonymized.
-  AnonymousObjType :: f (ObjTypeBody 'Stage1 f a) -> a -> ObjType 'Stage1 f a
-  -- <type>[<expr>]
-  ArrayObjType :: ObjType stage f a -> Expression stage f a -> a -> ObjType stage f a
-  -- <identifier>
-  ReferencedObjType :: Name f a -> a -> ObjType stage f a
-  deriving (Typeable)
-
-data ObjTypeDecl stage f a where
-  {- assert_pos(<expr>) -}
-  AssertPosStatement ::
-    (StageLessThan stage 3) =>
-    Expression stage f a ->
-    a ->
-    ObjTypeDecl stage f a
-  {- reg <ident>(<expr>) : <regtype> -}
-  RegisterDecl ::
-    Maybe (Modifier f a) ->
-    Maybe (Identifier f a) ->
-    Expression stage f a ->
-    Maybe (RegisterBody stage f a) ->
-    a ->
-    ObjTypeDecl stage f a
-  {- reserved(n); -}
-  ReservedDecl :: Expression stage f a -> a -> ObjTypeDecl stage f a
-  {- <struct|union> { subfields } <name>; -}
-  TypeSubStructure ::
-    f (ObjTypeBody stage f a) ->
-    Maybe (Identifier f a) ->
-    a ->
-    ObjTypeDecl stage f a
-  deriving (Typeable)
-
-data Modifier f a where
-  ModifierKeyword :: ModifierKeyword -> a -> Modifier f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data ModifierKeyword = Rw | Ro | Wo deriving (Eq, Ord, Show, Read, Typeable)
-
-data DeferredRegisterBody stage f a where
-  DeferredRegisterBody ::
-    [Directed (RegisterBitsDecl stage) f a] ->
-    a ->
-    DeferredRegisterBody stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data BodyType (f :: Type -> Type) a where
-  Union :: a -> BodyType f a
-  Struct :: a -> BodyType f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data RegisterBody stage f a where
-  RegisterBody ::
-    BodyType f a ->
-    f (DeferredRegisterBody stage f a) ->
-    a ->
-    RegisterBody stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data RegisterBitsDecl stage f a where
-  -- reserved(<expr>)
-  ReservedBits :: Expression stage f a -> a -> RegisterBitsDecl stage f a
-  -- <modifer> <ident> : <type>
-  DefinedBits ::
-    Maybe (Modifier f a) ->
-    Identifier f a ->
-    RegisterBitsTypeRef stage f a ->
-    a ->
-    RegisterBitsDecl stage f a
-  BitsSubStructure ::
-    RegisterBody stage f a ->
-    Maybe (Identifier f a) ->
-    a ->
-    RegisterBitsDecl stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data RegisterBitsTypeRef stage f a where
-  -- <type>[<expr>]
-  RegisterBitsArray ::
-    RegisterBitsTypeRef stage f a ->
-    Expression stage f a ->
-    a ->
-    RegisterBitsTypeRef stage f a
-  {- Reference to a type. -}
-  RegisterBitsReference :: Name f a -> a -> RegisterBitsTypeRef stage f a
-  {- enum(<expr>) { <body> }
-     Anonymous types are only allowed in stage1.
-     Stage2 should de-anonymize these type. -}
-  RegisterBitsAnonymousType ::
-    AnonymousBitsType Stage1 f a ->
-    a ->
-    RegisterBitsTypeRef 'Stage1 f a
-  {- (<expr>)
-   -
-   - The expression is just bits ... i.e. an integer.
-   -}
-  RegisterBitsJustBits ::
-    Expression stage f a ->
-    a ->
-    RegisterBitsTypeRef stage f a
-
-instance Alter (Expression stage) where
-  alter ffn fn = \case
-    LitNum t a -> LitNum t <$> fn a
-    Var i a -> Var <$> alter ffn fn i <*> fn a
-
-instance Annotated (Expression stage) where
-  annot = \case
-    LitNum _ a -> a
-    Var _ a -> a
-
-instance Alter (ObjTypeDecl stage) where
-  alter ffn fn = \case
-    (AssertPosStatement expr a) ->
-      AssertPosStatement <$> alter ffn fn expr <*> fn a
-    (RegisterDecl mMod mIdent expr mBody a) ->
-      RegisterDecl
-        <$> mapM (alter ffn fn) mMod
-        <*> mapM (alter ffn fn) mIdent
-        <*> alter ffn fn expr
-        <*> mapM (alter ffn fn) mBody
-        <*> fn a
-    (TypeSubStructure mBody mIdent a) ->
-      TypeSubStructure
-        <$> (ffn =<< mapM (alter ffn fn) mBody)
-        <*> mapM (alter ffn fn) mIdent
-        <*> fn a
-    (ReservedDecl expr a) ->
-      ReservedDecl
-        <$> alter ffn fn expr
-        <*> fn a
-
-instance Annotated (ObjTypeDecl stage) where
-  annot = \case
-    (AssertPosStatement _ a) -> a
-    (RegisterDecl _ _ _ _ a) -> a
-
-instance Alter (ObjType stage) where
-  alter ffn fn = \case
-    (AnonymousObjType b a) ->
-      AnonymousObjType <$> (ffn =<< mapM (alter ffn fn) b) <*> fn a
-    (ArrayObjType t e a) ->
-      ArrayObjType <$> alter ffn fn t <*> alter ffn fn e <*> fn a
-    (ReferencedObjType i a) ->
-      ReferencedObjType <$> alter ffn fn i <*> fn a
-
-instance Annotated (ObjType stage) where
-  annot = \case
-    (AnonymousObjType _ a) -> a
-    (ArrayObjType _ _ a) -> a
-    (ReferencedObjType _ a) -> a
-
-instance Alter (RegisterBitsTypeRef stage) where
-  alter ffn fn = \case
-    (RegisterBitsArray ref exp a) ->
-      RegisterBitsArray <$> alter ffn fn ref <*> alter ffn fn exp <*> fn a
-    (RegisterBitsReference i a) ->
-      RegisterBitsReference <$> alter ffn fn i <*> fn a
-    (RegisterBitsAnonymousType t a) ->
-      RegisterBitsAnonymousType <$> alter ffn fn t <*> fn a
-    (RegisterBitsJustBits e a) ->
-      RegisterBitsJustBits <$> alter ffn fn e <*> fn a
-
-instance Annotated (RegisterBitsTypeRef stage) where
-  annot = \case
-    (RegisterBitsArray _ _ a) -> a
-    (RegisterBitsReference _ a) -> a
-    (RegisterBitsAnonymousType _ a) -> a
-    (RegisterBitsJustBits _ a) -> a
-
-data AnonymousBitsType stage f a where
-  -- enum(<expr>) { <body> }
-  AnonymousEnumBody ::
-    Expression stage f a ->
-    f (EnumBody stage f a) ->
-    a ->
-    AnonymousBitsType stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data BitType (stage :: Stage) (f :: Type -> Type) a where
-  -- enum(<expr>) { <body> }
-  EnumBitType ::
-    Expression stage f a ->
-    f (EnumBody stage f a) ->
-    a ->
-    BitType stage f a
-  -- (<expr>)
-  RawBits :: Expression stage f a -> a -> BitType stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data EnumBody (stage :: Stage) (f :: Type -> Type) a where
-  -- <decl>,
-  EnumBody :: [Directed (EnumConstantDecl stage) f a] -> a -> EnumBody stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data EnumConstantDecl stage f a where
-  -- <ident> = <expr>
-  EnumConstantDecl ::
-    Identifier f a ->
-    Expression stage f a ->
-    a ->
-    EnumConstantDecl stage f a
-  -- reserved = <expr>
-  EnumConstantReserved ::
-    Expression stage f a ->
-    a ->
-    EnumConstantDecl stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
-
-data PackageBody (stage :: Stage) (f :: Type -> Type) a where
-  {- The body of a package -}
-  PackageBody :: [Directed (FiddleDecl stage) f a] -> a -> PackageBody stage f a
-  deriving (Generic, Annotated, Typeable)
-
-deriving instance (Alter (ImportType stage)) => Alter (PackageBody stage)
-
--- instance Alter (Modifier stage) where
---   alter _ fn (ModifierKeyword m a) = ModifierKeyword m (fn a)
---
--- instance Alter (Identifier) where
---   alter _ fn (Identifier i a) = Identifier i $ fn a
---
--- instance Alter (Expression stage) where
---   alter ffn fn = \case
---     (LitNum t a) -> LitNum t $ fn a
---     (RealNum t a) -> RealNum t $ fn a
---     (Var i a) -> Var (alter ffn fn i) $ fn a
-
-proxyOf :: t f a -> Proxy t
-proxyOf _ = Proxy
-
-class Annotated (t :: SynTreeKind) where
-  annot :: t f a -> a
-  default annot :: (Generic (t f a), GAnnot a (Rep (t f a))) => t f a -> a
-  annot t = gannot (from t)
-
-class GAnnot a r where
-  gannot :: r x -> a
-
-instance GAnnot a (Rec0 a) where
-  gannot = unK1
-
-instance (GAnnot a r) => GAnnot a (l :*: r) where
-  gannot (_ :*: r) = gannot r
-
-instance (GAnnot a r, GAnnot a l) => GAnnot a (l :+: r) where
-  gannot (R1 r) = gannot r
-  gannot (L1 l) = gannot l
-
-instance (GAnnot a r) => GAnnot a (M1 i c r) where
-  gannot (M1 a) = gannot a
-
-class Alter (t :: SynTreeKind) where
-  alter ::
-    forall f1 f2 a1 a2 m.
-    (Monad m, Traversable f1) =>
-    (forall z. f1 z -> m (f2 z)) ->
-    (a1 -> m a2) ->
-    t f1 a1 ->
-    m (t f2 a2)
-  default alter ::
-    forall f1 f2 a1 a2 m.
-    ( Generic (t f1 a1),
-      Generic (t f2 a2),
-      Traversable f1,
-      GAlter t f1 f2 a1 a2 (Rep (t f1 a1)) (Rep (t f2 a2)),
-      Monad m
-    ) =>
-    ( forall z.
-      f1 z ->
-      m (f2 z)
-    ) ->
-    (a1 -> m a2) ->
-    t f1 a1 ->
-    m (t f2 a2)
-  alter ffn fn t = to <$> galter (proxyOf t) ffn fn (from t)
-
-instance (Alter t, Traversable f) => Functor (t f) where
-  fmap f t = runIdentity (alter return (return . f) t)
-
-class GAlter t f1 f2 a1 a2 r1 r2 where
-  galter ::
-    forall proxy x m.
-    (Monad m, Traversable f1) =>
-    proxy t ->
-    (forall z. f1 z -> m (f2 z)) ->
-    (a1 -> m a2) ->
-    r1 x ->
-    m (r2 x)
-
-{- Altering a record with type a1 will apply the mapping function and produce a
-    record with type a2 -}
-instance GAlter t f1 f2 a1 a2 (Rec0 a1) (Rec0 a2) where
-  galter _ _ fn k1 = K1 <$> fn (unK1 k1)
-
-{- Base-Case. Altering unrelated leaf types will do nothing. -}
-instance GAlter t f1 f2 a1 a2 (Rec0 u1) (Rec0 u1) where
-  galter _ _ _ = return
-
-{- Recursive case. Call alter on sub-structures. -}
-instance
-  (Alter u) =>
-  GAlter t f1 f2 a1 a2 (Rec0 (u f1 a1)) (Rec0 (u f2 a2))
-  where
-  galter _ ffn fn k1 =
-    K1 <$> alter ffn fn (unK1 k1)
-
-{- Recursive case. Called when there are list of substructures that need to be
-    recused. -}
-instance
-  (Alter u, Traversable l) =>
-  GAlter t f1 f2 a1 a2 (Rec0 (l (u f1 a1))) (Rec0 (l (u f2 a2)))
-  where
-  galter _ ffn fn k1 =
-    K1 <$> mapM (alter ffn fn) (unK1 k1)
-
--- instance GAlter t f1 f2 a1 a2 (Rec0 (f1 z)) (Rec0 (f2 z)) where
---   galter _ ffn _ k1 = K1 <$> ffn (unK1 k1)
-
-{- Generic altering. Descends into the function and alters whatever is inside
-    the functor and then transforms the functor using the ffn function. -}
-instance
-  (Traversable f1, Alter u) =>
-  GAlter t f1 f2 a1 a2 (Rec0 (f1 (u f1 a1))) (Rec0 (f2 (u f2 a2)))
-  where
-  galter proxy ffn fn k1 = do
-    newK <- mapM (alter ffn fn) (unK1 k1)
-    K1 <$> ffn newK
-
-instance
-  ( GAlter t f1 f2 a1 a2 l1 l2,
-    GAlter t f1 f2 a1 a2 r1 r2
-  ) =>
-  GAlter t f1 f2 a1 a2 (l1 :*: r1) (l2 :*: r2)
-  where
-  galter proxy ffn fn (a :*: b) = do
-    a' <- galter proxy ffn fn a
-    b' <- galter proxy ffn fn b
-    return (a' :*: b')
-
-instance
-  ( GAlter t f1 f2 a1 a2 l1 l2,
-    GAlter t f1 f2 a1 a2 r1 r2
-  ) =>
-  GAlter t f1 f2 a1 a2 (l1 :+: r1) (l2 :+: r2)
-  where
-  galter proxy ffn fn (R1 r) = R1 <$> galter proxy ffn fn r
-  galter proxy ffn fn (L1 l) = L1 <$> galter proxy ffn fn l
-
-instance
-  (GAlter t f1 f2 a1 a2 r1 r2) =>
-  GAlter t f1 f2 a1 a2 (M1 i c r1) (M1 i c r2)
-  where
-  galter proxy ffn fn (M1 a) = M1 <$> galter proxy ffn fn a
-
-type family StageNumber (s :: Stage) :: Natural where
-  StageNumber Stage1 = 1
-  StageNumber Stage2 = 2
-  StageNumber Stage3 = 3
-
-{--}
-squeeze :: (Alter t, Traversable f, Monad f) => t f a -> f (t Identity a)
-squeeze = alter (fmap Identity) return
+import Language.Fiddle.Ast.Internal.Instances as X
+import Language.Fiddle.Ast.Internal.Kinds as X
+import Language.Fiddle.Ast.Internal.Stage as X
+import Language.Fiddle.Ast.Internal.SyntaxTree as X
diff --git a/src/Language/Fiddle/Ast/FileInterface.hs b/src/Language/Fiddle/Ast/FileInterface.hs
new file mode 100644
index 0000000..d29fc9d
--- /dev/null
+++ b/src/Language/Fiddle/Ast/FileInterface.hs
@@ -0,0 +1,33 @@
+module Language.Fiddle.Ast.FileInterface where
+
+-- Definitions for file interfaces. These interfaces contain an abstract
+-- representation of the symbols and information exported by a fiddle file.
+-- These interfaces are also serializable, and when compiling a fiddle file, all
+-- the import statements should supply an fdi (fiddle interface) file to speed
+-- up subsequent compilations.
+
+-- import Data.Text
+-- 
+-- data ObjectType = ObjectType
+--   { objectTypeSize :: Word32
+--   }
+-- 
+-- data Metatype
+--   = Object
+--       { objectLocation :: Word64,
+--         objectType :: Text
+--       }
+--   | Type
+--       { typeSizeBytes :: Word32
+--       }
+-- 
+-- data Element a = Element
+--   { elementFullyQualifiedSymbol :: Text,
+--     elementDocumentation :: Maybe Text,
+--     elementMetatype :: Metatype,
+--     elementAnnotation :: a
+--   }
+-- 
+-- data FileInterface a = FiddleInterface
+--   { exportedElements :: [Element a]
+--   }
diff --git a/src/Language/Fiddle/Ast/Internal/Generic.hs b/src/Language/Fiddle/Ast/Internal/Generic.hs
new file mode 100644
index 0000000..cb075cc
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/Generic.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeOperators #-}
+module Language.Fiddle.Ast.Internal.Generic where
+
+import GHC.Generics
+import GHC.TypeError as TypeError
diff --git a/src/Language/Fiddle/Ast/Internal/Instances.hs b/src/Language/Fiddle/Ast/Internal/Instances.hs
new file mode 100644
index 0000000..c8c606c
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/Instances.hs
@@ -0,0 +1,228 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Language.Fiddle.Ast.Internal.Instances where
+
+import Data.Functor.Identity
+import Data.Kind (Type)
+import Data.Typeable
+import GHC.Generics
+import GHC.TypeError as TypeError
+import Language.Fiddle.Ast.Internal.Kinds
+import Language.Fiddle.Ast.Internal.Stage
+
+-- Type class to easily switch between stages if there is no difference in the
+-- syntax tree structure between these stages. Can make things much cleaner and
+-- avoids the boilerplate and bugprone-ness of needing to rote copy everything.
+class
+  (Functor f) =>
+  EasySwitchStage
+    (t :: Stage -> SynTree)
+    (f :: Type -> Type)
+    (fromStage :: Stage)
+    (toStage :: Stage)
+  where
+  switchStage :: t fromStage f a -> t toStage f a
+  default switchStage ::
+    ( Generic (t fromStage f a),
+      Generic (t toStage f a),
+      GEasySwitchStage (Rep (t fromStage f a)) (Rep (t toStage f a))
+    ) =>
+    t fromStage f a ->
+    t toStage f a
+  switchStage t = to $ gSwitchStage (from t)
+
+-- Class for walking a syntax tree under the context of a monad and modifying
+-- the different parts of the SynTree type..
+class Alter (t :: SynTree) where
+  alter ::
+    forall f1 f2 a1 a2 m.
+    (Monad m, Traversable f1) =>
+    (forall z. f1 z -> m (f2 z)) ->
+    (a1 -> m a2) ->
+    t f1 a1 ->
+    m (t f2 a2)
+  default alter ::
+    forall f1 f2 a1 a2 m.
+    ( Generic (t f1 a1),
+      Generic (t f2 a2),
+      Traversable f1,
+      GAlter t f1 f2 a1 a2 (Rep (t f1 a1)) (Rep (t f2 a2)),
+      Monad m
+    ) =>
+    ( forall z.
+      f1 z ->
+      m (f2 z)
+    ) ->
+    (a1 -> m a2) ->
+    t f1 a1 ->
+    m (t f2 a2)
+  alter ffn fn t = to <$> galter (proxyOf t) ffn fn (from t)
+
+-- A syntax tree object is annotated if it has an annotation 'a' as the last
+-- element.
+class Annotated (t :: SynTree) where
+  annot :: t f a -> a
+  default annot :: (Generic (t f a), GAnnot a (Rep (t f a))) => t f a -> a
+  annot t = gannot (from t)
+
+-- Generic implementations of common typeclass for SyntaxTrees.
+--
+-- This is where we try to hide the pig behind the curtain.
+--
+--
+-- ---------------------------------------------------------------
+--
+--
+--
+class GAlter t f1 f2 a1 a2 r1 r2 where
+  galter ::
+    forall proxy x m.
+    (Monad m, Traversable f1) =>
+    proxy t ->
+    (forall z. f1 z -> m (f2 z)) ->
+    (a1 -> m a2) ->
+    r1 x ->
+    m (r2 x)
+
+{- Altering a record with type a1 will apply the mapping function and produce a
+    record with type a2 -}
+instance GAlter t f1 f2 a1 a2 (Rec0 a1) (Rec0 a2) where
+  galter _ _ fn k1 = K1 <$> fn (unK1 k1)
+
+{- Base-Case. Altering unrelated leaf types will do nothing. -}
+instance GAlter t f1 f2 a1 a2 (Rec0 u1) (Rec0 u1) where
+  galter _ _ _ = return
+
+{- Recursive case. Call alter on sub-structures. -}
+instance
+  (Alter u) =>
+  GAlter t f1 f2 a1 a2 (Rec0 (u f1 a1)) (Rec0 (u f2 a2))
+  where
+  galter _ ffn fn k1 =
+    K1 <$> alter ffn fn (unK1 k1)
+
+{- Recursive case. Called when there are list of substructures that need to be
+    recused. -}
+instance
+  (Alter u, Traversable l) =>
+  GAlter t f1 f2 a1 a2 (Rec0 (l (u f1 a1))) (Rec0 (l (u f2 a2)))
+  where
+  galter _ ffn fn k1 =
+    K1 <$> mapM (alter ffn fn) (unK1 k1)
+
+-- instance GAlter t f1 f2 a1 a2 (Rec0 (f1 z)) (Rec0 (f2 z)) where
+--   galter _ ffn _ k1 = K1 <$> ffn (unK1 k1)
+
+{- Generic altering. Descends into the function and alters whatever is inside
+    the functor and then transforms the functor using the ffn function. -}
+instance
+  (Traversable f1, Alter u) =>
+  GAlter t f1 f2 a1 a2 (Rec0 (f1 (u f1 a1))) (Rec0 (f2 (u f2 a2)))
+  where
+  galter proxy ffn fn k1 = do
+    newK <- mapM (alter ffn fn) (unK1 k1)
+    K1 <$> ffn newK
+
+instance
+  ( GAlter t f1 f2 a1 a2 l1 l2,
+    GAlter t f1 f2 a1 a2 r1 r2
+  ) =>
+  GAlter t f1 f2 a1 a2 (l1 :*: r1) (l2 :*: r2)
+  where
+  galter proxy ffn fn (a :*: b) = do
+    a' <- galter proxy ffn fn a
+    b' <- galter proxy ffn fn b
+    return (a' :*: b')
+
+instance
+  ( GAlter t f1 f2 a1 a2 l1 l2,
+    GAlter t f1 f2 a1 a2 r1 r2
+  ) =>
+  GAlter t f1 f2 a1 a2 (l1 :+: r1) (l2 :+: r2)
+  where
+  galter proxy ffn fn (R1 r) = R1 <$> galter proxy ffn fn r
+  galter proxy ffn fn (L1 l) = L1 <$> galter proxy ffn fn l
+
+instance
+  (GAlter t f1 f2 a1 a2 r1 r2) =>
+  GAlter t f1 f2 a1 a2 (M1 i c r1) (M1 i c r2)
+  where
+  galter proxy ffn fn (M1 a) = M1 <$> galter proxy ffn fn a
+
+class GAnnot a r where
+  gannot :: r x -> a
+
+instance GAnnot a (Rec0 a) where
+  gannot = unK1
+
+instance (GAnnot a r) => GAnnot a (l :*: r) where
+  gannot (_ :*: r) = gannot r
+
+instance (GAnnot a r, GAnnot a l) => GAnnot a (l :+: r) where
+  gannot (R1 r) = gannot r
+  gannot (L1 l) = gannot l
+
+instance (GAnnot a r) => GAnnot a (M1 i c r) where
+  gannot (M1 a) = gannot a
+
+instance
+  (GEasySwitchStage s1 s2) =>
+  GEasySwitchStage (M1 i c s1) (M1 i c s2)
+  where
+  gSwitchStage (M1 a) = M1 (gSwitchStage a)
+
+instance
+  (GEasySwitchStage l1 l2, GEasySwitchStage r1 r2) =>
+  GEasySwitchStage (l1 :+: r1) (l2 :+: r2)
+  where
+  gSwitchStage (R1 r) = R1 $ gSwitchStage r
+  gSwitchStage (L1 l) = L1 $ gSwitchStage l
+
+instance
+  (GEasySwitchStage l1 l2, GEasySwitchStage r1 r2) =>
+  (GEasySwitchStage (l1 :*: r1) (l2 :*: r2))
+  where
+  gSwitchStage (l :*: r) = gSwitchStage l :*: gSwitchStage r
+
+instance
+  (EasySwitchStage t f fs ts) =>
+  (GEasySwitchStage (Rec0 (t fs f a)) (Rec0 (t ts f a)))
+  where
+  gSwitchStage (K1 val) = K1 (switchStage val)
+
+instance
+  ( EasySwitchStage t f fs ts,
+    Functor func
+  ) =>
+  (GEasySwitchStage (Rec0 (func (t fs f a))) (Rec0 (func (t ts f a))))
+  where
+  gSwitchStage (K1 val) = K1 (switchStage <$> val)
+
+instance (GEasySwitchStage (Rec0 a) (Rec0 a)) where
+  gSwitchStage = id
+
+instance
+  ( TypeError
+      ( TypeError.Text "Unable to match type "
+          :<>: TypeError.ShowType a
+          :<>: TypeError.Text " with "
+          :<>: TypeError.ShowType b
+      )
+  ) =>
+  (GEasySwitchStage (Rec0 a) (Rec0 b))
+  where
+  gSwitchStage = error "Cannot be called"
+
+class GEasySwitchStage r1 r2 where
+  gSwitchStage :: r1 x -> r2 x
+
+proxyOf :: t f a -> Proxy t
+proxyOf _ = Proxy
+
+instance (Alter t, Traversable f) => Functor (t f) where
+  fmap f t = runIdentity (alter return (return . f) t)
diff --git a/src/Language/Fiddle/Ast/Internal/Kinds.hs b/src/Language/Fiddle/Ast/Internal/Kinds.hs
new file mode 100644
index 0000000..1368c84
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/Kinds.hs
@@ -0,0 +1,25 @@
+
+module Language.Fiddle.Ast.Internal.Kinds where
+
+import Data.Kind (Type)
+import Language.Fiddle.Ast.Internal.Stage
+
+-- The Kind types should have for SyntaxTrees.
+--
+-- A synatx tree kind should take as parameters, an applicative functor for the
+-- first argument. This applicative functor allows errors and warnings to be
+-- contained to their deferred regions during compilation, so more errors may be
+-- reported an once.
+--
+-- The second argument is the annotation type. Every syntax tree element has an
+-- annotation. When initially parsing, this annotation is a list of comments
+-- that came before the element and the source position of the element.
+--
+-- SynTree types are not dependent on the compilation stage. They're the same
+-- regardless of the compilation stage.
+type SynTree = (Type -> Type) -> Type -> Type
+
+-- A syntax tree which is dependent on the stage in compilation. As compilations
+-- progress through stages, types in the syntax tree may change as things become
+-- more and more machine readable.
+type StagedSynTree = Stage -> SynTree
diff --git a/src/Language/Fiddle/Ast/Internal/Stage.hs b/src/Language/Fiddle/Ast/Internal/Stage.hs
new file mode 100644
index 0000000..cfcd0e6
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/Stage.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Language.Fiddle.Ast.Internal.Stage where
+
+import Data.Type.Bool
+import Data.Type.Equality
+import Data.Typeable
+import qualified GHC.TypeError as TypeError
+import GHC.TypeLits
+
+-- Stage of compilation. Parts of the AST maybe un unavailable with other stages
+-- as compilation simplifies the AST.
+data Stage = Stage1 | Stage2 | Stage3
+  deriving (Typeable)
+
+-- Returns the stage before the given stage.
+type family PreviousStage (s :: Stage) :: Stage where
+  PreviousStage Stage1 = TypeError (TypeError.Text "No Prior stage to Stage1")
+  PreviousStage s = NumberToStage (StageToNumber s - 1)
+
+-- Returns the stage after the give stage.
+type family NextStage (s :: Stage) :: Stage where
+  NextStage s = NumberToStage (StageToNumber s + 1)
+
+-- Converts a stage to a number.
+type family StageToNumber (s :: Stage) :: Natural where
+  StageToNumber Stage1 = 1
+  StageToNumber Stage2 = 2
+  StageToNumber Stage3 = 3
+
+-- Converts a number to a stage.
+type family NumberToStage (n :: Natural) :: Stage where
+  NumberToStage 1 = Stage1
+  NumberToStage 2 = Stage2
+  NumberToStage 3 = Stage3
+  NumberToStage n = TypeError (TypeError.Text "Number in NumberToStage.")
+
+-- Type-level constraint to determine if a stage is less than some natural
+-- ordinal. Used to bound parts of the AST in multiple stages.
+type StageLessThan stage (n :: Natural) = (CmpNat (StageToNumber stage) n == LT)
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
new file mode 100644
index 0000000..48852ee
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -0,0 +1,537 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Language.Fiddle.Ast.Internal.SyntaxTree
+  ( -- Type Families
+    NumberType,
+    ImportType,
+    -- Witness Types
+    Witness (..),
+    WitnessType,
+    -- AST Types
+    Name (..),
+    Directive (..),
+    DirectiveBody (..),
+    DirectiveElement (..),
+    DirectiveExpression (..),
+    Directed (..),
+    FiddleUnit (..),
+    Identifier (..),
+    Expression (..),
+    ImportStatement (..),
+    ImportList (..),
+    FiddleDecl (..),
+    ObjTypeBody (..),
+    ObjType (..),
+    ObjTypeDecl (..),
+    Modifier (..),
+    ModifierKeyword (..),
+    DeferredRegisterBody (..),
+    BodyType (..),
+    RegisterBody (..),
+    RegisterBitsDecl (..),
+    RegisterBitsTypeRef (..),
+    AnonymousBitsType (..),
+    BitType (..),
+    EnumBody (..),
+    EnumConstantDecl (..),
+    PackageBody (..),
+    -- Helper Functions
+    mapDirected,
+    mapDirectedM,
+    asDirected,
+    undirected,
+    -- Utility Functions
+    squeeze,
+  )
+where
+
+import Data.Coerce
+import Data.Functor.Identity
+import Data.Kind (Type)
+import Data.List.NonEmpty
+import Data.Proxy
+import Data.Text (Text)
+import Data.Traversable
+import Data.Type.Bool
+import Data.Type.Equality
+import Data.Typeable
+import Data.Void (Void, absurd)
+import GHC.Generics
+import GHC.TypeLits
+import Language.Fiddle.Ast.Internal.Generic
+import Language.Fiddle.Ast.Internal.Instances
+import Language.Fiddle.Ast.Internal.Kinds
+import Language.Fiddle.Ast.Internal.Stage
+
+-- The Type of number during each stage of compilation. When in the first stage,
+-- numbers are just strings like anything else. In later stages, numbers get
+-- parsed into actual integers. This makes it easier to process later.
+type family NumberType (a :: Stage) :: Type where
+  NumberType Stage1 = Text
+  NumberType Stage2 = Integer
+  NumberType s = NumberType (PreviousStage s)
+
+-- The type that represents an import statement. In the early stages of
+-- compilation, this is just a string representing the import path, but in later
+-- stages of compilation, this actually gets replaced by an abstract
+-- representation of the imported material.
+type family ImportType (stage :: Stage) :: SynTree where
+  ImportType Stage1 = ImportStatement
+  ImportType Stage2 = ImportStatement
+  ImportType Stage3 = ImportStatement
+
+-- A way to disable or enable a subtree type based on a type-level boolean.
+--
+-- This is used over GADT's specific parameterization to allow for deriving
+-- generics and reduce boilerplate.
+--
+-- This is a wrapper type to allow defining instances.
+data Witness (s :: Bool) where
+  Witness :: (WitnessType s) -> Witness s
+
+-- | If the type level expression is true, the witness type is the Unit type, if
+-- it is false, the witness type is Void, thus making whatever it touches
+-- uninhabitable. This is how parts of the AST is enabled or disabled during
+-- compilation.
+type family WitnessType (s :: Bool) where
+  WitnessType True = ()
+  WitnessType False = Void
+
+-- A Name is multiple identifiers separated by dots. It's the way of namespaces
+-- to different packages.
+data Name :: SynTree where
+  Name :: NonEmpty (Identifier f a) -> a -> Name f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- Syntax tree fo the directive sublanguage. Directives can be on many elements
+-- and provide the compiler with additional information about the emitted code.
+--
+-- The directive subtree by design does not depend on the compilation stage.
+-- This is because the directive sublanguage should pass directly to the backend
+-- compilation stage.
+data Directive :: SynTree where
+  Directive :: f (DirectiveBody f a) -> a -> Directive f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- A directive body has multiple directive elements.
+data DirectiveBody :: SynTree where
+  DirectiveBody :: [DirectiveElement f a] -> a -> DirectiveBody f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- Element in the directive.
+data DirectiveElement :: SynTree where
+  -- A directive can just be a key. Where the mere presence of the key has
+  -- semantic value.
+  DirectiveElementKey ::
+    -- Which backend is this directive intended for?
+    Maybe (Identifier f a) ->
+    Identifier f a ->
+    a ->
+    DirectiveElement f a
+  -- A directive can be more complex too. It can have an optional backend
+  -- specificer, a key and a value.
+  DirectiveElementKeyValue ::
+    -- Which backend is this directive intendend for?
+    Maybe (Identifier f a) ->
+    -- The key for this directive.
+    Identifier f a ->
+    -- The value for this directive.
+    DirectiveExpression f a ->
+    a ->
+    DirectiveElement f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- Expressions which can be found in the directive.
+data DirectiveExpression f a where
+  DirectiveString :: Text -> a -> DirectiveExpression f a
+  DirectiveNumber :: Text -> a -> DirectiveExpression f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- A type, which wraps another syntax tree, but tacks on an array of directives.
+-- that apply to the subtree.
+data Directed t stage f a where
+  Directed :: [Directive f a] -> t stage f a -> a -> Directed t stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- Apply a function to the underlying subtree in a Directed type.
+mapDirected :: (t s f a -> t' s' f a) -> Directed t s f a -> Directed t' s' f a
+mapDirected fn (Directed dr tfa a) = Directed dr (fn tfa) a
+
+-- Apply a monadic function to the underlying subtree in a Directed type.
+mapDirectedM ::
+  (Monad m) => (t s f a -> m (t' s' f a)) -> Directed t s f a -> m (Directed t' s' f a)
+mapDirectedM fn (Directed dr tfa a) = Directed dr <$> fn tfa <*> pure a
+
+asDirected :: (Annotated (t s)) => t s f a -> Directed t s f a
+asDirected tfa = Directed [] tfa (annot tfa)
+
+undirected :: Directed t s f a -> t s f a
+undirected (Directed _ tfa _) = tfa
+
+-- Root of the parse tree. Just contains a list of declarations.
+data FiddleUnit (stage :: Stage) (f :: Type -> Type) a where
+  FiddleUnit :: [Directed FiddleDecl stage f a] -> a -> FiddleUnit stage f a
+  deriving (Generic, Annotated, Typeable)
+
+deriving instance (Alter (ImportType stage)) => Alter (FiddleUnit stage)
+
+-- Just an identifier.
+data Identifier f a = Identifier !Text a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- Expression.
+data Expression (s :: Stage) :: SynTree where
+  -- Just a string. Parsing the number comes in stage2.
+  LitNum :: NumberType stage -> a -> Expression stage f a
+  Var :: Identifier f a -> a -> Expression stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data ImportStatement f a where
+  ImportStatement :: Text -> Maybe (ImportList f a) -> a -> ImportStatement f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data ImportList f a where
+  ImportList :: [Identifier f a] -> a -> ImportList f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+-- Top-level declarations.
+data FiddleDecl :: StagedSynTree where
+  {-
+   - An option is a key/value pair.
+   - option <ident> <ident>;
+   -}
+  OptionDecl ::
+    Identifier f a ->
+    Identifier f a ->
+    a ->
+    FiddleDecl stage f a
+  ImportDecl ::
+    ImportType stage f a ->
+    a ->
+    FiddleDecl stage f a
+  UsingDecl ::
+    Name f a -> a -> FiddleDecl stage f a
+  {- Package Statement. Package Name, Package body -}
+  PackageDecl ::
+    Name f a ->
+    f (PackageBody stage f a) ->
+    a ->
+    FiddleDecl stage f a
+  {- location <identifier> = <expr>. -}
+  LocationDecl ::
+    Identifier f a ->
+    Expression stage f a ->
+    a ->
+    FiddleDecl stage f a
+  {- bits <identifier> : <type> -}
+  BitsDecl ::
+    Identifier f a ->
+    BitType stage f a ->
+    a ->
+    FiddleDecl stage f a
+  {- objtype <identifier> : <type> -}
+  ObjTypeDecl ::
+    Identifier f a ->
+    f (ObjTypeBody stage f a) ->
+    a ->
+    FiddleDecl stage f a
+  {- object <ident> at <expr> : <type> -}
+  ObjectDecl ::
+    Identifier f a ->
+    Expression stage f a ->
+    ObjType stage f a ->
+    a ->
+    FiddleDecl stage f a
+  deriving (Generic, Annotated, Typeable)
+
+deriving instance (Alter (ImportType stage)) => Alter (FiddleDecl stage)
+
+data ObjTypeBody (stage :: Stage) (f :: Type -> Type) a where
+  ObjTypeBody ::
+    BodyType f a ->
+    [Directed ObjTypeDecl stage f a] ->
+    a ->
+    ObjTypeBody stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data ObjType stage f a where
+  -- { <body> }
+  -- Anonymous types are only allowed in stage1. Stage2 should have them be
+  -- de-anonymized.
+  AnonymousObjType ::
+    (Witness (stage == Stage1)) ->
+    f (ObjTypeBody stage f a) ->
+    a ->
+    ObjType stage f a
+  -- <type>[<expr>]
+  ArrayObjType :: ObjType stage f a -> Expression stage f a -> a -> ObjType stage f a
+  -- <identifier>
+  ReferencedObjType :: Name f a -> a -> ObjType stage f a
+  deriving (Typeable, Generic, Alter, Annotated, Typeable)
+
+data ObjTypeDecl stage f a where
+  {- assert_pos(<expr>) -}
+  AssertPosStatement ::
+    Witness (StageLessThan stage 3) ->
+    Expression stage f a ->
+    a ->
+    ObjTypeDecl stage f a
+  {- reg <ident>(<expr>) : <regtype> -}
+  RegisterDecl ::
+    Maybe (Modifier f a) ->
+    Maybe (Identifier f a) ->
+    Expression stage f a ->
+    Maybe (RegisterBody stage f a) ->
+    a ->
+    ObjTypeDecl stage f a
+  {- reserved(n); -}
+  ReservedDecl :: Expression stage f a -> a -> ObjTypeDecl stage f a
+  {- <struct|union> { subfields } <name>; -}
+  TypeSubStructure ::
+    f (ObjTypeBody stage f a) ->
+    Maybe (Identifier f a) ->
+    a ->
+    ObjTypeDecl stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data Modifier f a where
+  ModifierKeyword :: ModifierKeyword -> a -> Modifier f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data ModifierKeyword = Rw | Ro | Wo deriving (Eq, Ord, Show, Read, Typeable)
+
+data DeferredRegisterBody stage f a where
+  DeferredRegisterBody ::
+    [Directed RegisterBitsDecl stage f a] ->
+    a ->
+    DeferredRegisterBody stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data BodyType (f :: Type -> Type) a where
+  Union :: a -> BodyType f a
+  Struct :: a -> BodyType f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data RegisterBody stage f a where
+  RegisterBody ::
+    BodyType f a ->
+    f (DeferredRegisterBody stage f a) ->
+    a ->
+    RegisterBody stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data RegisterBitsDecl stage f a where
+  -- reserved(<expr>)
+  ReservedBits :: Expression stage f a -> a -> RegisterBitsDecl stage f a
+  -- <modifer> <ident> : <type>
+  DefinedBits ::
+    Maybe (Modifier f a) ->
+    Identifier f a ->
+    RegisterBitsTypeRef stage f a ->
+    a ->
+    RegisterBitsDecl stage f a
+  BitsSubStructure ::
+    RegisterBody stage f a ->
+    Maybe (Identifier f a) ->
+    a ->
+    RegisterBitsDecl stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data RegisterBitsTypeRef stage f a where
+  -- <type>[<expr>]
+  RegisterBitsArray ::
+    RegisterBitsTypeRef stage f a ->
+    Expression stage f a ->
+    a ->
+    RegisterBitsTypeRef stage f a
+  {- Reference to a type. -}
+  RegisterBitsReference :: Name f a -> a -> RegisterBitsTypeRef stage f a
+  {- enum(<expr>) { <body> }
+     Anonymous types are only allowed in stage1.
+     Stage2 should de-anonymize these type. -}
+  RegisterBitsAnonymousType ::
+    Witness (stage == Stage1) ->
+    AnonymousBitsType stage f a ->
+    a ->
+    RegisterBitsTypeRef stage f a
+  {- (<expr>)
+   -
+   - The expression is just bits ... i.e. an integer.
+   -}
+  RegisterBitsJustBits ::
+    Expression stage f a ->
+    a ->
+    RegisterBitsTypeRef stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data AnonymousBitsType stage f a where
+  -- enum(<expr>) { <body> }
+  AnonymousEnumBody ::
+    Expression stage f a ->
+    f (EnumBody stage f a) ->
+    a ->
+    AnonymousBitsType stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data BitType (stage :: Stage) (f :: Type -> Type) a where
+  -- enum(<expr>) { <body> }
+  EnumBitType ::
+    Expression stage f a ->
+    f (EnumBody stage f a) ->
+    a ->
+    BitType stage f a
+  -- (<expr>)
+  RawBits :: Expression stage f a -> a -> BitType stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data EnumBody (stage :: Stage) (f :: Type -> Type) a where
+  -- <decl>,
+  EnumBody :: [Directed EnumConstantDecl stage f a] -> a -> EnumBody stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data EnumConstantDecl stage f a where
+  -- <ident> = <expr>
+  EnumConstantDecl ::
+    Identifier f a ->
+    Expression stage f a ->
+    a ->
+    EnumConstantDecl stage f a
+  -- reserved = <expr>
+  EnumConstantReserved ::
+    Expression stage f a ->
+    a ->
+    EnumConstantDecl stage f a
+  deriving (Generic, Annotated, Alter, Typeable)
+
+data PackageBody (stage :: Stage) (f :: Type -> Type) a where
+  {- The body of a package -}
+  PackageBody :: [Directed FiddleDecl stage f a] -> a -> PackageBody stage f a
+  deriving (Generic, Annotated, Typeable)
+
+deriving instance (Alter (ImportType stage)) => Alter (PackageBody stage)
+
+squeeze :: (Alter t, Traversable f, Monad f) => t f a -> f (t Identity a)
+squeeze = alter (fmap Identity) return
+
+-- Expression involves NumberType, so we add the constraint:
+deriving instance (Functor f, NumberType s ~ NumberType s') => EasySwitchStage Expression f s s'
+
+-- FiddleDecl includes both NumberType and ImportType, so we need both constraints:
+deriving instance
+  ( Functor f,
+    StageLessThan s 3 ~ StageLessThan s' 3,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s',
+    ImportType s ~ ImportType s'
+  ) =>
+  EasySwitchStage FiddleDecl f s s'
+
+-- ObjType includes NumberType, so we add the constraint:
+deriving instance
+  ( Functor f,
+    StageLessThan s 3 ~ StageLessThan s' 3,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage ObjType f s s'
+
+-- ObjTypeBody doesn't have any special type families, so no additional constraints:
+deriving instance
+  ( Functor f,
+    StageLessThan s 3 ~ StageLessThan s' 3,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage ObjTypeBody f s s'
+
+-- ObjTypeDecl doesn't have special type families, so no additional constraints:
+deriving instance
+  ( Functor f,
+    StageLessThan s 3 ~ StageLessThan s' 3,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage ObjTypeDecl f s s'
+
+-- DeferredRegisterBody doesn't have special type families:
+deriving instance
+  ( Functor f,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage DeferredRegisterBody f s s'
+
+-- RegisterBody depends on NumberType, so we add that constraint:
+deriving instance
+  ( Functor f,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage RegisterBody f s s'
+
+-- RegisterBitsDecl depends on NumberType:
+deriving instance
+  ( Functor f,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage RegisterBitsDecl f s s'
+
+-- RegisterBitsTypeRef depends on NumberType:
+deriving instance
+  ( Functor f,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s'
+  ) =>
+  EasySwitchStage RegisterBitsTypeRef f s s'
+
+-- AnonymousBitsType depends on NumberType:
+deriving instance
+  (Functor f, NumberType s ~ NumberType s') =>
+  EasySwitchStage AnonymousBitsType f s s'
+
+-- BitType depends on NumberType:
+deriving instance
+  (Functor f, NumberType s ~ NumberType s') =>
+  EasySwitchStage BitType f s s'
+
+-- EnumBody doesn't depend on any type families:
+deriving instance
+  (Functor f, NumberType s ~ NumberType s') =>
+  EasySwitchStage EnumBody f s s'
+
+-- EnumConstantDecl depends on NumberType:
+deriving instance
+  (Functor f, NumberType s ~ NumberType s') =>
+  EasySwitchStage EnumConstantDecl f s s'
+
+-- PackageBody includes both NumberType and ImportType:
+deriving instance
+  ( Functor f,
+    StageLessThan s 3 ~ StageLessThan s' 3,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s',
+    ImportType s ~ ImportType s'
+  ) =>
+  EasySwitchStage PackageBody f s s'
+
+-- FiddleUnit includes NumberType and ImportType, so we need both constraints:
+deriving instance
+  ( Functor f,
+    StageLessThan s 3 ~ StageLessThan s' 3,
+    (s == Stage1) ~ (s' == Stage1),
+    NumberType s ~ NumberType s',
+    ImportType s ~ ImportType s'
+  ) =>
+  EasySwitchStage FiddleUnit f s s'
+
+-- Directed depends on its underlying AST type:
+deriving instance
+  (EasySwitchStage t f s s') =>
+  EasySwitchStage (Directed t) f s s'
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTreeKinds.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTreeKinds.hs
new file mode 100644
index 0000000..bfdfb13
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTreeKinds.hs
@@ -0,0 +1 @@
+module Language.Fiddle.Ast.Internal.SyntaxTreeKinds where
diff --git a/src/Language/Fiddle/Compiler/Stage1.hs b/src/Language/Fiddle/Compiler/Stage1.hs
index a17afa1..d2fe885 100644
--- a/src/Language/Fiddle/Compiler/Stage1.hs
+++ b/src/Language/Fiddle/Compiler/Stage1.hs
@@ -5,11 +5,11 @@
 
 module Language.Fiddle.Compiler.Stage1 (toStage2) where
 
-import qualified Data.List.NonEmpty as NonEmpty
 import Control.Monad.Identity (Identity (..))
 import Control.Monad.State (get, gets, modify, put)
 import qualified Data.Char as Char
 import Data.List (intercalate)
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Type.Bool
@@ -69,9 +69,9 @@ toStage2 (FiddleUnit decls annot) = do
       FiddleUnit <$> reconfigureFiddleDecls (Path []) decls <*> pure annot
   return a
 
-reconfigureFiddleDecls :: Path -> [Directed (FiddleDecl Stage1) I Annot] -> M Annot [Directed (FiddleDecl Stage2) I Annot]
+reconfigureFiddleDecls :: Path -> [Directed FiddleDecl Stage1 I Annot] -> M Annot [Directed FiddleDecl Stage2 I Annot]
 reconfigureFiddleDecls p decls = do
-  -- (Stage2CompilerState anonymousObjTypes anonymousBitsTypes, decls) <- pushState $ do
+  -- Stage2CompilerState anonymousObjTypes anonymousBitsTypes, decls <- pushState $ do
   --   put (Stage2CompilerState [] [])
   --   gets (,) <*> mapM (fiddleDeclToStage2 p) decls
 
@@ -95,6 +95,7 @@ reconfigureFiddleDecls p decls = do
 pushId :: Identifier f a -> Path -> Path
 pushId (Identifier str _) (Path lst) =
   Path (PathExpression (Text.unpack str) : lst)
+
 pushName :: Name f a -> Path -> Path
 pushName (Name idents _) path =
   foldl (flip pushId) path idents
@@ -134,7 +135,10 @@ objTypeBodyToStage2 path (ObjTypeBody bodyType decls annot) =
 
 objTypeDeclToStage2 :: Path -> ObjTypeDecl Stage1 I Annot -> M Annot (ObjTypeDecl Stage2 I Annot)
 objTypeDeclToStage2 path = \case
-  (AssertPosStatement expr annot) -> AssertPosStatement <$> toStage2Expr expr <*> pure annot
+  (AssertPosStatement w expr annot) ->
+    AssertPosStatement w
+      <$> toStage2Expr expr
+      <*> pure annot
   (TypeSubStructure (Identity deferredBody) maybeIdent annot) ->
     let path' = maybe path (`pushId` path) maybeIdent
      in TypeSubStructure . Identity
@@ -185,7 +189,7 @@ registerBitsTypeRefToStage2 path = \case
       <*> pure annot
   RegisterBitsReference name annot -> return (RegisterBitsReference name annot)
   RegisterBitsJustBits expr annot -> RegisterBitsJustBits <$> toStage2Expr expr <*> pure annot
-  RegisterBitsAnonymousType anonType annot -> do
+  RegisterBitsAnonymousType _ anonType annot -> do
     ident <- internAnonymousBitsType path =<< anonymousBitsTypeToStage2 path anonType
     return $ RegisterBitsReference (identToName ident) annot
 
@@ -202,7 +206,7 @@ anonymousBitsTypeToStage2 path = \case
 
 objectTypeToStage2 :: Path -> ObjType Stage1 I Annot -> M Annot (ObjType Stage2 I Annot)
 objectTypeToStage2 path = \case
-  (AnonymousObjType (Identity body) annot) -> do
+  (AnonymousObjType _ (Identity body) annot) -> do
     body' <- objTypeBodyToStage2 path body
     identifier <- internObjType path body'
     return (ReferencedObjType (identToName identifier) annot)
diff --git a/src/Language/Fiddle/Compiler/Stage2.hs b/src/Language/Fiddle/Compiler/Stage2.hs
index 57b0b55..2035e3d 100644
--- a/src/Language/Fiddle/Compiler/Stage2.hs
+++ b/src/Language/Fiddle/Compiler/Stage2.hs
@@ -5,11 +5,11 @@
 
 -- Stage3 doesn't change much from Stage2. Stage3 primarily removes the assert
 -- statements and checks that they are consistent with the calculations.
-module Language.Fiddle.Compiler.Stage2 where
+module Language.Fiddle.Compiler.Stage2 (toStage3) where
 
 import Control.Monad (forM, forM_, unless, when)
 import Control.Monad.RWS (MonadState (get), MonadWriter (tell), gets, modify')
-import Data.Foldable (foldlM, Foldable (toList))
+import Data.Foldable (Foldable (toList), foldlM)
 import Data.Functor.Identity
 import qualified Data.IntMap as IntMap
 import Data.Kind (Type)
@@ -110,12 +110,6 @@ insertTypeSize (Identifier s _) size = do
                 insertScope fullName (Right size) (inScope stage3State)
             }
 
--- addTypeSize :: Identifier f a -> SizeBits -> Compile Stage3State ()
--- addTypeSize (Identifier s _) size = do
---   modify' $
---     \stage3State ->
---       stage3State {typeSizes = Map.insert (Text.unpack s) size (typeSizes stage3State)}
-
 lookupTypeSize :: Name I Annot -> Compile Stage3State SizeBits
 lookupTypeSize (Name idents a) = do
   let path = fmap (\(Identifier s _) -> Text.unpack s) idents
@@ -135,11 +129,6 @@ lookupTypeSize (Name idents a) = do
         ]
       compilationFailure
 
-expressionToStage3 :: Expression Stage2 f Annot -> Expression Stage3 f Annot
-expressionToStage3 = \case
-  LitNum n a -> LitNum n a
-  Var i a -> Var i a
-
 emptyState = Stage3State mempty mempty
 
 toStage3 :: FiddleUnit Stage2 I Annot -> Compile () (FiddleUnit Stage3 I Annot)
@@ -178,7 +167,10 @@ getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do
               tell
                 [ Diagnostic
                     Error
-                    (printf "Enum constant too large. Max allowed %d\n" ((2 :: Int) ^ declaredSize))
+                    ( printf
+                        "Enum constant too large. Max allowed %d\n"
+                        ((2 :: Int) ^ declaredSize)
+                    )
                     (unCommented (annot enumConst))
                 ]
 
@@ -186,7 +178,8 @@ getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do
         )
         IntMap.empty
         constants
-    let missing = filter (not . (`IntMap.member` imap)) [0 .. 2 ^ declaredSize - 1]
+    let missing =
+          filter (not . (`IntMap.member` imap)) [0 .. 2 ^ declaredSize - 1]
     unless (null missing) $
       tell
         [ Diagnostic
@@ -206,7 +199,8 @@ addCurrentScope s = do
   modify' $ \st@(Stage3State {scopePath = (ScopePath current others)}) ->
     st {scopePath = ScopePath (current ++ s) others}
 
-fiddleDeclToStage3 :: FiddleDecl Stage2 I Annot -> Compile Stage3State (FiddleDecl Stage3 I Annot)
+fiddleDeclToStage3 ::
+  FiddleDecl Stage2 I Annot -> Compile Stage3State (FiddleDecl Stage3 I Annot)
 fiddleDeclToStage3 = \case
   OptionDecl i1 i2 a -> return $ OptionDecl i1 i2 a
   PackageDecl n@(Name idents _) body a -> do
@@ -227,97 +221,120 @@ fiddleDeclToStage3 = \case
                 }
       )
     return $ UsingDecl n a
-  LocationDecl id expr a -> return $ LocationDecl id (expressionToStage3 expr) a
+  LocationDecl id expr a -> return $ LocationDecl id (switchStage expr) a
   BitsDecl id typ a -> do
     typeSize <- getTypeSize typ
     insertTypeSize id typeSize
-    BitsDecl id <$> bitTypeToStage3 typ <*> pure a
+    return $ BitsDecl id (switchStage typ) a
   ObjTypeDecl ident body a ->
-    ObjTypeDecl ident <$> mapM (\bt -> fst <$> objTypeBodyToStage3 bt 0) body <*> pure a
+    ObjTypeDecl ident
+      <$> mapM (\bt -> fst <$> objTypeBodyToStage3 bt 0) body
+      <*> pure a
   ImportDecl importStatement a -> return $ ImportDecl importStatement a
   ObjectDecl ident expr typ a ->
-    ObjectDecl ident (expressionToStage3 expr) <$> objTypeToStage3 typ <*> pure a
+    ObjectDecl
+      ident
+      (switchStage expr)
+      <$> objTypeToStage3 typ
+      <*> pure a
 
-objTypeToStage3 :: ObjType Stage2 I Annot -> Compile Stage3State (ObjType Stage3 I Annot)
+objTypeToStage3 ::
+  ObjType Stage2 I Annot -> Compile Stage3State (ObjType Stage3 I Annot)
 objTypeToStage3 = \case
   ArrayObjType objtype expr a ->
     ArrayObjType
       <$> objTypeToStage3 objtype
-      <*> pure (expressionToStage3 expr)
+      <*> pure (switchStage expr)
       <*> pure a
   ReferencedObjType ident a -> return $ ReferencedObjType ident a
 
 registerBodyToStage3 ::
   RegisterBody Stage2 I Annot ->
   Compile Stage3State (RegisterBody Stage3 I Annot, Word32)
-registerBodyToStage3 (RegisterBody bodyType (Identity deferredRegisterBody) a') = do
-  let isUnion = case bodyType of
-        Union {} -> True
-        _ -> False
-
-  case deferredRegisterBody of
-    DeferredRegisterBody decls a -> do
-      (cur, returned) <-
-        foldlM
-          ( \(cursor, returned) decl ->
-              case undirected decl of
-                ReservedBits expr a -> do
-                  size <- fromIntegral <$> exprToSize expr
-                  let s3 = mapDirected (const $ ReservedBits (expressionToStage3 expr) a) decl
-                  if isUnion
-                    then checkUnion cursor size (s3 : returned) a
-                    else
-                      return (cursor + size, s3 : returned)
-                BitsSubStructure registerBody maybeIdent annot -> do
-                  checkBitsSubStructure registerBody maybeIdent annot
-
-                  (newBody, subsize) <- registerBodyToStage3 registerBody
-                  let s3 = mapDirected (const $ BitsSubStructure newBody maybeIdent annot) decl
-
-                  if isUnion
-                    then checkUnion cursor subsize (s3 : returned) a
-                    else
-                      return (cursor + subsize, s3 : returned)
-                DefinedBits modifier identifier typeref a -> do
-                  (s3TypeRef, size) <- registerBitsTypeRefToStage3 typeref
-                  let s3 = mapDirected (const $ DefinedBits modifier identifier s3TypeRef a) decl
-
-                  if isUnion
-                    then checkUnion cursor size (s3 : returned) a
-                    else
-                      return (cursor + size, s3 : returned)
+registerBodyToStage3
+  (RegisterBody bodyType (Identity deferredRegisterBody) a') = do
+    let isUnion = case bodyType of
+          Union {} -> True
+          _ -> False
+
+    case deferredRegisterBody of
+      DeferredRegisterBody decls a -> do
+        (cur, returned) <-
+          foldlM
+            ( \(cursor, returned) decl ->
+                case undirected decl of
+                  ReservedBits expr a -> do
+                    size <- fromIntegral <$> exprToSize expr
+                    let s3 =
+                          mapDirected
+                            (const $ ReservedBits (switchStage expr) a)
+                            decl
+                    if isUnion
+                      then checkUnion cursor size (s3 : returned) a
+                      else
+                        return (cursor + size, s3 : returned)
+                  BitsSubStructure registerBody maybeIdent annot -> do
+                    checkBitsSubStructure registerBody maybeIdent annot
+
+                    (newBody, subsize) <- registerBodyToStage3 registerBody
+                    let s3 =
+                          mapDirected
+                            (const $ BitsSubStructure newBody maybeIdent annot)
+                            decl
+
+                    if isUnion
+                      then checkUnion cursor subsize (s3 : returned) a
+                      else
+                        return (cursor + subsize, s3 : returned)
+                  DefinedBits modifier identifier typeref a -> do
+                    (s3TypeRef, size) <- registerBitsTypeRefToStage3 typeref
+                    let s3 =
+                          mapDirected
+                            (const $ DefinedBits modifier identifier s3TypeRef a)
+                            decl
+
+                    if isUnion
+                      then checkUnion cursor size (s3 : returned) a
+                      else
+                        return (cursor + size, s3 : returned)
+            )
+            (0, [])
+            decls
+
+        return
+          ( RegisterBody
+              bodyType
+              (Identity (DeferredRegisterBody (reverse returned) a))
+              a',
+            cur
           )
-          (0, [])
-          decls
-
-      return (RegisterBody bodyType (Identity (DeferredRegisterBody (reverse returned) a)) a', cur)
-  where
-    checkBitsSubStructure
-      (RegisterBody bodyType (Identity (DeferredRegisterBody decls _)) _)
-      maybeIdent
-      annot =
-        let emitWarning s = tell [Diagnostic Warning s (unCommented annot)]
-         in case () of
-              ()
-                | [_] <- decls,
-                  (Union {}) <- bodyType ->
-                    emitWarning "Union with a single field. Should this be a struct?"
-              ()
-                | [_] <- decls,
-                  (Struct {}) <- bodyType,
-                  Nothing <- maybeIdent ->
-                    emitWarning "Anonymous sub-struct with single field is superfluous."
-              ()
-                | [] <- decls ->
-                    emitWarning
-                      ( printf
-                          "Empty sub-%s is superfluous."
-                          ( case bodyType of
-                              Union {} -> "union"
-                              Struct {} -> "struct"
-                          )
-                      )
-              _ -> return ()
+    where
+      checkBitsSubStructure
+        (RegisterBody bodyType (Identity (DeferredRegisterBody decls _)) _)
+        maybeIdent
+        annot =
+          let emitWarning s = tell [Diagnostic Warning s (unCommented annot)]
+           in case () of
+                ()
+                  | [_] <- decls,
+                    (Union {}) <- bodyType ->
+                      emitWarning "Union with a single field. Should this be a struct?"
+                ()
+                  | [_] <- decls,
+                    (Struct {}) <- bodyType,
+                    Nothing <- maybeIdent ->
+                      emitWarning "Anonymous sub-struct with single field is superfluous."
+                ()
+                  | [] <- decls ->
+                      emitWarning
+                        ( printf
+                            "Empty sub-%s is superfluous."
+                            ( case bodyType of
+                                Union {} -> "union"
+                                Struct {} -> "struct"
+                            )
+                        )
+                _ -> return ()
 
 checkUnion :: Word32 -> Word32 -> b -> Commented SourceSpan -> Compile Stage3State (Word32, b)
 checkUnion cursor subsize ret a = do
@@ -344,13 +361,13 @@ registerBitsTypeRefToStage3 = \case
     (ref', size) <- registerBitsTypeRefToStage3 ref
     multiplier <- exprToSize expr
     return
-      ( RegisterBitsArray ref' (expressionToStage3 expr) a,
+      ( RegisterBitsArray ref' (switchStage expr) a,
         size * fromIntegral multiplier
       )
   RegisterBitsReference name a ->
     (RegisterBitsReference name a,) <$> lookupTypeSize name
   RegisterBitsJustBits expr a ->
-    (RegisterBitsJustBits (expressionToStage3 expr) a,)
+    (RegisterBitsJustBits (switchStage expr) a,)
       . fromIntegral
       <$> exprToSize expr
 
@@ -374,7 +391,7 @@ objTypeBodyToStage3 (ObjTypeBody bodyType decls a) startOff = do
                           RegisterDecl
                             mMod
                             mIdent
-                            (expressionToStage3 expr)
+                            (switchStage expr)
                             s3RegisterBody
                             a
                       )
@@ -440,13 +457,13 @@ objTypeBodyToStage3 (ObjTypeBody bodyType decls a) startOff = do
                       (unCommented a)
                   ]
               let size = size' `div` 8
-              let s3 = mapDirected (const $ ReservedDecl (expressionToStage3 expr) annot) decl
+              let s3 = mapDirected (const $ ReservedDecl (switchStage expr) annot) decl
               if isUnion
                 then
                   checkUnion cursor size (s3 : returned) a
                 else
                   return (cursor + size, s3 : returned)
-            AssertPosStatement expr a -> do
+            AssertPosStatement _ expr a -> do
               declaredPos <- fromIntegral <$> exprToSize expr
 
               let expectedPos = if isUnion then startOff else cursor + startOff
@@ -500,21 +517,6 @@ objTypeBodyToStage3 (ObjTypeBody bodyType decls a) startOff = do
     pushApply (Just (a, b)) = (Just a, Just b)
     pushApply Nothing = (Nothing, Nothing)
 
-bitTypeToStage3 :: BitType Stage2 I Annot -> Compile Stage3State (BitType Stage3 I Annot)
-bitTypeToStage3 (EnumBitType expr body a) =
-  EnumBitType (expressionToStage3 expr)
-    <$> mapM enumBodyToStage3 body
-    <*> pure a
-
-enumBodyToStage3 :: EnumBody Stage2 I Annot -> Compile Stage3State (EnumBody Stage3 I Annot)
-enumBodyToStage3 (EnumBody constants a) =
-  EnumBody <$> mapM (mapDirectedM enumConstantDeclToStage3) constants <*> pure a
-
-enumConstantDeclToStage3 :: EnumConstantDecl Stage2 I Annot -> Compile Stage3State (EnumConstantDecl Stage3 I Annot)
-enumConstantDeclToStage3 = \case
-  EnumConstantDecl ident expr a -> return $ EnumConstantDecl ident (expressionToStage3 expr) a
-  EnumConstantReserved expr a -> return $ EnumConstantReserved (expressionToStage3 expr) a
-
 packageBodyToStage3 :: PackageBody Stage2 I Annot -> Compile Stage3State (PackageBody Stage3 I Annot)
 packageBodyToStage3 (PackageBody decls a) =
   PackageBody <$> mapM (mapDirectedM fiddleDeclToStage3) decls <*> pure a
diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index 598336a..59db6aa 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -14,6 +14,7 @@ import Control.Monad.Writer (execWriter, tell)
 import Data.Aeson (Value (..), foldable, object, toEncoding, toJSON)
 import Data.Aeson.Encoding (text)
 import Data.Aeson.Types as Aeson
+import Data.Foldable (Foldable (toList))
 import qualified Data.Foldable
 import Data.Functor.Classes (Show1, liftShowsPrec)
 import Data.Kind (Type)
@@ -32,7 +33,8 @@ type Context stage =
   ( Show (NumberType stage),
     Typeable stage,
     ToGenericSyntaxTree (ImportType stage),
-    Typeable (ImportType stage)
+    Typeable (ImportType stage),
+    ToGenericSyntaxTreeValue (NumberType stage)
   )
 
 data GenericSyntaxTree f a where
@@ -89,17 +91,25 @@ instance (Foldable f, ToJSON a) => ToJSON (GenericSyntaxTree f a) where
     (SyntaxTreeValue s) -> text (Data.Text.pack s)
 
 class ToGenericSyntaxTreeValue v where
-  toGenericSyntaxTreeValue :: forall f a. v -> GenericSyntaxTree f a
+  toGenericSyntaxTreeValue :: forall f a. v -> Maybe (GenericSyntaxTree f a)
   default toGenericSyntaxTreeValue ::
-    forall f a. (Show v) => v -> GenericSyntaxTree f a
-  toGenericSyntaxTreeValue = SyntaxTreeValue . show
+    forall f a. (Show v) => v -> Maybe (GenericSyntaxTree f a)
+  toGenericSyntaxTreeValue = Just . SyntaxTreeValue . show
 
 instance ToGenericSyntaxTreeValue Data.Text.Text where
-  toGenericSyntaxTreeValue = SyntaxTreeValue . Data.Text.unpack
+  toGenericSyntaxTreeValue = Just . SyntaxTreeValue . Data.Text.unpack
+
+instance (Show s, Num s) => ToGenericSyntaxTreeValue s where
+  toGenericSyntaxTreeValue = Just . SyntaxTreeValue . show
+
+-- Witnesses exist just for type level meta programming, don't return anything
+-- if we don't need it.
+instance ToGenericSyntaxTreeValue (Witness b) where
+  toGenericSyntaxTreeValue _ = Nothing
 
 type GenericContext t f a = (Traversable f, ToGenericSyntaxTree t, Typeable t, Typeable f, Typeable a)
 
-class ToGenericSyntaxTree (t :: SynTreeKind) where
+class ToGenericSyntaxTree (t :: SynTree) where
   toGenericSyntaxTree :: (Traversable f, Typeable f, Typeable t, Typeable a) => t f a -> GenericSyntaxTree f a
   default toGenericSyntaxTree ::
     (GenericContext t f a, Generic (t f a), (GToGenericSyntaxTree (Rep (t f a)) f a)) =>
@@ -114,7 +124,7 @@ class GToMemberList r f a where
   gToMemberList :: Int -> r x -> [GenericSyntaxTree f a]
 
 instance (ToGenericSyntaxTreeValue v) => GToMemberList (Rec0 v) f a where
-  gToMemberList _ = (: []) . toGenericSyntaxTreeValue . unK1
+  gToMemberList _ = toList . toGenericSyntaxTreeValue . unK1
 
 instance
   (GenericContext r f a) =>
@@ -195,64 +205,19 @@ deriving instance (ToGenericSyntaxTree ImportList)
 
 deriving instance (ToGenericSyntaxTree ImportStatement)
 
-deriving instance (ToGenericSyntaxTree t, Typeable t) => (ToGenericSyntaxTree (Directed t))
+deriving instance
+  (Context stage, ToGenericSyntaxTree (t stage), Typeable t) =>
+  (ToGenericSyntaxTree (Directed t stage))
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (FiddleUnit stage))
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (FiddleDecl stage))
 
-instance (Context stage) => ToGenericSyntaxTree (ObjType stage) where
-  toGenericSyntaxTree t = case t of
-    (AnonymousObjType body annot) ->
-      SyntaxTreeDeferred $
-        fmap
-          ( \body' ->
-              SyntaxTreeObject
-                "AnonymousObjType"
-                [toGenericSyntaxTree body']
-                annot
-                body'
-          )
-          body
-    (ArrayObjType arr expr annot) ->
-      SyntaxTreeObject
-        "ArrayObjType"
-        [toGenericSyntaxTree arr, toGenericSyntaxTree expr]
-        annot
-        t
-    (ReferencedObjType ident a) ->
-      SyntaxTreeObject "ReferencedObjType" [toGenericSyntaxTree ident] a t
+deriving instance (Context stage) => ToGenericSyntaxTree (ObjType stage)
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (ObjTypeBody stage))
 
-instance (Context stage) => (ToGenericSyntaxTree (ObjTypeDecl stage)) where
-  toGenericSyntaxTree t = case t of
-    (AssertPosStatement expr a) ->
-      SyntaxTreeObject "AssertPosStatement" [toGenericSyntaxTree expr] a t
-    (TypeSubStructure body mIdent a) ->
-      SyntaxTreeObject
-        "TypeSubStructure"
-        ( Data.Foldable.toList (toGenericSyntaxTree <$> body)
-            ++ Data.Foldable.toList (toGenericSyntaxTree <$> mIdent)
-        )
-        a
-        t
-    (ReservedDecl expr a) ->
-      SyntaxTreeObject
-        "ReservedDecl"
-        [toGenericSyntaxTree expr]
-        a
-        t
-    (RegisterDecl mMod mIdent expr mBody a) ->
-      SyntaxTreeObject
-        "RegisterDecl"
-        ( Data.Foldable.toList (toGenericSyntaxTree <$> mMod)
-            ++ Data.Foldable.toList (toGenericSyntaxTree <$> mIdent)
-            ++ [toGenericSyntaxTree expr]
-            ++ Data.Foldable.toList (toGenericSyntaxTree <$> mBody)
-        )
-        a
-        t
+deriving instance (Context stage) => (ToGenericSyntaxTree (ObjTypeDecl stage))
 
 deriving instance (ToGenericSyntaxTreeValue ModifierKeyword)
 
@@ -264,20 +229,7 @@ deriving instance (Context stage) => (ToGenericSyntaxTree (RegisterBody stage))
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (RegisterBitsDecl stage))
 
-instance (Context stage) => ToGenericSyntaxTree (RegisterBitsTypeRef stage) where
-  toGenericSyntaxTree t = case t of
-    (RegisterBitsArray ref exp a) ->
-      SyntaxTreeObject
-        "RegisterBitsArray"
-        [toGenericSyntaxTree ref, toGenericSyntaxTree exp]
-        a
-        t
-    (RegisterBitsReference i a) ->
-      SyntaxTreeObject "RegisterBitsReference" [toGenericSyntaxTree i] a t
-    (RegisterBitsAnonymousType t a) ->
-      SyntaxTreeObject "RegisterBitsAnonymousType " [toGenericSyntaxTree t] a t
-    (RegisterBitsJustBits t a) ->
-      SyntaxTreeObject "RegisterBitsJustBits " [toGenericSyntaxTree t] a t
+deriving instance (Context stage) => ToGenericSyntaxTree (RegisterBitsTypeRef stage)
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (AnonymousBitsType stage))
 
@@ -289,7 +241,4 @@ deriving instance (Context stage) => (ToGenericSyntaxTree (EnumConstantDecl stag
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (PackageBody stage))
 
-instance (Context stage) => (ToGenericSyntaxTree (Expression stage)) where
-  toGenericSyntaxTree tr = case tr of
-    LitNum t a -> SyntaxTreeObject "LitNum" [SyntaxTreeValue (show t)] a tr
-    Var t a -> SyntaxTreeObject "LitNum" [toGenericSyntaxTree t] a tr
+deriving instance (Context stage) => (ToGenericSyntaxTree (Expression stage))
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index b44a9a1..85ae65e 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -52,7 +52,7 @@ isComment (Token t _) =
 stripTrailingComments :: [Token s] -> [Token s]
 stripTrailingComments = reverse . dropWhile isComment . reverse
 
-directed :: Pa t -> PaS (Directed (t 'Stage1))
+directed :: Pa t -> PaS (Directed t 'Stage1)
 directed subparser = withMeta $ do
   Directed <$> many directive <*> subparser
 
@@ -195,7 +195,7 @@ objType = do
       (ReferencedObjType <$> name)
         <|> ( do
                 t <- bodyType
-                AnonymousObjType <$> defer body (objTypeBody t)
+                AnonymousObjType (Witness ()) <$> defer body (objTypeBody t)
             )
 
 exprInParen :: Pa Expression
@@ -211,7 +211,7 @@ objTypeDecl =
   withMeta $
     ( do
         tok KWAssertPos
-        AssertPosStatement <$> exprInParen
+        AssertPosStatement (Witness ()) <$> exprInParen
     )
       <|> ( do
               tok KWReserved
@@ -291,7 +291,7 @@ registerBitsTypeRef = do
     baseTypeRef =
       withMeta $
         (RegisterBitsJustBits <$> exprInParen)
-          <|> (RegisterBitsAnonymousType <$> anonymousBitsType)
+          <|> (RegisterBitsAnonymousType (Witness ()) <$> anonymousBitsType)
           <|> (RegisterBitsReference <$> name)
 
 anonymousBitsType :: Pa AnonymousBitsType