Add Stage3 compliation.

I think this is the last phase before sending the refined AST to the
backend compiler to be processed.

1 files changed, 23 insertions, 20 deletions

diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
index 277ab24..d440a44 100644
--- a/src/Language/Fiddle/Ast.hs
+++ b/src/Language/Fiddle/Ast.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds #-}
 
 module Language.Fiddle.Ast where
 
@@ -33,14 +34,14 @@ data FiddleUnit (stage :: Stage) (f :: Type -> Type) a where
   deriving (Generic, Annotated, Alter, Typeable)
 
 -- Just an identifier.
-data Identifier stage f a = Identifier !Text a
+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 stage f a -> a -> Expression stage f a
+  Var :: Identifier f a -> a -> Expression stage f a
 
 -- Top-level declarations.
 data FiddleDecl (stage :: Stage) (f :: Type -> Type) a where
@@ -49,37 +50,37 @@ data FiddleDecl (stage :: Stage) (f :: Type -> Type) a where
    - option <ident> <ident>;
    -}
   OptionDecl ::
-    Identifier stage f a ->
-    Identifier stage f a ->
+    Identifier f a ->
+    Identifier f a ->
     a ->
     FiddleDecl stage f a
   {- Package Statement. Package Name, Package body -}
   PackageDecl ::
-    Identifier stage f a ->
+    Identifier f a ->
     f (PackageBody stage f a) ->
     a ->
     FiddleDecl stage f a
   {- location <identifier> = <expr>. -}
   LocationDecl ::
-    Identifier stage f a ->
+    Identifier f a ->
     Expression stage f a ->
     a ->
     FiddleDecl stage f a
   {- bits <identifier> : <type> -}
   BitsDecl ::
-    Identifier stage f a ->
+    Identifier f a ->
     BitType stage f a ->
     a ->
     FiddleDecl stage f a
   {- objtype <identifier> : <type> -}
   ObjTypeDecl ::
-    Identifier stage f a ->
+    Identifier f a ->
     f (ObjTypeBody stage f a) ->
     a ->
     FiddleDecl stage f a
   {- object <ident> at <expr> : <type> -}
   ObjectDecl ::
-    Identifier stage f a ->
+    Identifier f a ->
     Expression stage f a ->
     ObjType stage f a ->
     a ->
@@ -98,28 +99,30 @@ data ObjType stage f a where
   -- <type>[<expr>]
   ArrayObjType :: ObjType stage f a -> Expression stage f a -> a -> ObjType stage f a
   -- <identifier>
-  ReferencedObjType :: Identifier stage f a -> a -> ObjType stage f a
+  ReferencedObjType :: Identifier f a -> a -> ObjType stage f a
   deriving (Typeable)
 
+type StageLessThan stage (n :: Natural) = (CmpNat (StageNumber stage) n ~ LT)
+
 data ObjTypeDecl stage f a where
   {- assert_pos(<expr>) -}
   AssertPosStatement ::
-    (CmpNat (StageNumber stage) 3 ~ LT) =>
+    (StageLessThan stage 3) =>
     Expression stage f a ->
     a ->
     ObjTypeDecl stage f a
   {- reg <ident>(<expr>) : <regtype> -}
   RegisterDecl ::
-    Maybe (Modifier stage f a) ->
-    Maybe (Identifier stage f a) ->
+    Maybe (Modifier f a) ->
+    Maybe (Identifier f a) ->
     Expression stage f a ->
     Maybe (RegisterBody stage f a) ->
     a ->
     ObjTypeDecl stage f a
   deriving (Typeable)
 
-data Modifier stage f a where
-  ModifierKeyword :: ModifierKeyword -> a -> Modifier stage f a
+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)
@@ -140,8 +143,8 @@ data RegisterBitsDecl stage f a where
   ReservedBits :: Expression stage f a -> a -> RegisterBitsDecl stage f a
   -- <modifer> <ident> : <type>
   DefinedBits ::
-    Maybe (Modifier stage f a) ->
-    Identifier stage f a ->
+    Maybe (Modifier f a) ->
+    Identifier f a ->
     RegisterBitsTypeRef stage f a ->
     a ->
     RegisterBitsDecl stage f a
@@ -155,7 +158,7 @@ data RegisterBitsTypeRef stage f a where
     a ->
     RegisterBitsTypeRef stage f a
   {- Reference to a type. -}
-  RegisterBitsReference :: Identifier stage f a -> a -> RegisterBitsTypeRef stage f a
+  RegisterBitsReference :: Identifier f a -> a -> RegisterBitsTypeRef stage f a
   {- enum(<expr>) { <body> }
      Anonymous types are only allowed in stage1.
      Stage2 should de-anonymize these type. -}
@@ -258,7 +261,7 @@ data EnumBody (stage :: Stage) (f :: Type -> Type) a where
 
 data EnumConstantDecl stage f a where
   -- <ident> = <expr>
-  EnumConstantDecl :: Identifier stage f a -> Expression stage f a -> a -> EnumConstantDecl stage f a
+  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)
@@ -271,7 +274,7 @@ data PackageBody (stage :: Stage) (f :: Type -> Type) a where
 -- instance Alter (Modifier stage) where
 --   alter _ fn (ModifierKeyword m a) = ModifierKeyword m (fn a)
 --
--- instance Alter (Identifier stage) where
+-- instance Alter (Identifier) where
 --   alter _ fn (Identifier i a) = Identifier i $ fn a
 --
 -- instance Alter (Expression stage) where