diff options
| -rw-r--r-- | goal.fiddle | 4 | ||||
| -rw-r--r-- | src/Language/Fiddle/Compiler/ConsistencyCheck.hs | 9 | ||||
| -rw-r--r-- | src/Language/Fiddle/Compiler/ImportResolution.hs | 8 | ||||
| -rw-r--r-- | src/Language/Fiddle/Internal/UnitInterface.hs | 72 |
4 files changed, 44 insertions, 49 deletions
diff --git a/goal.fiddle b/goal.fiddle index c6707a5..a7f43f0 100644 --- a/goal.fiddle +++ b/goal.fiddle @@ -118,7 +118,7 @@ package stm32l4.gpio { union { assert_pos(0x10); ro reg (32) : struct { - id_r : common.data_t[16]; + id_r : common.bit_t[16]; reserved(16); }; @@ -145,7 +145,7 @@ package stm32l4.gpio { assert_pos(0x14); wo reg (32) : struct { union { - rw od_r : common.data_t[16]; + rw od_r : common.bit_t[16]; struct { rw osp_v : (15); diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs index abfbb9b..e081122 100644 --- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs +++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs @@ -142,7 +142,7 @@ instance AdvanceStage Expanded ImportStatement where where unitInterfaceScopeToGlobalScope = fmap - ( \(Annotated _ _ exportedValue) -> case exportedValue of + ( \(_, exportedValue) -> case exportedValue of ExportedBitsType sz -> Left sz ExportedObjType sz -> Right sz ) @@ -597,7 +597,12 @@ insertIntoUnitInterface path ui (Commented comments srcspan) val = ) in ui { rootScope = - insertScope path (Annotated srcspan docComments val) (rootScope ui) + insertScope + path + ( Metadata srcspan docComments [], + val + ) + (rootScope ui) } insertTypeSize :: diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs index 4f076b8..aacf27e 100644 --- a/src/Language/Fiddle/Compiler/ImportResolution.hs +++ b/src/Language/Fiddle/Compiler/ImportResolution.hs @@ -218,8 +218,9 @@ getImportResolutionState parseFile compileToChecked flags unit = do then doFullCompile else return val Left err -> do - tell [Diagnostic Error err srcSpan] - MaybeT $ return Nothing + tell [Diagnostic Warning "Doing recompile" srcSpan] + tell [Diagnostic Warning err srcSpan] + doFullCompile else doFullCompile addDependency path unitInterface = @@ -254,7 +255,8 @@ getImportResolutionState parseFile compileToChecked flags unit = do findFileInImportPath :: SourceSpan -> [FilePath] -> FilePath -> Compl FilePath findFileInImportPath sourceSpan paths path = do - realPaths <- lift2 $ filterM doesFileExist (map (++ ("/" ++ path)) paths) + canonicalPaths <- lift2 $ mapM (canonicalizePath . (++ ("/" ++ path))) paths + realPaths <- lift2 $ filterM doesFileExist canonicalPaths case realPaths of [] -> do diff --git a/src/Language/Fiddle/Internal/UnitInterface.hs b/src/Language/Fiddle/Internal/UnitInterface.hs index b18b98b..4244121 100644 --- a/src/Language/Fiddle/Internal/UnitInterface.hs +++ b/src/Language/Fiddle/Internal/UnitInterface.hs @@ -5,15 +5,38 @@ module Language.Fiddle.Internal.UnitInterface where import Data.Aeson import Data.Text import Data.Word +import GHC.Generics import Language.Fiddle.Internal.Scopes (Scope) import Language.Fiddle.Types (SourceSpan) -data Annotated a = Annotated - { sourceSpan :: SourceSpan, - docComment :: Text, - internal :: a +-- | Represents a compiler directive that provides configuration for the compiler +-- or its various backends. Directives can adjust the behavior of the compiler +-- or influence the code generation in the backends. +data InternalDirective = InternalDirective + { -- | Specifies the backend that this directive is intended for. If 'Nothing', + -- the directive applies globally across all backends. + directiveBackend :: Maybe String, + -- | The key or name of the directive. This identifies the directive's + -- purpose, such as enabling specific features or setting options. + directiveKey :: String, + -- | The optional value associated with this directive. Some directives + -- may not require a value (e.g., flags), in which case this field is 'Nothing'. + directiveValue :: Maybe String } - deriving (Eq, Ord, Show) + deriving (Generic, ToJSON, FromJSON, Show, Eq, Ord) + +-- | Metadata about an exported value. This includes things like the source +-- location, doc comments and compiler directives associated with the exported +-- symbol. +data Metadata = Metadata + { -- | Source location for the exported symbol. + metadataSourceSpan :: SourceSpan, + -- | Doc comment associated with the symbol. + metadataDocComment :: Text, + -- | List of directives associated with this exported symbol. + metadataDirectives :: [InternalDirective] + } + deriving (Generic, ToJSON, FromJSON, Show, Eq, Ord) -- | Contains a datastructure which represents a FiddleUnit. -- @@ -21,7 +44,7 @@ data Annotated a = Annotated -- direct dependencies. data UnitInterface where UnitInterface :: - { rootScope :: Scope String (Annotated ExportedValue), + { rootScope :: Scope String (Metadata, ExportedValue), dependencies :: [FilePath] } -> UnitInterface @@ -41,22 +64,7 @@ data ExportedValue where ExportedObjType :: {exportObjTypeSize :: Word32} -> ExportedValue - deriving (Show, Eq, Ord) - -instance (ToJSON a) => ToJSON (Annotated a) where - toJSON (Annotated span doc internal) = - object - [ "sourceSpan" .= span, - "docComment" .= doc, - "internal" .= internal - ] - -instance (FromJSON a) => FromJSON (Annotated a) where - parseJSON = withObject "Annotated" $ \v -> - Annotated - <$> v .: "sourceSpan" - <*> v .: "docComment" - <*> v .: "internal" + deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON) instance ToJSON UnitInterface where toJSON (UnitInterface rootScope dependencies) = @@ -70,23 +78,3 @@ instance FromJSON UnitInterface where UnitInterface <$> v .: "rootScope" <*> v .: "dependencies" - -instance ToJSON ExportedValue where - toJSON (ExportedBitsType size) = - object - [ "type" .= String "ExportedBitsType", - "size" .= size - ] - toJSON (ExportedObjType size) = - object - [ "type" .= String "ExportedObjType", - "size" .= size - ] - -instance FromJSON ExportedValue where - parseJSON = withObject "ExportedValue" $ \v -> do - typ <- v .: "type" - case typ of - String "ExportedBitsType" -> ExportedBitsType <$> v .: "size" - String "ExportedObjType" -> ExportedObjType <$> v .: "size" - _ -> fail "Unknown ExportedValue type" |