diff options
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 |