More major changes to the grammer.

Added annotation sublanguage for defining compiler directives. Also
added the syntax for import statements. Imports are not implemented, but
I'm currently working on that.

6 files changed, 313 insertions, 54 deletions

diff --git a/src/Language/Fiddle/Ast.hs b/src/Language/Fiddle/Ast.hs
index 8352975..bb6605e 100644
--- a/src/Language/Fiddle/Ast.hs
+++ b/src/Language/Fiddle/Ast.hs
@@ -18,13 +18,79 @@ 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
+-- 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
+
+-- [[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
@@ -32,8 +98,10 @@ data Stage = Stage1 | Stage2 | Stage3
 
 -- Root of the parse tree. Just contains a list of declarations.
 data FiddleUnit (stage :: Stage) (f :: Type -> Type) a where
-  FiddleUnit :: [FiddleDecl stage f a] -> a -> FiddleUnit stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
+  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
@@ -45,6 +113,24 @@ data Expression stage f a where
   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
   {-
@@ -56,6 +142,10 @@ data FiddleDecl (stage :: Stage) (f :: Type -> Type) a where
     Identifier f a ->
     a ->
     FiddleDecl stage f a
+  ImportDecl ::
+    ImportType stage f a ->
+    a ->
+    FiddleDecl stage f a
   {- Package Statement. Package Name, Package body -}
   PackageDecl ::
     Identifier f a ->
@@ -87,10 +177,16 @@ data FiddleDecl (stage :: Stage) (f :: Type -> Type) a where
     ObjType stage f a ->
     a ->
     FiddleDecl stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
+  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 -> [ObjTypeDecl stage f a] -> a -> ObjTypeBody stage f a
+  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
@@ -139,7 +235,7 @@ data ModifierKeyword = Rw | Ro | Wo deriving (Eq, Ord, Show, Read, Typeable)
 
 data DeferredRegisterBody stage f a where
   DeferredRegisterBody ::
-    [RegisterBitsDecl stage f a] ->
+    [Directed (RegisterBitsDecl stage) f a] ->
     a ->
     DeferredRegisterBody stage f a
   deriving (Generic, Annotated, Alter, Typeable)
@@ -150,7 +246,11 @@ data BodyType (f :: Type -> Type) a where
   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
+  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
@@ -207,7 +307,8 @@ instance Annotated (Expression stage) where
 
 instance Alter (ObjTypeDecl stage) where
   alter ffn fn = \case
-    (AssertPosStatement expr a) -> AssertPosStatement <$> alter ffn fn expr <*> fn a
+    (AssertPosStatement expr a) ->
+      AssertPosStatement <$> alter ffn fn expr <*> fn a
     (RegisterDecl mMod mIdent expr mBody a) ->
       RegisterDecl
         <$> mapM (alter ffn fn) mMod
@@ -285,20 +386,29 @@ data BitType (stage :: Stage) (f :: Type -> Type) a where
 
 data EnumBody (stage :: Stage) (f :: Type -> Type) a where
   -- <decl>,
-  EnumBody :: [EnumConstantDecl stage f a] -> a -> EnumBody stage f a
+  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
+  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
+  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 :: [FiddleDecl stage f a] -> a -> PackageBody stage f a
-  deriving (Generic, Annotated, Alter, Typeable)
+  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)
@@ -315,7 +425,7 @@ data PackageBody (stage :: Stage) (f :: Type -> Type) a where
 proxyOf :: t f a -> Proxy t
 proxyOf _ = Proxy
 
-class Annotated (t :: (Type -> Type) -> Type -> Type) where
+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)
@@ -336,7 +446,7 @@ instance (GAnnot a r, GAnnot a l) => GAnnot a (l :+: r) where
 instance (GAnnot a r) => GAnnot a (M1 i c r) where
   gannot (M1 a) = gannot a
 
-class Alter (t :: (Type -> Type) -> Type -> Type) where
+class Alter (t :: SynTreeKind) where
   alter ::
     forall f1 f2 a1 a2 m.
     (Monad m, Traversable f1) =>
@@ -384,13 +494,19 @@ 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
+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
+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)
 
