diff --git a/parser-typechecker/src/Unison/Syntax/DeclParser.hs b/parser-typechecker/src/Unison/Syntax/DeclParser.hs index 3d8c9d12b1..1f2e4f564e 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclParser.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclParser.hs @@ -5,7 +5,6 @@ module Unison.Syntax.DeclParser synDeclName, SynDataDecl (..), SynEffectDecl (..), - UnresolvedModifier (..), ) where @@ -13,6 +12,7 @@ import Control.Lens import Data.List.NonEmpty (pattern (:|)) import Data.List.NonEmpty qualified as NonEmpty import Unison.ABT qualified as ABT +import Unison.DataDeclaration qualified as DataDeclaration import Unison.Name qualified as Name import Unison.Parser.Ann (Ann) import Unison.Prelude @@ -51,7 +51,7 @@ data SynDataDecl v = SynDataDecl { annotation :: !Ann, constructors :: ![(Ann, v, Type v Ann)], fields :: !(Maybe [(L.Token v, Type v Ann)]), - modifier :: !(Maybe (L.Token UnresolvedModifier)), + modifier :: !DataDeclaration.Modifier, name :: !(L.Token v), tyvars :: ![v] } @@ -60,7 +60,7 @@ data SynDataDecl v = SynDataDecl data SynEffectDecl v = SynEffectDecl { annotation :: !Ann, constructors :: ![(Ann, v, Type v Ann)], - modifier :: !(Maybe (L.Token UnresolvedModifier)), + modifier :: !DataDeclaration.Modifier, name :: !(L.Token v), tyvars :: ![v] } @@ -100,7 +100,7 @@ synDeclP = do SynDecl'Effect <$> synEffectDeclP modifier <|> SynDecl'Data <$> synDataDeclP modifier synDataDeclP :: forall m v. (Monad m, Var v) => Maybe (L.Token UnresolvedModifier) -> P v m (SynDataDecl v) -synDataDeclP modifier = do +synDataDeclP modifier0 = do typeToken <- fmap void (reserved "type") <|> openBlockWith "type" (name, typeArgs) <- (,) <$> prefixVar <*> many prefixVar let tyvars = L.payload <$> typeArgs @@ -142,9 +142,10 @@ synDataDeclP modifier = do _ <- closeBlock let closingAnn :: Ann closingAnn = NonEmpty.last (ann eq NonEmpty.:| ((\(constrSpanAnn, _) -> constrSpanAnn) <$> constructors)) + modifier <- resolveModifier name modifier0 pure SynDataDecl - { annotation = maybe (ann typeToken) ann modifier <> closingAnn, + { annotation = maybe (ann typeToken) ann modifier0 <> closingAnn, constructors = snd <$> constructors, fields = Nothing, modifier, @@ -153,9 +154,10 @@ synDataDeclP modifier = do } Just (constructor, fields, closingAnn) -> do _ <- closeBlock + modifier <- resolveModifier name modifier0 pure SynDataDecl - { annotation = maybe (ann typeToken) ann modifier <> closingAnn, + { annotation = maybe (ann typeToken) ann modifier0 <> closingAnn, constructors = [constructor], fields, modifier, @@ -168,7 +170,7 @@ synDataDeclP modifier = do TermParser.verifyRelativeVarName prefixDefinitionName synEffectDeclP :: forall m v. (Monad m, Var v) => Maybe (L.Token UnresolvedModifier) -> P v m (SynEffectDecl v) -synEffectDeclP modifier = do +synEffectDeclP modifier0 = do abilityToken <- fmap void (reserved "ability") <|> openBlockWith "ability" name <- TermParser.verifyRelativeVarName prefixDefinitionName typeArgs <- many (TermParser.verifyRelativeVarName prefixDefinitionName) @@ -178,9 +180,10 @@ synEffectDeclP modifier = do _ <- closeBlock <* closeBlock let closingAnn = last $ ann blockStart : ((\(_, _, t) -> ann t) <$> constructors) + modifier <- resolveModifier name modifier0 pure SynEffectDecl - { annotation = maybe (ann abilityToken) ann modifier <> closingAnn, + { annotation = maybe (ann abilityToken) ann modifier0 <> closingAnn, constructors, modifier, name, @@ -217,3 +220,11 @@ effectConstructorP typeArgs name = then es else Type.apps' (toTypeVar name) (toTypeVar <$> typeArgs) : es in Type.cleanupAbilityLists $ Type.effect (ABT.annotation t) es' t + +resolveModifier :: (Monad m, Var v) => L.Token v -> Maybe (L.Token UnresolvedModifier) -> P v m DataDeclaration.Modifier +resolveModifier name modifier = + case L.payload <$> modifier of + Just UnresolvedModifier'Structural -> pure DataDeclaration.Structural + Just (UnresolvedModifier'UniqueWithGuid guid) -> pure (DataDeclaration.Unique guid) + Just UnresolvedModifier'UniqueWithoutGuid -> resolveUniqueTypeGuid name.payload + Nothing -> resolveUniqueTypeGuid name.payload diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 96e07287ad..f5f3ef3f2b 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -23,7 +23,7 @@ import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Prelude import Unison.Reference (TypeReferenceId) -import Unison.Syntax.DeclParser (SynDataDecl (..), SynDecl (..), SynEffectDecl (..), UnresolvedModifier (..), synDeclName, synDeclsP, synDeclConstructors) +import Unison.Syntax.DeclParser (SynDataDecl (..), SynDecl (..), SynEffectDecl (..), synDeclConstructors, synDeclName, synDeclsP) import Unison.Syntax.Lexer qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.Parser @@ -64,8 +64,8 @@ file = do -- which are parsed and applied to the type decls and term stanzas (namesStart, imports) <- TermParser.imports <* optional semi - -- Parse all syn decls - unNamespacedSynDecls <- synDeclsP + -- Parse all syn decls. The namespace in the parsing environment is required here in order to avoid unique type churn. + unNamespacedSynDecls <- local (\e -> e {maybeNamespace}) synDeclsP -- Sanity check: bail if there's a duplicate name among them unNamespacedSynDecls @@ -246,24 +246,15 @@ synDeclsToDecls = do foldlM ( \(datas, effects) -> \case SynDecl'Data decl -> do - modifier <- resolveModifier decl.name decl.modifier - let decl1 = DataDeclaration modifier decl.annotation decl.tyvars decl.constructors + let decl1 = DataDeclaration decl.modifier decl.annotation decl.tyvars decl.constructors let !datas1 = Map.insert decl.name.payload decl1 datas pure (datas1, effects) SynDecl'Effect decl -> do - modifier <- resolveModifier decl.name decl.modifier - let decl1 = DataDeclaration.mkEffectDecl' modifier decl.annotation decl.tyvars decl.constructors + let decl1 = DataDeclaration.mkEffectDecl' decl.modifier decl.annotation decl.tyvars decl.constructors let !effects1 = Map.insert decl.name.payload decl1 effects pure (datas, effects1) ) (Map.empty, Map.empty) - where - resolveModifier name modifier = - case L.payload <$> modifier of - Just UnresolvedModifier'Structural -> pure DataDeclaration.Structural - Just (UnresolvedModifier'UniqueWithGuid guid) -> pure (DataDeclaration.Unique guid) - Just UnresolvedModifier'UniqueWithoutGuid -> resolveUniqueTypeGuid name.payload - Nothing -> resolveUniqueTypeGuid name.payload applyNamespaceToStanza :: forall a v. diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index ae37936cd5..b013075145 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -97,6 +97,7 @@ import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toVar, unsafeParseVar) import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc +import Unison.Syntax.Var qualified as Var import Unison.Term (MatchCase (..)) import Unison.UnisonFile.Error qualified as UF import Unison.Util.Bytes (Bytes) @@ -144,6 +145,9 @@ data ParsingEnv (m :: Type -> Type) = ParsingEnv -- And for term links we are certainly out of luck: we can't look up a resolved file-bound term by hash *during -- parsing*. That's an issue with term links in general, unrelated to namespaces, but perhaps complicated by -- namespaces nonetheless. + -- + -- New development: this namespace is now also used during decl parsing, because in order to accurately reuse a + -- unique type guid we need to look up by namespaced name. maybeNamespace :: Maybe Name, localNamespacePrefixedTypesAndConstructors :: Names } @@ -183,10 +187,11 @@ uniqueName lenInBase32Hex = do pure . fromMaybe none $ mkName pos lenInBase32Hex resolveUniqueTypeGuid :: (Monad m, Var v) => v -> P v m Modifier -resolveUniqueTypeGuid name = do - ParsingEnv {uniqueTypeGuid} <- ask +resolveUniqueTypeGuid name0 = do + ParsingEnv {maybeNamespace, uniqueTypeGuid} <- ask + let name = Name.unsafeParseVar (maybe id (Var.namespaced2 . Name.toVar) maybeNamespace name0) guid <- - lift (lift (uniqueTypeGuid (Name.unsafeParseVar name))) >>= \case + lift (lift (uniqueTypeGuid name)) >>= \case Nothing -> uniqueName 32 Just guid -> pure guid pure (Unique guid)