Some major changes to the structure of the language.

Added structures and unions to better define the layout and model
overlapping concerns.

renamed objtype -> type and object -> instance.

added reserved statements for types.

1 files changed, 32 insertions, 3 deletions

diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
index d440a44..8352975 100644
--- a/src/Language/Fiddle/Ast.hs
+++ b/src/Language/Fiddle/Ast.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -5,7 +6,6 @@
 {-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ConstraintKinds #-}
 
 module Language.Fiddle.Ast where
 
@@ -18,6 +18,8 @@ import Data.Typeable
 import GHC.Generics
 import GHC.TypeLits
 
+-- The type of a number at each stage in compilation. Numbers should be parsed
+-- in Stage2.
 type family NumberType (a :: Stage) where
   NumberType Stage1 = Text
   NumberType Stage2 = Integer
@@ -88,7 +90,7 @@ data FiddleDecl (stage :: Stage) (f :: Type -> Type) a where
   deriving (Generic, Annotated, Alter, Typeable)
 
 data ObjTypeBody (stage :: Stage) (f :: Type -> Type) a where
-  ObjTypeBody :: [ObjTypeDecl stage f a] -> a -> ObjTypeBody stage f a
+  ObjTypeBody :: BodyType f a -> [ObjTypeDecl stage f a] -> a -> ObjTypeBody stage f a
   deriving (Generic, Annotated, Alter, Typeable)
 
 data ObjType stage f a where
@@ -119,6 +121,14 @@ data ObjTypeDecl stage f a where
     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
@@ -134,8 +144,13 @@ data DeferredRegisterBody stage f a where
     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 :: f (DeferredRegisterBody stage f a) -> a -> RegisterBody stage f a
+  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
@@ -148,6 +163,11 @@ data RegisterBitsDecl stage f a where
     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
@@ -195,6 +215,15 @@ instance Alter (ObjTypeDecl stage) where
         <*> 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