diff options
| author | Josh Rahm <joshuarahm@gmail.com> | 2024-10-11 14:21:43 -0600 |
|---|---|---|
| committer | Josh Rahm <joshuarahm@gmail.com> | 2024-10-11 14:21:43 -0600 |
| commit | 5092619a63058d6b4a895ecdaef31fec7a8da4cc (patch) | |
| tree | be3aa6d91002b50d8e049e5fdb0182b16d4766ad /src/Language/Fiddle/Compiler/Qualification.hs | |
| parent | 9af1d30c8cd6aef509736e1ecb6e77b47338b98d (diff) | |
| download | fiddle-5092619a63058d6b4a895ecdaef31fec7a8da4cc.tar.gz fiddle-5092619a63058d6b4a895ecdaef31fec7a8da4cc.tar.bz2 fiddle-5092619a63058d6b4a895ecdaef31fec7a8da4cc.zip | |
Replace all the qualification metadata with 'When (s .>= Qualified)'
This makes deriving much easier and cleans up the messy contexts in
GenericTree and elsewhere at the cost of slightly more obtuse syntax.
Diffstat (limited to 'src/Language/Fiddle/Compiler/Qualification.hs')
| -rw-r--r-- | src/Language/Fiddle/Compiler/Qualification.hs | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs index a39e5dc..0f7158d 100644 --- a/src/Language/Fiddle/Compiler/Qualification.hs +++ b/src/Language/Fiddle/Compiler/Qualification.hs @@ -96,7 +96,7 @@ instance AdvanceStage S RegisterBitsTypeRef where <$> advanceStage localState a <*> pure b RegisterBitsReference _ name a -> do - v <- fmap snd <$> resolveName name localState + v <- fmap (Present . snd) <$> resolveName name localState return $ RegisterBitsReference v name a instance AdvanceStage S ObjType where @@ -107,7 +107,7 @@ instance AdvanceStage S ObjType where <*> advanceStage localState b <*> pure c ReferencedObjType _ name a -> do - v <- fmap snd <$> resolveName name localState + v <- fmap (Present . snd) <$> resolveName name localState return $ ReferencedObjType v name a deriving instance (AdvanceStage S t) => AdvanceStage S (Directed t) @@ -176,6 +176,9 @@ resolveSymbol a (p : ps) (LocalState {ephemeralScope = ephemeralScope, currentSc resolveSymbol a _ _ = return $ Left [Diagnostic Error "Empty path provided (this is a bug)" (unCommented a)] +qMd :: (Applicative f) => t -> f (QMd Qualified t) +qMd = pure . Present + advanceFiddleDecls :: LocalState -> [Directed FiddleDecl S F A] -> @@ -213,7 +216,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do insertDecl decl doReturn =<< PackageDecl - (pure decl) + (qMd decl) name <$> mapM (advanceStage localState'') body <*> pure ann @@ -228,7 +231,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do insertDecl decl doReturn =<< LocationDecl - (pure decl) + (qMd decl) ident <$> advanceStage localState' expr <*> pure ann @@ -243,7 +246,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do insertDecl decl doReturn =<< BitsDecl - (pure decl) + (qMd decl) ident <$> advanceStage localState' typ <*> pure ann @@ -258,7 +261,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do insertDecl decl doReturn =<< ObjTypeDecl - (pure decl) + (qMd decl) ident <$> mapM (advanceStage localState') body <*> pure ann @@ -275,7 +278,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do insertDecl decl doReturn =<< ObjectDecl - (pure decl) + (qMd decl) ident <$> advanceStage localState' loc <*> advanceStage localState' typ |