From 607e152aa38c0851e0cb0117c0fb2bdb789720ad Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 18 Jul 2023 10:22:07 -0400 Subject: [PATCH] add uniqueTypeGuid stub to parsing env --- parser-typechecker/src/Unison/Parsers.hs | 6 ++++-- parser-typechecker/src/Unison/Runtime/IOSource.hs | 6 +++++- parser-typechecker/tests/Unison/Test/Common.hs | 7 ++++++- .../src/Unison/Codebase/Editor/HandleInput.hs | 15 +++++++++++++-- unison-cli/src/Unison/LSP/FileAnalysis.hs | 7 ++++++- unison-cli/tests/Unison/Test/LSP.hs | 7 ++++++- unison-syntax/src/Unison/Syntax/Parser.hs | 9 ++++++++- 7 files changed, 48 insertions(+), 9 deletions(-) diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index 708677fee..29703d612 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -77,8 +77,10 @@ unsafeParseFileBuiltinsOnly :: unsafeParseFileBuiltinsOnly = unsafeReadAndParseFile $ Parser.ParsingEnv - mempty - (Names.NamesWithHistory Builtin.names0 mempty) + { uniqueNames = mempty, + uniqueTypeGuid = \_ -> pure Nothing, + names = Names.NamesWithHistory Builtin.names0 mempty + } unsafeParseFile :: Monad m => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) unsafeParseFile s pEnv = unsafeGetRightFrom s <$> parseFile "" s pEnv diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/parser-typechecker/src/Unison/Runtime/IOSource.hs index 60f099a81..21a9e350d 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/parser-typechecker/src/Unison/Runtime/IOSource.hs @@ -40,7 +40,11 @@ debug = False parsingEnv :: Parser.ParsingEnv Identity parsingEnv = - Parser.ParsingEnv mempty (Names.NamesWithHistory Builtin.names0 mempty) + Parser.ParsingEnv + { uniqueNames = mempty, + uniqueTypeGuid = \_ -> pure Nothing, + names = Names.NamesWithHistory Builtin.names0 mempty + } typecheckingEnv :: Typechecker.Env Symbol Ann typecheckingEnv = diff --git a/parser-typechecker/tests/Unison/Test/Common.hs b/parser-typechecker/tests/Unison/Test/Common.hs index f54d88aac..ba1e5916c 100644 --- a/parser-typechecker/tests/Unison/Test/Common.hs +++ b/parser-typechecker/tests/Unison/Test/Common.hs @@ -83,4 +83,9 @@ parseAndSynthesizeAsFile ambient filename s = do Result.Result _ (Just typecheckedFile) -> pure (Right typecheckedFile) parsingEnv :: Parser.ParsingEnv Identity -parsingEnv = Parser.ParsingEnv mempty B.names +parsingEnv = + Parser.ParsingEnv + { uniqueNames = mempty, + uniqueTypeGuid = \_ -> pure Nothing, + names = B.names + } diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 3417786bb..a58cd18a2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1455,7 +1455,12 @@ loadUnisonFile sourceName text = do & #latestTypecheckedFile .~ Nothing Cli.Env {codebase, generateUniqueName} <- ask uniqueName <- liftIO generateUniqueName - let parsingEnv = Parser.ParsingEnv uniqueName parseNames + let parsingEnv = + Parser.ParsingEnv + { uniqueNames = uniqueName, + uniqueTypeGuid = wundefined, + names = parseNames + } unisonFile <- Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv) & onLeftM \err -> Cli.returnEarly (ParseErrors text [err]) @@ -2982,8 +2987,14 @@ parseType input src = do NamesWithHistory.push (NamesWithHistory.currentNames names0) (NamesWithHistory.NamesWithHistory parseNames (NamesWithHistory.oldNames names0)) + let parsingEnv = + Parser.ParsingEnv + { uniqueNames = mempty, + uniqueTypeGuid = wundefined, + names + } typ <- - Parsers.parseType (Text.unpack (fst lexed)) (Parser.ParsingEnv mempty names) & onLeftM \err -> + Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err -> Cli.returnEarly (TypeParseError src err) Type.bindNames Name.unsafeFromVar mempty (NamesWithHistory.currentNames names) (Type.generalizeLowercase mempty typ) & onLeft \errs -> diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 3543d3329..b03935aa6 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -77,7 +77,12 @@ checkFile doc = runMaybeT $ do cb <- asks codebase let generateUniqueName = Parser.uniqueBase32Namegen <$> Random.getSystemDRG uniqueName <- liftIO generateUniqueName - let parsingEnv = Parser.ParsingEnv uniqueName parseNames + let parsingEnv = + Parser.ParsingEnv + { uniqueNames = uniqueName, + uniqueTypeGuid = wundefined, + names = parseNames + } (notes, parsedFile, typecheckedFile) <- do liftIO do Codebase.runTransaction cb do diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 72d0462b6..99537d087 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -330,7 +330,12 @@ typecheckSrc name src = do uniqueName <- Parser.uniqueBase32Namegen <$> Random.getSystemDRG let ambientAbilities = [] let parseNames = mempty - let parsingEnv = Parser.ParsingEnv uniqueName parseNames + let parsingEnv = + Parser.ParsingEnv + { uniqueNames = uniqueName, + uniqueTypeGuid = wundefined, + names = parseNames + } Codebase.runTransaction codebase do Parsers.parseFile name (Text.unpack src) parsingEnv >>= \case Left err -> pure (Left (crash ("Failed to parse: " ++ show err))) diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index f30322a50..1bb641107 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -62,6 +62,7 @@ import Data.Bytes.Put (runPutS) import Data.Bytes.Serial (serialize) import Data.Bytes.VarInt (VarInt (..)) import Data.Char qualified as Char +import Data.Kind (Type) import Data.List.NonEmpty qualified as Nel import Data.Set qualified as Set import Data.Text qualified as Text @@ -89,7 +90,6 @@ import Unison.UnisonFile.Error qualified as UF import Unison.Util.Bytes (Bytes) import Unison.Var (Var) import Unison.Var qualified as Var -import Data.Kind (Type) debug :: Bool debug = False @@ -100,6 +100,13 @@ type Err v = P.ParseError Input (Error v) data ParsingEnv (m :: Type -> Type) = ParsingEnv { uniqueNames :: UniqueName, + -- | Return a GUID to reuse for a unique type of the given name, if any. + -- + -- This callback is called for every `unique type` declaration that does not explicitly specify a GUID. + -- + -- The name (e.g. `Foo` in `unique type Foo`) is passed in, and if the function returns a Just, that GUID is used; + -- otherwise, a random one is generated from `uniqueNames`. + uniqueTypeGuid :: Name -> m (Maybe Text), names :: NamesWithHistory }