Implement qualification.

Big change. Implements qualification, which separates the qualification
concerns from the ConsistencyCheck phase.

I'm getting close to implementing a backend.

3 files changed, 32 insertions, 26 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/Instances.hs b/src/Language/Fiddle/Ast/Internal/Instances.hs
index 232d5c0..aaa20b8 100644
--- a/src/Language/Fiddle/Ast/Internal/Instances.hs
+++ b/src/Language/Fiddle/Ast/Internal/Instances.hs
@@ -120,8 +120,8 @@ class
       stage
       ( t
           (StageAfter stage) -- The next stage in the pipeline
-          (StageFunctor stage) -- The functor associated with the next stage
-          (StageAnnotation stage) -- Annotation type for the next stage
+          (StageFunctor stage) -- The functor associated with this stage
+          (StageAnnotation stage) -- Annotation type for this stage
       )
 
   -- | Default implementation of 'advanceStage' using generics. This leverages
@@ -311,6 +311,12 @@ instance
     K1 <$> ffn newK
 
 instance
+  (Traversable f1) =>
+  GAlter t f1 f2 a1 a2 (Rec0 (f1 x)) (Rec0 (f2 x))
+  where
+  galter _ ffn _ (K1 k) = K1 <$> ffn k
+
+instance
   ( GAlter t f1 f2 a1 a2 l1 l2,
     GAlter t f1 f2 a1 a2 r1 r2
   ) =>
diff --git a/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs b/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
index d80963d..221dd5b 100644
--- a/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
+++ b/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
@@ -1,8 +1,16 @@
-module Language.Fiddle.Ast.Internal.Instances.Walk (Walk (..), GWalk (..)) where
+module Language.Fiddle.Ast.Internal.Instances.Walk (Walk (..), GWalk (..), walk_) where
 
 import Data.Typeable
 import GHC.Generics
 
+-- | Like walk, but assumes no local state.
+walk_ ::
+  (Monad m, Traversable f, Typeable f, Typeable a, Walk t) =>
+  (forall t'. (Walk t', Typeable t', Typeable f, Typeable a) => t' f a -> m ()) ->
+  t f a ->
+  m ()
+walk_ fn t = walk (\t _ -> fn t) t ()
+
 class (Typeable t) => Walk t where
   walk ::
     (Monad m, Traversable f, Typeable f, Typeable a) =>
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index 8e3cd6c..73c4303 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -12,6 +12,7 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     ImportInterface,
     FiddleUnitInterface,
     QualificationMetadata,
+    CommonQualificationData (..),
     -- Witness Types
     Witness (..),
     WitnessType,
@@ -48,18 +49,13 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     mapDirectedM,
     asDirected,
     undirected,
-    -- Utility Functions
-    squeeze,
-    nameToList,
   )
 where
 
 import Control.Monad (forM_)
-import Data.Functor.Identity
 import Data.Kind (Type)
 import Data.List.NonEmpty hiding (map)
 import Data.Text (Text)
-import qualified Data.Text as Text
 import Data.Type.Bool
 import Data.Typeable
 import Data.Void (Void)
@@ -67,11 +63,11 @@ import GHC.Generics
 import Language.Fiddle.Ast.Internal.Instances
 import Language.Fiddle.Ast.Internal.Kinds
 import Language.Fiddle.Ast.Internal.Stage
-import Language.Fiddle.Internal.UnitInterface (UnitInterface)
+import Language.Fiddle.Internal.UnitInterface
 
 -- | Common data for each qualified element.
-newtype CommonQualifcationData
-  = CommonQualifcationData
+newtype CommonQualificationData
+  = CommonQualificationData
   { -- The fully qualified path to this qualified element.
     fullyQualifiedPath :: [String]
   }
@@ -79,7 +75,7 @@ newtype CommonQualifcationData
 
 type family QualificationMetadata stage t where
   QualificationMetadata stage t =
-    If (stage < Qualified) () (CommonQualifcationData, t)
+    If (stage < Qualified) () t
 
 -- | The type attached to import statements which describe the imported file's
 -- unit interface
