involve the current namespace directive when generating a unique type…

… guid

parser-typechecker/src/Unison/Syntax/DeclParser.hs

@@ -5,14 +5,14 @@ module Unison.Syntax.DeclParser
     synDeclName,
     SynDataDecl (..),
     SynEffectDecl (..),
-    UnresolvedModifier (..),
   )
 where
 
 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

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.

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)