diff options
| author | adelon <22380201+adelon@users.noreply.github.com> | 2026-07-31 14:26:27 +0200 |
|---|---|---|
| committer | adelon <22380201+adelon@users.noreply.github.com> | 2026-07-31 14:26:27 +0200 |
| commit | a7c6b74dd7cb29e0b4d557b7927cb0c208742103 (patch) | |
| tree | cb16092f483f565307b71317d7be95d1ee985412 /source/Checking/Semantic.hs | |
| parent | f35c5f2ffa2ac6c4d93c90544ffc7e1fff7f3af3 (diff) | |
Hash fresh semantic interfaces once
Diffstat (limited to 'source/Checking/Semantic.hs')
| -rw-r--r-- | source/Checking/Semantic.hs | 40 |
1 files changed, 23 insertions, 17 deletions
diff --git a/source/Checking/Semantic.hs b/source/Checking/Semantic.hs index 728995b..46d992e 100644 --- a/source/Checking/Semantic.hs +++ b/source/Checking/Semantic.hs @@ -431,13 +431,11 @@ semanticInterface -> [SemanticInterfaceId] -> [DeclarationInterfaceDelta] -> Either SemanticInterfaceError SemanticInterface -semanticInterface owner direct declarations = - validateSemanticInterface - owner - direct - declarations - (computeSemanticInterfaceId - owner direct declarations) +semanticInterface owner direct declarations = do + validateSemanticInterfaceStructure owner direct declarations + let identity = + computeSemanticInterfaceId owner direct declarations + pure (SemanticInterface owner direct declarations identity) validateSemanticInterface :: ModuleName @@ -446,6 +444,24 @@ validateSemanticInterface -> SemanticInterfaceId -> Either SemanticInterfaceError SemanticInterface validateSemanticInterface owner direct declarations asserted = do + validateSemanticInterfaceStructure owner direct declarations + let computed = + computeSemanticInterfaceId + owner direct declarations + unless + (asserted == computed) + (Left + (SemanticInterfaceIdMismatch asserted computed)) + pure + (SemanticInterface + owner direct declarations asserted) + +validateSemanticInterfaceStructure + :: ModuleName + -> [SemanticInterfaceId] + -> [DeclarationInterfaceDelta] + -> Either SemanticInterfaceError () +validateSemanticInterfaceStructure owner direct declarations = do rejectDuplicate DuplicateDirectSemanticInterface direct @@ -475,16 +491,6 @@ validateSemanticInterface owner direct declarations asserted = do declarationDeltaFacts declarations)) (Left NonIncreasingFactSlots) - let computed = - computeSemanticInterfaceId - owner direct declarations - unless - (asserted == computed) - (Left - (SemanticInterfaceIdMismatch asserted computed)) - pure - (SemanticInterface - owner direct declarations asserted) semanticInterfaceOwner :: SemanticInterface -> ModuleName semanticInterfaceOwner |