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/ConsistencyCheck.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/ConsistencyCheck.hs')
| -rw-r--r-- | src/Language/Fiddle/Compiler/ConsistencyCheck.hs | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs index a4f252e..552ea40 100644 --- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs +++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs @@ -35,6 +35,9 @@ type A = Commented SourceSpan type M = Compile () +pattern QMdP :: t -> Identity (When True t) +pattern QMdP t = Identity (Present t) + instance CompilationStage Checked where type StageAfter Checked = TypeError (TypeError.Text "No stage after Checked") type StageMonad Checked = M @@ -85,19 +88,19 @@ instance AdvanceStage S FiddleUnit where doWalk t = case () of () - | (Just (PackageDecl {packageQualificationMetadata = (Identity d)})) <- + | (Just (PackageDecl {packageQualificationMetadata = (QMdP d)})) <- castTS t -> tell (UnitInterface.singleton d) - | (Just (LocationDecl {locationQualificationMetadata = (Identity d)})) <- + | (Just (LocationDecl {locationQualificationMetadata = (QMdP d)})) <- castTS t -> tell (UnitInterface.singleton d) - | (Just (BitsDecl {bitsQualificationMetadata = (Identity d)})) <- + | (Just (BitsDecl {bitsQualificationMetadata = (QMdP d)})) <- castTS t -> tell (UnitInterface.singleton d) - | (Just (ObjTypeDecl {objTypeQualificationMetadata = (Identity d)})) <- + | (Just (ObjTypeDecl {objTypeQualificationMetadata = (QMdP d)})) <- castTS t -> tell (UnitInterface.singleton d) - | (Just (ObjectDecl {objectQualificationMetadata = (Identity d)})) <- + | (Just (ObjectDecl {objectQualificationMetadata = (QMdP d)})) <- castTS t -> tell (UnitInterface.singleton d) | (Just (ImportStatement {importInterface = ii})) <- @@ -242,8 +245,9 @@ bitsTypeSize (RegisterBitsArray tr nExpr _) = do bitsTypeSize RegisterBitsReference { bitsRefQualificationMetadata = - Identity (ExportedBitsDecl {exportedBitsDeclSizeBits = sz}) + QMdP (ExportedBitsDecl {exportedBitsDeclSizeBits = sz}) } = return sz +bitsTypeSize (RegisterBitsReference {}) = error "should be exhaustive" bitsTypeSize (RegisterBitsJustBits expr _) = expressionToIntM expr |