1 files changed, 151 insertions, 0 deletions
diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
new file mode 100644
index 0000000..23fb05f
--- /dev/null
+++ b/src/Language/Fiddle/Ast.hs
@@ -0,0 +1,151 @@
+module Language.Fiddle.Ast where
+
+import Data.Text (Text)
+
+-- Stage of compilation. Parts of the AST maybe un unavailable with other stages
+-- as compilation simplifies the AST.
+data Stage = Stage1 | Stage2 | Stage3
+
+-- Just an identifier.
+data Identifier a = Identifier !Text a
+
+-- Expression.
+data Expression stage a where
+  -- Just a string. Parsing the number comes in stage2.
+  LitNum :: Text -> a -> Expression 'Stage1 a
+  RealNum :: Integer -> a -> Expression 'Stage2 a
+  Var :: Identifier a -> a -> Expression stage a
+
+-- Root of the parse tree. Just contains a list of declarations.
+data FiddleUnit (stage :: Stage) (f :: * -> *) a where
+  FiddleUnit :: [FiddleDecl stage f a] -> a -> FiddleUnit stage f a
+
+-- Top-level declarations.
+data FiddleDecl (stage :: Stage) (f :: * -> *) a where
+  {-
+   - An option is a key/value pair.
+   - option <ident> <ident>;
+   -}
+  OptionDecl :: Identifier a -> Identifier a -> a -> FiddleDecl stage f a
+  {- Package Statement. Package Name, Package body -}
+  PackageDecl ::
+    Identifier a ->
+    f (PackageBody stage f a) ->
+    a ->
+    FiddleDecl stage f a
+  {- location <identifier> = <expr>. -}
+  LocationDecl ::
+    Identifier a ->
+    Expression stage a ->
+    a ->
+    FiddleDecl stage f a
+  {- bits <identifier> : <type> -}
+  BitsDecl ::
+    Identifier a ->
+    BitType stage f a ->
+    a ->
+    FiddleDecl stage f a
+  {- objtype <identifier> : <type> -}
+  ObjTypeDecl ::
+    Identifier a ->
+    f (ObjTypeBody stage f a) ->
+    a ->
+    FiddleDecl stage f a
+  {- object <ident> at <expr> : <type> -}
+  ObjectDecl ::
+    Identifier a ->
+    Expression stage a ->
+    ObjType stage f a ->
+    a ->
+    FiddleDecl stage f a
+
+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 a -> a -> ObjType stage f a
+  -- <identifier>
+  ReferencedObjType :: Identifier a -> a -> ObjType stage f a
+
+data ObjTypeBody (stage :: Stage) (f :: * -> *) a where
+  ObjTypeBody :: [ObjTypeDecl stage f a] -> a -> ObjTypeBody stage f a
+
+data ObjTypeDecl stage f a where
+  {- assert_pos(<expr>) -}
+  AssertPosStatement :: Expression stage a -> a -> ObjTypeDecl stage f a
+  {- reg <ident>(<expr>) : <regtype> -}
+  RegisterDecl ::
+    Maybe (Modifier a) ->
+    Maybe (Identifier a) ->
+    Expression stage a ->
+    Maybe (RegisterBody stage f a) ->
+    a ->
+    ObjTypeDecl stage f a
+
+data Modifier a where
+  ModifierKeyword :: ModifierKeyword -> a -> Modifier a
+
+data ModifierKeyword = Rw | Ro | Wo
+
+data DeferredRegisterBody stage f a where
+  DeferredRegisterBody ::
+    [RegisterBitsDecl stage f a] ->
+    a ->
+    DeferredRegisterBody stage f a
+
+data RegisterBody stage f a where
+  RegisterBody :: f (DeferredRegisterBody stage f a) -> a -> RegisterBody stage f a
+
+data RegisterBitsDecl stage f a where
+  -- reserved(<expr>)
+  ReservedBits :: Expression stage a -> a -> RegisterBitsDecl stage f a
+  -- <modifer> <ident> : <type>
+  DefinedBits ::
+    Maybe (Modifier a) ->
+    Identifier a ->
+    RegisterBitsTypeRef stage f a ->
+    a ->
+    RegisterBitsDecl stage f a
+
+data RegisterBitsTypeRef stage f a where
+  -- <type>[<expr>]
+  RegisterBitsArray ::
+    RegisterBitsTypeRef stage f a ->
+    Expression stage a ->
+    a ->
+    RegisterBitsTypeRef stage f a
+  {- Reference to a type. -}
+  RegisterBitsReference :: Identifier a -> a -> RegisterBitsTypeRef stage f a
+  {- enum(<expr>) { <body> }
+     Anonymous types are only allowed in stage1.
+     Stage2 should de-anonymize these type. -}
+  RegisterBitsAnonymousType ::
+    AnonymousBitsType f a ->
+    a ->
+    RegisterBitsTypeRef 'Stage1 f a
+
+data AnonymousBitsType f a where
+  -- enum(<expr>) { <body> }
+  AnonymousEnumBody :: Expression 'Stage1 a -> f (EnumBody stage f a) -> a -> AnonymousBitsType f a
+
+data BitType (stage :: Stage) (f :: * -> *) a where
+  -- enum(<expr>) { <body> }
+  EnumBitType :: Expression stage a -> f (EnumBody stage f a) -> a -> BitType stage f a
+  -- (<expr>)
+  RawBits :: Expression stage a -> a -> BitType stage f a
+
+data EnumBody (stage :: Stage) (f :: * -> *) a where
+  -- <decl>,
+  EnumBody :: [EnumConstantDecl stage a] -> a -> EnumBody stage f a
+
+data EnumConstantDecl stage a where
+  -- <ident> = <expr>
+  EnumConstantDecl :: Identifier a -> Expression stage a -> a -> EnumConstantDecl stage a
+  -- reserved = <expr>
+  EnumConstantReserved :: Expression stage a -> a -> EnumConstantDecl stage a
+
+data PackageBody (stage :: Stage) (f :: * -> *) a where
+  {- The body of a package -}
+  PackageBody :: [FiddleDecl stage f a] -> a -> PackageBody stage f a