summaryrefslogtreecommitdiff
path: root/src/Language/Fiddle/Compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/Fiddle/Compiler')
-rw-r--r--src/Language/Fiddle/Compiler/ConsistencyCheck.hs42
-rw-r--r--src/Language/Fiddle/Compiler/Expansion.hs15
-rw-r--r--src/Language/Fiddle/Compiler/ImportResolution.hs19
-rw-r--r--src/Language/Fiddle/Compiler/Qualification.hs23
-rw-r--r--src/Language/Fiddle/Compiler/Stage0.hs23
5 files changed, 54 insertions, 68 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 79ac9e7..3bdae4a 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -11,36 +11,29 @@ module Language.Fiddle.Compiler.ConsistencyCheck
)
where
-import Control.Monad (forM, forM_, unless, when)
-import Control.Monad.Identity (Identity (Identity))
+import Control.Monad (forM_, unless, when)
import Control.Monad.RWS (MonadState (get, put), MonadWriter (tell), gets, modify')
-import Data.Foldable (Foldable (toList), foldlM)
+import Data.Foldable (foldlM)
import Data.Functor.Identity
-import qualified Data.IntMap as IntMap
-import Data.Kind (Type)
-import Data.List (inits, intercalate)
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe, mapMaybe)
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import Data.Void
+import Data.List (intercalate)
+import Data.Maybe (mapMaybe)
import Data.Word (Word32)
import GHC.TypeError as TypeError
-import GHC.TypeLits
import Language.Fiddle.Ast
import Language.Fiddle.Compiler
import Language.Fiddle.Internal.Scopes
import Language.Fiddle.Internal.UnitInterface as UnitInterface
import Language.Fiddle.Types (Comment (DocComment), Commented (Commented, unCommented), SourceSpan)
-import Text.Printf (printf)
import Prelude hiding (unzip)
+import Text.Printf (printf)
+
+import qualified Data.IntMap as IntMap
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Text as Text
data GlobalState = GlobalState
{ globalScope :: Scope String (Either SizeBits SizeBytes),
- fileDependencies :: [FilePath],
+ _fileDependencies :: [FilePath],
unitInterface :: UnitInterface
}
@@ -158,7 +151,7 @@ instance AdvanceStage CurrentStage ObjTypeBody where
deriving instance AdvanceStage CurrentStage FiddleDecl
instance AdvanceStage CurrentStage (Directed FiddleDecl) where
- modifyState (Directed directives t _) s = case t of
+ modifyState (Directed _ t _) s = case t of
(BitsDecl _ id typ annotation) -> do
typeSize <- getTypeSize typ
insertTypeSize annotation s id typeSize
@@ -345,9 +338,6 @@ objTypeBodyToStage3 st (ObjTypeBody bodyType decls a) startOff = do
)
_ -> return ()
fUnzip xs = (fst <$> xs, snd <$> xs)
- pushApply :: Maybe (a, b) -> (Maybe a, Maybe b)
- pushApply (Just (a, b)) = (Just a, Just b)
- pushApply Nothing = (Nothing, Nothing)
registerBodyToStage3 ::
LocalState ->
@@ -531,6 +521,7 @@ lookupTypeSize (LocalState scopePath) (Name idents a) = do
(unCommented a)
]
compilationFailure
+ _ -> compilationFailure
getTypeSize :: BitType CurrentStage I Annot -> Compile s SizeBits
getTypeSize (RawBits expr _) = fromIntegral <$> exprToSize expr
@@ -581,9 +572,12 @@ getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do
diagnosticError :: String -> Annot -> Compile a ()
diagnosticError str a = tell [Diagnostic Error str (unCommented a)]
-diagnosticInfo :: String -> Annot -> Compile a ()
-diagnosticInfo str a = tell [Diagnostic Info str (unCommented a)]
-
+insertIntoUnitInterface ::
+ NonEmpty.NonEmpty String ->
+ UnitInterface ->
+ Commented SourceSpan ->
+ ExportedValue ->
+ UnitInterface
insertIntoUnitInterface path ui (Commented comments srcspan) val =
let docComments =
mconcat
diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 202717f..1c4df45 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -7,20 +7,17 @@
module Language.Fiddle.Compiler.Expansion (expandAst, expansionPhase) where
import Control.Monad.Identity (Identity (..))
-import Control.Monad.State (get, gets, modify, put)
-import qualified Data.Char as Char
+import Control.Monad.State (get, modify, put)
import Data.List (intercalate)
-import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
-import qualified Data.Text as Text
-import Data.Type.Bool
-import Debug.Trace
-import GHC.TypeLits
import Language.Fiddle.Ast
import Language.Fiddle.Compiler
-import Language.Fiddle.Compiler.Qualification
+import Language.Fiddle.Compiler.Qualification ()
import Language.Fiddle.Types
-import Text.Printf (printf)
+
+import qualified Data.Char as Char
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Text as Text
type M = Compile State
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index aacf27e..4d4bd32 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -8,33 +8,32 @@ module Language.Fiddle.Compiler.ImportResolution
)
where
-import qualified Codec.Compression.GZip as GZip
import Control.Arrow (Arrow (second))
import Control.Monad (filterM)
import Control.Monad.Identity (Identity)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
-import Control.Monad.Writer.Lazy (MonadTrans (lift), MonadWriter (tell), WriterT (WriterT, runWriterT), execWriterT)
-import Data.Aeson (decode, eitherDecode, encode)
-import qualified Data.ByteString.Lazy as BL
+import Control.Monad.Writer.Lazy (MonadTrans (lift), MonadWriter (tell), WriterT (..), execWriterT)
+import Data.Aeson (eitherDecode, encode)
import Data.Map (Map)
-import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
-import qualified Data.Text as Text
import Data.Tuple (swap)
import Data.Typeable
import Language.Fiddle.Ast
-import Language.Fiddle.Ast.FileInterface (ResolvedImport)
import Language.Fiddle.Compiler
-import Language.Fiddle.Compiler.Expansion
+import Language.Fiddle.Compiler.Expansion ()
import Language.Fiddle.Internal.UnitInterface
import Language.Fiddle.Types
import Options.Applicative
import System.Directory
import System.FilePath
-import System.IO
import Text.Printf (printf)
+import qualified Codec.Compression.GZip as GZip
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+
newtype Flags = Flags
{ importDirectories :: [FilePath]
}
@@ -70,8 +69,6 @@ type M = Compile GlobalState
type Annot = Commented SourceSpan
-newtype ImportError = ImportError [Diagnostic]
-
newtype ResolvedImports = ResolvedImports
{ importMap :: Map Text ([Diagnostic], Maybe UnitInterface)
}
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index 27c0911..eddb3cb 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -10,14 +10,12 @@
-- removed, as they become unnecessary once references are fully qualified.
module Language.Fiddle.Compiler.Qualification (qualificationPhase) where
-import Control.Monad (forM)
import Control.Monad.Identity
import Data.Foldable (foldlM)
-import Data.Maybe (catMaybes)
import Data.Word
import Language.Fiddle.Ast
import Language.Fiddle.Compiler
-import Language.Fiddle.Compiler.ConsistencyCheck
+import Language.Fiddle.Compiler.ConsistencyCheck ()
import Language.Fiddle.Internal.Scopes
import Language.Fiddle.Internal.UnitInterface
import Language.Fiddle.Types
@@ -25,9 +23,9 @@ import Language.Fiddle.Types
type CurrentStage = Expanded
data GlobalState = GlobalState
- { globalScope :: Scope String (Either SizeBits SizeBytes),
- fileDependencies :: [FilePath],
- unitInterface :: UnitInterface
+ { _globalScope :: Scope String (Either SizeBits SizeBytes),
+ _fileDependencies :: [FilePath],
+ _unitInterface :: UnitInterface
}
newtype LocalState = LocalState (ScopePath String)
@@ -44,8 +42,8 @@ instance CompilationStage Expanded where
type StageAfter Expanded = Qualified
type StageMonad Expanded = Compile GlobalState
type StageState Expanded = LocalState
- type StageFunctor Expanded = Identity
- type StageAnnotation Expanded = Commented SourceSpan
+ type StageFunctor Expanded = I
+ type StageAnnotation Expanded = Annot
qualificationPhase :: CompilationPhase Expanded Qualified
qualificationPhase =
@@ -85,12 +83,12 @@ instance AdvanceStage CurrentStage ObjType where
deriving instance (AdvanceStage CurrentStage t) => AdvanceStage CurrentStage (Directed t)
instance AdvanceStage CurrentStage PackageBody where
- advanceStage localState (PackageBody decls annot) =
- PackageBody <$> advanceFiddleDecls localState decls <*> pure annot
+ advanceStage localState (PackageBody decls a) =
+ PackageBody <$> advanceFiddleDecls localState decls <*> pure a
instance AdvanceStage CurrentStage FiddleUnit where
- advanceStage localState (FiddleUnit () decls annot) =
- FiddleUnit () <$> advanceFiddleDecls localState decls <*> pure annot
+ advanceStage localState (FiddleUnit () decls a) =
+ FiddleUnit () <$> advanceFiddleDecls localState decls <*> pure a
advanceFiddleDecls ::
LocalState ->
@@ -102,6 +100,7 @@ advanceFiddleDecls (LocalState scopePath) decls = fmap (reverse . fst) $ do
( \(declsRet, scopePath') -> \case
Directed {directedSubtree = UsingDecl {usingName = name}} ->
return (declsRet, addUsingPath (nameToList name) scopePath')
+ _ -> undefined
)
([], scopePath)
decls
diff --git a/src/Language/Fiddle/Compiler/Stage0.hs b/src/Language/Fiddle/Compiler/Stage0.hs
index 96ee539..cd17140 100644
--- a/src/Language/Fiddle/Compiler/Stage0.hs
+++ b/src/Language/Fiddle/Compiler/Stage0.hs
@@ -6,12 +6,10 @@ import qualified Data.Text
import Language.Fiddle.Ast
import Language.Fiddle.Compiler
import qualified Language.Fiddle.Parser
-import Language.Fiddle.Types (Commented, SourceSpan(..))
+import Language.Fiddle.Types (Commented, SourceSpan (..))
import Text.Parsec (ParseError, errorPos)
import Text.Parsec.Error (errorMessages, showErrorMessages)
-newtype Stage0Diagnostic = SyntaxError String
-
toStage0 ::
String ->
Data.Text.Text ->
@@ -31,15 +29,16 @@ toStage1 ::
FiddleUnit Parsed (Either ParseError) a ->
Compile () (FiddleUnit Parsed Identity a)
toStage1 ast = do
- alter
- ( \case
- (Left l) -> do
- tell [parseErrorToDiagnostic l]
- return (Left l)
- r -> return r
- )
- return
- ast
+ _ <-
+ alter
+ ( \case
+ (Left l) -> do
+ tell [parseErrorToDiagnostic l]
+ return (Left l)
+ r -> return r
+ )
+ return
+ ast
hoistMaybe $
case squeeze ast of
generated by cgit (git 2.34.1) at 2025-07-03 13:58:52 +0000