@@ -278,7 +274,7 @@ data Expression (s :: Stage) :: SynTree where
   -- | A variable reference.
   Var ::
     { -- | The identifier of the variable.
-      varIdentifier :: Identifier f a,
+      varIdentifier :: Name f a,
       -- | Annotation for the variable.
       varAnnot :: a
     } ->
@@ -348,7 +344,8 @@ data FiddleDecl :: StagedSynTree where
   -- | A package declaration.
   PackageDecl ::
     { -- | Qualification metadata about this package statement.
-      packageQualificationMetadata :: QualificationMetadata stage (),
+      packageQualificationMetadata ::
+        f (QualificationMetadata stage ExportedPackageDecl),
       -- | The package name.
       packageName :: Name f a,
       -- | The body of the package.
@@ -360,7 +357,8 @@ data FiddleDecl :: StagedSynTree where
   -- | A location declaration in the form 'location <identifier> = <expr>'.
   LocationDecl ::
     { -- | qualified metadata about this location.
-      locationQualificationMetadata :: QualificationMetadata stage (),
+      locationQualificationMetadata ::
+        f (QualificationMetadata stage ExportedLocationDecl),
       -- | The location identifier.
       locationIdent :: Identifier f a,
       -- | The associated expression.
@@ -372,7 +370,7 @@ data FiddleDecl :: StagedSynTree where
   -- | A bits declaration in the form 'bits <identifier> : <type>'.
   BitsDecl ::
     { -- | Qualification metadata about this "bits" declaration.
-      bitsQualificationMetadata :: QualificationMetadata stage (),
+      bitsQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl),
       -- | The identifier of the bits.
       bitsIdent :: Identifier f a,
       -- | The type of the bits.
@@ -384,7 +382,7 @@ data FiddleDecl :: StagedSynTree where
   -- | An object type declaration.
   ObjTypeDecl ::
     { -- | Qualification metadata about this object type.
-      objTypeQualificationMetadata :: QualificationMetadata stage (),
+      objTypeQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl),
       -- | The identifier of the object type.
       objTypeIdent :: Identifier f a,
       -- | The body of the object type.
@@ -396,7 +394,7 @@ data FiddleDecl :: StagedSynTree where
   -- | An object declaration in the form 'object <ident> at <expr> : <type>'.
   ObjectDecl ::
     { -- | Qualification metadata about this object.
-      objectQualificationMetadata :: QualificationMetadata stage (),
+      objectQualificationMetadata :: f (QualificationMetadata stage ExportedObjectDecl),
       -- | The identifier of the object.
       objectIdent :: Identifier f a,
       -- | The location expression.
@@ -448,7 +446,7 @@ data ObjType stage f a where
     ObjType stage f a
   -- | A reference to an existing type by name.
   ReferencedObjType ::
-    { refQualificationMetadata :: QualificationMetadata stage (),
+    { refQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl),
       -- | The name of the referenced type.
       refName :: Name f a,
       -- | Annotation for the referenced type.
@@ -609,7 +607,7 @@ data RegisterBitsTypeRef stage f a where
   -- | A reference to another type by name.
   RegisterBitsReference ::
     { -- | Qualification metadata about this Bits reference.
-      bitsRefQualificationMetadata :: QualificationMetadata stage (),
+      bitsRefQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl),
       -- | The name of the referenced type.
       bitsRefName :: Name f a,
       -- | Annotation for the reference.
@@ -714,9 +712,3 @@ data PackageBody (stage :: Stage) (f :: Type -> Type) a where
     } ->
     PackageBody stage f a
   deriving (Generic, Annotated, Typeable, Alter, Walk)
-
-squeeze :: (Alter t, Traversable f, Monad f) => t f a -> f (t Identity a)
-squeeze = alter (fmap Identity) return
-
-nameToList :: Name f a -> [String]
-nameToList (Name ids _) = map (Text.unpack . identifierName) (toList ids)