diff --git a/src/Language/Fiddle/Compiler/Stage1.hs b/src/Language/Fiddle/Compiler/Stage1.hs
index 25ee66b..2e3acbc 100644
--- a/src/Language/Fiddle/Compiler/Stage1.hs
+++ b/src/Language/Fiddle/Compiler/Stage1.hs
@@ -68,7 +68,7 @@ toStage2 (FiddleUnit decls annot) = do
       FiddleUnit <$> reconfigureFiddleDecls (Path []) decls <*> pure annot
   return a
 
-reconfigureFiddleDecls :: Path -> [FiddleDecl Stage1 I Annot] -> M Annot [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
   --   put (Stage2CompilerState [] [])
@@ -76,13 +76,13 @@ reconfigureFiddleDecls p decls = do
 
   lastState <- get
   put (Stage2CompilerState [] [])
-  decls <- mapM (fiddleDeclToStage2 p) decls
+  decls <- mapM (mapDirectedM $ fiddleDeclToStage2 p) decls
   (Stage2CompilerState anonymousObjTypes anonymousBitsTypes) <- get
   put lastState
 
   return $
-    map resolveAnonymousObjType anonymousObjTypes
-      ++ map resolveAnonymousBitsType anonymousBitsTypes
+    map (asDirected . resolveAnonymousObjType) anonymousObjTypes
+      ++ map (asDirected . resolveAnonymousBitsType) anonymousBitsTypes
       ++ decls
   where
     resolveAnonymousObjType (Linkage linkage, objTypeBody) =
@@ -104,6 +104,7 @@ fiddleDeclToStage2 path decl = do
     (LocationDecl i expr a) -> LocationDecl i <$> toStage2Expr expr <*> pure a
     (BitsDecl i typ a) -> BitsDecl i <$> bitsTypeToStage2 (pushId i path) typ <*> pure a
     (ObjTypeDecl i body a) -> ObjTypeDecl i <$> mapM (objTypeBodyToStage2 (pushId i path)) body <*> pure a
+    (ImportDecl importStatement a) -> return $ ImportDecl importStatement a
     (ObjectDecl i expr typ a) ->
       ObjectDecl i <$> toStage2Expr expr <*> objectTypeToStage2 (pushId i path) typ <*> pure a
 
@@ -115,7 +116,7 @@ bitsTypeToStage2 path = \case
 
 enumBodyToStage2 :: Path -> EnumBody Stage1 I Annot -> M Annot (EnumBody Stage2 I Annot)
 enumBodyToStage2 path = \case
-  EnumBody constants a -> EnumBody <$> mapM (enumConstantToStage2 path) constants <*> pure a
+  EnumBody constants a -> EnumBody <$> mapM (mapDirectedM (enumConstantToStage2 path)) constants <*> pure a
 
 enumConstantToStage2 :: Path -> EnumConstantDecl Stage1 I Annot -> M Annot (EnumConstantDecl Stage2 I Annot)
 enumConstantToStage2 path = \case
@@ -124,7 +125,7 @@ enumConstantToStage2 path = \case
 
 objTypeBodyToStage2 :: Path -> ObjTypeBody Stage1 I Annot -> M Annot (ObjTypeBody Stage2 I Annot)
 objTypeBodyToStage2 path (ObjTypeBody bodyType decls annot) =
-  ObjTypeBody bodyType <$> mapM (objTypeDeclToStage2 path) decls <*> pure annot
+  ObjTypeBody bodyType <$> mapM (mapDirectedM $ objTypeDeclToStage2 path) decls <*> pure annot
 
 objTypeDeclToStage2 :: Path -> ObjTypeDecl Stage1 I Annot -> M Annot (ObjTypeDecl Stage2 I Annot)
 objTypeDeclToStage2 path = \case
@@ -150,7 +151,7 @@ registerBodyToStage2 :: Path -> RegisterBody Stage1 I Annot -> M Annot (Register
 registerBodyToStage2 path (RegisterBody bodyType (Identity (DeferredRegisterBody registerBitsDecl a1)) a2) =
   RegisterBody bodyType . Identity
     <$> ( DeferredRegisterBody
-            <$> mapM (registerBitsDeclToStage2 path) registerBitsDecl
+            <$> mapM (mapDirectedM $ registerBitsDeclToStage2 path) registerBitsDecl
             <*> pure a1
         )
     <*> pure a2
diff --git a/src/Language/Fiddle/Compiler/Stage2.hs b/src/Language/Fiddle/Compiler/Stage2.hs
index 727f153..431fc76 100644
--- a/src/Language/Fiddle/Compiler/Stage2.hs
+++ b/src/Language/Fiddle/Compiler/Stage2.hs
@@ -72,7 +72,7 @@ toStage3 (FiddleUnit decls a) =
   snd
     <$> subCompile
       emptyState
-      ( FiddleUnit <$> mapM fiddleDeclToStage3 decls <*> pure a
+      ( FiddleUnit <$> mapM (mapDirectedM fiddleDeclToStage3) decls <*> pure a
       )
 
 exprToSize ::
@@ -94,7 +94,7 @@ getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do
   when (declaredSize <= 4) $ do
     imap <-
       foldlM
-        ( \imap enumConst -> do
+        ( \imap (undirected -> enumConst) -> do
             number <- case enumConst of
               EnumConstantDecl _ expr _ -> exprToSize expr
               EnumConstantReserved expr _ -> exprToSize expr
@@ -137,6 +137,7 @@ fiddleDeclToStage3 = \case
     BitsDecl id <$> bitTypeToStage3 typ <*> pure a
   ObjTypeDecl ident body 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
 
@@ -162,10 +163,10 @@ registerBodyToStage3 (RegisterBody bodyType (Identity deferredRegisterBody) a')
       (cur, returned) <-
         foldlM
           ( \(cursor, returned) decl ->
-              case decl of
+              case undirected decl of
                 ReservedBits expr a -> do
                   size <- fromIntegral <$> exprToSize expr
-                  let s3 = ReservedBits (expressionToStage3 expr) a
+                  let s3 = mapDirected (const $ ReservedBits (expressionToStage3 expr) a) decl
                   if isUnion
                     then checkUnion cursor size (s3 : returned) a
                     else
@@ -174,7 +175,7 @@ registerBodyToStage3 (RegisterBody bodyType (Identity deferredRegisterBody) a')
                   checkBitsSubStructure registerBody maybeIdent annot
 
                   (newBody, subsize) <- registerBodyToStage3 registerBody
-                  let s3 = BitsSubStructure newBody maybeIdent annot
+                  let s3 = mapDirected (const $ BitsSubStructure newBody maybeIdent annot) decl
 
                   if isUnion
                     then checkUnion cursor subsize (s3 : returned) a
@@ -182,7 +183,7 @@ registerBodyToStage3 (RegisterBody bodyType (Identity deferredRegisterBody) a')
                       return (cursor + subsize, s3 : returned)
                 DefinedBits modifier identifier typeref a -> do
                   (s3TypeRef, size) <- registerBitsTypeRefToStage3 typeref
-                  let s3 = DefinedBits modifier identifier s3TypeRef a
+                  let s3 = mapDirected (const $ DefinedBits modifier identifier s3TypeRef a) decl
 
                   if isUnion
                     then checkUnion cursor size (s3 : returned) a
@@ -265,18 +266,22 @@ objTypeBodyToStage3 (ObjTypeBody bodyType decls a) startOff = do
   (cur, returned) <-
     foldlM
       ( \(cursor, returned) decl ->
-          case decl of
+          case undirected decl of
             RegisterDecl mMod mIdent expr mBody a -> do
               (s3RegisterBody, mCalculatedSize) <-
                 fUnzip <$> mapM registerBodyToStage3 mBody
 
               let s3 =
-                    RegisterDecl
-                      mMod
-                      mIdent
-                      (expressionToStage3 expr)
-                      s3RegisterBody
-                      a
+                    mapDirected
+                      ( const $
+                          RegisterDecl
+                            mMod
+                            mIdent
+                            (expressionToStage3 expr)
+                            s3RegisterBody
+                            a
+                      )
+                      decl
 
               declaredSizeBits <- fromIntegral <$> exprToSize expr
 
@@ -320,7 +325,7 @@ objTypeBodyToStage3 (ObjTypeBody bodyType decls a) startOff = do
                   subBody
                   ( if isUnion then startOff else cursor
                   )
-              let s3 = TypeSubStructure (Identity newBody) maybeIdent annot
+              let s3 = mapDirected (const $ TypeSubStructure (Identity newBody) maybeIdent annot) decl
 
               checkTypesSubStructure subBody maybeIdent annot
               if isUnion
@@ -338,7 +343,7 @@ objTypeBodyToStage3 (ObjTypeBody bodyType decls a) startOff = do
                       (unCommented a)
                   ]
               let size = size' `div` 8
-              let s3 = ReservedDecl (expressionToStage3 expr) annot
+              let s3 = mapDirected (const $ ReservedDecl (expressionToStage3 expr) annot) decl
               if isUnion
                 then
                   checkUnion cursor size (s3 : returned) a
@@ -406,7 +411,7 @@ bitTypeToStage3 (EnumBitType expr body a) =
 
 enumBodyToStage3 :: EnumBody Stage2 I Annot -> Compile Stage3State (EnumBody Stage3 I Annot)
 enumBodyToStage3 (EnumBody constants a) =
-  EnumBody <$> mapM enumConstantDeclToStage3 constants <*> pure a
+  EnumBody <$> mapM (mapDirectedM enumConstantDeclToStage3) constants <*> pure a
 
 enumConstantDeclToStage3 :: EnumConstantDecl Stage2 I Annot -> Compile Stage3State (EnumConstantDecl Stage3 I Annot)
 enumConstantDeclToStage3 = \case
@@ -415,4 +420,4 @@ enumConstantDeclToStage3 = \case
 
 packageBodyToStage3 :: PackageBody Stage2 I Annot -> Compile Stage3State (PackageBody Stage3 I Annot)
 packageBodyToStage3 (PackageBody decls a) =
-  PackageBody <$> mapM fiddleDeclToStage3 decls <*> pure a
+  PackageBody <$> mapM (mapDirectedM fiddleDeclToStage3) decls <*> pure a
diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index 00824ed..46c0594 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -28,7 +28,12 @@ import Language.Fiddle.Types
 import Text.Parsec.Pos
 import Text.Printf (printf)
 
-type Context stage = (Show (NumberType stage), Typeable stage)
+type Context stage =
+  ( Show (NumberType stage),
+    Typeable stage,
+    ToGenericSyntaxTree (ImportType stage),
+    Typeable (ImportType stage)
+  )
 
 data GenericSyntaxTree f a where
   {- GenericSyntaxtTree with a name and children. -}
@@ -94,7 +99,7 @@ instance ToGenericSyntaxTreeValue Data.Text.Text where
 
 type GenericContext t f a = (Traversable f, ToGenericSyntaxTree t, Typeable t, Typeable f, Typeable a)
 
-class ToGenericSyntaxTree (t :: (Type -> Type) -> Type -> Type) where
+class ToGenericSyntaxTree (t :: SynTreeKind) 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)) =>
@@ -176,6 +181,20 @@ deriving instance (ToGenericSyntaxTree Identifier)
 
 deriving instance (ToGenericSyntaxTree BodyType)
 
+deriving instance (ToGenericSyntaxTree Directive)
+
+deriving instance (ToGenericSyntaxTree DirectiveBody)
+
+deriving instance (ToGenericSyntaxTree DirectiveElement)
+
+deriving instance (ToGenericSyntaxTree DirectiveExpression)
+
+deriving instance (ToGenericSyntaxTree ImportList)
+
+deriving instance (ToGenericSyntaxTree ImportStatement)
+
+deriving instance (ToGenericSyntaxTree t, Typeable t) => (ToGenericSyntaxTree (Directed t))
+
 deriving instance (Context stage) => (ToGenericSyntaxTree (FiddleUnit stage))
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (FiddleDecl stage))
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index 7eed0f2..f3ad744 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -7,6 +7,7 @@ module Language.Fiddle.Parser
   )
 where
 
+import Control.Monad (void)
 import Data.Functor.Identity
 import Data.Kind (Type)
 import Data.Text (Text)
@@ -50,25 +51,89 @@ isComment (Token t _) =
 stripTrailingComments :: [Token s] -> [Token s]
 stripTrailingComments = reverse . dropWhile isComment . reverse
 
+directed :: Pa t -> PaS (Directed (t 'Stage1))
+directed subparser = withMeta $ do
+  Directed <$> many directive <*> subparser
+
+directive :: PaS Directive
+directive =
+  withMeta $
+    Directive <$> defer directiveBodyTokens directiveBody
+
+directiveBody :: PaS DirectiveBody
+directiveBody = withMeta $ do
+  DirectiveBody <$> many (directiveElement <* (void (tok TokComma) <|> eof))
+
+directiveElement :: PaS DirectiveElement
+directiveElement = withMeta $ do
+  identifier1 <- nextText
+  choice
+    [ do
+        tok TokColon
+        let backend = identifier1
+        key <- nextText
+        choice
+          [ do
+              tok TokEq
+              DirectiveElementKeyValue (Just backend) key <$> directiveExpression,
+            do
+              return (DirectiveElementKey (Just backend) key)
+          ],
+      do
+        tok TokEq
+        let key = identifier1
+        DirectiveElementKeyValue Nothing key <$> directiveExpression,
+      return $ DirectiveElementKey Nothing identifier1
+    ]
+
+nextText :: PaS Identifier
+nextText = withMeta $ Identifier <$> token textOf
+
+directiveExpression :: PaS DirectiveExpression
+directiveExpression = withMeta $ do
+  choice
+    [ do
+        token $ \case
+          (TokString str) -> Just $ DirectiveString str
+          (TokLitNum num) -> Just $ DirectiveNumber num
+          _ -> Nothing
+    ]
+
 fiddleUnit :: Pa FiddleUnit
 fiddleUnit = do
   withMeta
-    ( FiddleUnit <$> many1 (fiddleDecl <* tok TokSemi)
+    ( FiddleUnit <$> many1 (directed fiddleDecl <* tok TokSemi)
     )
     <* many comment
 
+stringToken :: P Text
+stringToken = token (\case
+  (TokString str) -> Just str
+  _ -> Nothing)
+
+importList :: PaS ImportList
+importList = withMeta $ do
+  tok TokLParen
+  ImportList <$> many (ident <* (tok TokComma <|> lookAhead (tok TokRParen)))
+   <* tok TokRParen
+
+importStatement :: PaS ImportStatement
+importStatement = withMeta $
+  ImportStatement <$> stringToken <*> optionMaybe importList
+
 fiddleDecl :: Pa FiddleDecl
 fiddleDecl = do
   withMeta $ do
     t <- tokenType <$> anyToken
     case t of
-      KWOption -> OptionDecl <$> ident <*> ident
+      KWOption -> OptionDecl <$> nextText <*> nextText
       KWPackage ->
         PackageDecl
           <$> ident
           <*> defer body packageBody
       KWLocation -> LocationDecl <$> ident <*> (tok TokEq >> expression)
       KWBits -> BitsDecl <$> ident <*> (tok TokColon >> bitType)
+      KWImport -> ImportDecl <$> importStatement
       KWType ->
         ObjTypeDecl
           <$> ident
@@ -132,7 +197,7 @@ exprInParen = tok TokLParen *> expression <* tok TokRParen
 objTypeBody :: BodyType F (Commented SourceSpan) -> Pa ObjTypeBody
 objTypeBody bt =
   withMeta $
-    ObjTypeBody bt <$> many (objTypeDecl <* tok TokSemi)
+    ObjTypeBody bt <$> many (directed objTypeDecl <* tok TokSemi)
 
 objTypeDecl :: Pa ObjTypeDecl
 objTypeDecl =
@@ -185,7 +250,7 @@ registerBody = withMeta $ RegisterBody <$> bitBodyType <*> defer body deferredRe
 deferredRegisterBody :: Pa DeferredRegisterBody
 deferredRegisterBody =
   withMeta $
-    DeferredRegisterBody <$> many (registerBitsDecl <* tok TokSemi)
+    DeferredRegisterBody <$> many (directed registerBitsDecl <* tok TokSemi)
 
 registerBitsDecl :: Pa RegisterBitsDecl
 registerBitsDecl =
@@ -239,7 +304,7 @@ bitType = withMeta $ rawBits <|> enumType
 enumBody :: Pa EnumBody
 enumBody =
   withMeta $
-    EnumBody <$> many (enumConstantDecl <* tok TokComma)
+    EnumBody <$> many (directed enumConstantDecl <* tok TokComma)
 
 enumConstantDecl :: Pa EnumConstantDecl
 enumConstantDecl =
@@ -260,6 +325,13 @@ body = do
   (_, b, _) <- body'
   return b
 
+directiveBodyTokens :: P [Token SourceSpan]
+directiveBodyTokens = do
+  tokKeepComment TokDirectiveStart
+  ret <- concat <$> manyTill ((: []) <$> anyToken) (lookAhead $ tokKeepComment TokDirectiveEnd)
+  tokKeepComment TokDirectiveEnd
+  return ret
+
 body' :: P (Token SourceSpan, [Token SourceSpan], Token SourceSpan)
 body' = do
   l <- tokKeepComment TokLBrace
@@ -299,9 +371,10 @@ packageBody =
   withMeta $
     PackageBody
       <$> many
-        ( fiddleDecl
-            <* ( tok TokSemi <|> fail "Expected ';'"
-               )
+        ( directed $
+            fiddleDecl
+              <* ( tok TokSemi <|> fail "Expected ';'"
+                 )
         )
 
 printNext :: P ()
diff --git a/src/Language/Fiddle/Tokenizer.hs b/src/Language/Fiddle/Tokenizer.hs
index 08f5649..87f119f 100644
--- a/src/Language/Fiddle/Tokenizer.hs
+++ b/src/Language/Fiddle/Tokenizer.hs
@@ -27,6 +27,7 @@ data T
   | KWType
   | KWUnion
   | KWWo
+  | KWImport
   | TokColon
   | TokComma
   | TokComment !Text
@@ -41,8 +42,35 @@ data T
   | TokRBracket
   | TokRParen
   | TokSemi
+  | TokString !Text
+  | TokDirectiveStart -- [[
+  | TokDirectiveEnd -- ]]
   deriving (Eq, Ord, Show, Read)
 
+textOf :: T -> Maybe Text
+textOf t = do
+  case t of
+    KWAssertPos -> Just "assert_pos"
+    KWAt -> Just "at"
+    KWBits -> Just "bits"
+    KWEnum -> Just "enum"
+    KWInstance -> Just "instance"
+    KWLocation -> Just "location"
+    KWOption -> Just "option"
+    KWPackage -> Just "package"
+    KWReg -> Just "reg"
+    KWReserved -> Just "reserved"
+    KWRo -> Just "ro"
+    KWRw -> Just "rw"
+    KWStruct -> Just "struct"
+    KWType -> Just "type"
+    KWUnion -> Just "union"
+    KWWo -> Just "wo"
+    KWImport -> Just "import"
+    TokIdent i -> Just i
+    TokLitNum n -> Just n
+    _ -> Nothing
+
 data Token a = Token !T a
   deriving (Eq, Ord, Show, Functor)
 
@@ -66,6 +94,7 @@ parseToken = spaces *> tok parseToken' <* spaces
         "type" -> KWType
         "option" -> KWOption
         "package" -> KWPackage
+        "import" -> KWImport
         "reg" -> KWReg
         "ro" -> KWRo
         "wo" -> KWWo
@@ -77,6 +106,19 @@ parseToken = spaces *> tok parseToken' <* spaces
         (Data.Text.head -> h) | isDigit h -> TokLitNum str
         ident -> TokIdent ident
 
+    parseString = fmap (TokString . Data.Text.pack . concat) $ do
+      char '"'
+      manyTill
+        ( do
+            c <- anyChar
+            if c == '\\'
+              then do
+                c2 <- anyChar
+                return [c, c2]
+              else return [c]
+        )
+        (char '"')
+
     parseComment =
       try
         ( do
@@ -91,7 +133,9 @@ parseToken = spaces *> tok parseToken' <* spaces
 
     parseSymbol =
       choice
-        [ char ':' $> TokColon,
+        [ try (string "[[" $> TokDirectiveStart),
+          try (string "]]" $> TokDirectiveEnd),
+          char ':' $> TokColon,
           char ',' $> TokComma,
           char '=' $> TokEq,
           char '{' $> TokLBrace,
@@ -107,6 +151,7 @@ parseToken = spaces *> tok parseToken' <* spaces
 
     parseToken' =
       fmap (parseAlNumTok . Data.Text.pack) (many1 (alphaNum <|> char '_'))
+        <|> parseString
         <|> parseComment
         <|> parseSymbol