diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 6185747380..f2e0da2592 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -6,7 +6,6 @@ where import Control.Lens import Control.Monad.Reader (asks, local) import Data.List qualified as List -import Data.List.NonEmpty (pattern (:|)) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text @@ -14,6 +13,7 @@ import Text.Megaparsec qualified as P import Unison.ABT qualified as ABT import Unison.DataDeclaration (DataDeclaration, EffectDeclaration) import Unison.DataDeclaration qualified as DD +import Unison.DataDeclaration qualified as DataDeclaration import Unison.DataDeclaration.Records (generateRecordAccessors) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment @@ -26,12 +26,14 @@ import Unison.Prelude import Unison.Reference (TypeReferenceId) import Unison.Syntax.DeclParser (declarations) import Unison.Syntax.Lexer qualified as L -import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) +import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.Parser import Unison.Syntax.TermParser qualified as TermParser -import Unison.Syntax.Var qualified as Var (namespaced) -import Unison.Term (Term) +import Unison.Syntax.Var qualified as Var (namespaced, namespaced2) +import Unison.Term (Term, Term2) import Unison.Term qualified as Term +import Unison.Type (Type) +import Unison.Type qualified as Type import Unison.UnisonFile (UnisonFile (..)) import Unison.UnisonFile.Env qualified as UF import Unison.UnisonFile.Names qualified as UFN @@ -48,21 +50,66 @@ resolutionFailures es = P.customFailure (ResolutionFailures es) file :: forall m v. (Monad m, Var v) => P v m (UnisonFile v Ann) file = do _ <- openBlock + + -- Parse an optional directive like "namespace foo.bar" + maybeNamespace :: Maybe v <- + optional (reserved "namespace") >>= \case + Nothing -> pure Nothing + Just _ -> Just . Name.toVar . L.payload <$> (importWordyId <|> importSymbolyId) + -- The file may optionally contain top-level imports, -- which are parsed and applied to the type decls and term stanzas (namesStart, imports) <- TermParser.imports <* optional semi (dataDecls, effectDecls, parsedAccessors) <- declarations - env <- case UFN.environmentFor namesStart dataDecls effectDecls of - Right (Right env) -> pure env - Right (Left es) -> P.customFailure $ TypeDeclarationErrors es - Left es -> resolutionFailures (toList es) - let accessors :: [[(v, Ann, Term v Ann)]] + + env <- + let applyNamespaceToDecls :: forall decl. Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl + applyNamespaceToDecls dataDeclL = + case maybeNamespace of + Nothing -> id + Just namespace -> Map.fromList . map f . Map.toList + where + f :: (v, decl) -> (v, decl) + f (declName, decl) = + ( Var.namespaced2 namespace declName, + review dataDeclL (applyNamespaceToDataDecl namespace unNamespacedTypeNames (view dataDeclL decl)) + ) + + unNamespacedTypeNames :: Set v + unNamespacedTypeNames = + Set.union (Map.keysSet dataDecls) (Map.keysSet effectDecls) + + dataDecls1 = applyNamespaceToDecls id dataDecls + effectDecls1 = applyNamespaceToDecls DataDeclaration.asDataDecl_ effectDecls + in case UFN.environmentFor namesStart dataDecls1 effectDecls1 of + Right (Right env) -> pure env + Right (Left es) -> P.customFailure $ TypeDeclarationErrors es + Left es -> resolutionFailures (toList es) + let unNamespacedAccessors :: [(v, Ann, Term v Ann)] + unNamespacedAccessors = do + (typ, fields) <- parsedAccessors + -- The parsed accessor has an un-namespaced type, so apply the namespace directive (if necessary) before + -- looking up in the environment computed by `environmentFor`. + let typ1 = maybe id Var.namespaced2 maybeNamespace (L.payload typ) + Just (r, _) <- [Map.lookup typ1 (UF.datas env)] + -- Generate the record accessors with *un-namespaced* names (passing `typ` rather than `typ1`) below, because we + -- need to know these names in order to perform rewriting. As an example, + -- + -- namespace foo + -- type Bar = { baz : Nat } + -- term = ... Bar.baz ... + -- + -- we want to rename `Bar.baz` to `foo.Bar.baz`, and it seems easier to first generate un-namespaced accessors + -- like `Bar.baz`, rather than rip off the namespace from accessors like `foo.Bar.baz` (though not by much). + generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r + where + toPair (tok, typ) = (L.payload tok, ann tok <> ann typ) + let accessors :: [(v, Ann, Term v Ann)] accessors = - [ generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r - | (typ, fields) <- parsedAccessors, - Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)] - ] - toPair (tok, typ) = (L.payload tok, ann tok <> ann typ) + unNamespacedAccessors + & case maybeNamespace of + Nothing -> id + Just namespace -> over (mapped . _1) (Var.namespaced2 namespace) let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports] let locals = Names.importing importNames (UF.names env) -- At this stage of the file parser, we've parsed all the type and ability @@ -74,8 +121,26 @@ file = do -- make use of _terms_ from the local file. local (\e -> e {names = Names.push locals namesStart}) do names <- asks names - stanzas0 <- sepBy semi stanza - let stanzas = fmap (TermParser.substImports names imports) <$> stanzas0 + stanzas <- do + unNamespacedStanzas0 <- sepBy semi stanza + let unNamespacedStanzas = fmap (TermParser.substImports names imports) <$> unNamespacedStanzas0 + pure $ + unNamespacedStanzas + & case maybeNamespace of + Nothing -> id + Just namespace -> + let unNamespacedTermNamespaceNames :: Set v + unNamespacedTermNamespaceNames = + Set.unions + [ -- The vars parsed from the stanzas themselves (before applying namespace directive) + Set.fromList (unNamespacedStanzas >>= getVars), + -- The un-namespaced constructor names (from the *originally-parsed* data and effect decls) + foldMap (Set.fromList . DataDeclaration.constructorVars) dataDecls, + foldMap (Set.fromList . DataDeclaration.constructorVars . DataDeclaration.toDataDecl) effectDecls, + -- The un-namespaced accessors + Set.fromList (map (view _1) unNamespacedAccessors) + ] + in map (applyNamespaceToStanza namespace unNamespacedTermNamespaceNames) _ <- closeBlock let (termsr, watchesr) = foldl' go ([], []) stanzas go (terms, watches) s = case s of @@ -89,7 +154,7 @@ file = do -- All locally declared term variables, running example: -- [foo.alice, bar.alice, zonk.bob] fqLocalTerms :: [v] - fqLocalTerms = (stanzas0 >>= getVars) <> (view _1 <$> join accessors) + fqLocalTerms = (stanzas >>= getVars) <> (view _1 <$> accessors) -- suffixified local term bindings shadow any same-named thing from the outer codebase scope -- example: `foo.bar` in local file scope will shadow `foo.bar` and `bar` in codebase scope let (curNames, resolveLocals) = @@ -120,9 +185,48 @@ file = do validateUnisonFile (UF.datasId env) (UF.effectsId env) - (terms <> join accessors) + (terms <> accessors) (List.multimap watches) +applyNamespaceToDataDecl :: forall a v. (Var v) => v -> Set v -> DataDeclaration v a -> DataDeclaration v a +applyNamespaceToDataDecl namespace locallyBoundTypes = + over (DataDeclaration.constructors_ . mapped) \(ann, conName, conTy) -> + (ann, Var.namespaced2 namespace conName, ABT.substsInheritAnnotation replacements conTy) + where + -- Replace var "Foo" with var "namespace.Foo" + replacements :: [(v, Type v ())] + replacements = + locallyBoundTypes + & Set.toList + & map (\v -> (v, Type.var () (Var.namespaced2 namespace v))) + +applyNamespaceToStanza :: + forall a v. + (Var v) => + v -> + Set v -> + Stanza v (Term v a) -> + Stanza v (Term v a) +applyNamespaceToStanza namespace locallyBoundTerms = \case + Binding x -> Binding (goBinding x) + Bindings xs -> Bindings (map goBinding xs) + WatchBinding wk ann x -> WatchBinding wk ann (goBinding x) + WatchExpression wk guid ann term -> WatchExpression wk guid ann (goTerm term) + where + goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a) + goBinding ((ann, name), term) = + ((ann, Var.namespaced2 namespace name), goTerm term) + + goTerm :: Term v a -> Term v a + goTerm = + ABT.substsInheritAnnotation replacements + + replacements :: [(v, Term2 v a a v ())] + replacements = + locallyBoundTerms + & Set.toList + & map (\v -> (v, Term.var () (Var.namespaced2 namespace v))) + -- | Final validations and sanity checks to perform before finishing parsing. validateUnisonFile :: (Ord v) => @@ -237,7 +341,7 @@ stanza = watchExpression <|> unexpectedAction <|> binding binding@((_, v), _) <- TermParser.binding pure $ case doc of Nothing -> Binding binding - Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced (v :| [Var.named "doc"])), doc), binding] + Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced2 v (Var.named "doc")), doc), binding] watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann) watched = P.try do diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 00fdd5f115..5c30654760 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -131,11 +131,13 @@ environmentFor :: Names.ResolutionResult v a (Either [Error v a] (Env v a)) environmentFor names dataDecls0 effectDecls0 = do let locallyBoundTypes = variableCanonicalizer (Map.keys dataDecls0 <> Map.keys effectDecls0) - -- data decls and hash decls may reference each other, and thus must be hashed together + + -- data decls and effect decls may reference each other, and thus must be hashed together dataDecls :: Map v (DataDeclaration v a) <- traverse (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names) dataDecls0 effectDecls :: Map v (EffectDeclaration v a) <- traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names)) effectDecls0 + let allDecls0 :: Map v (DataDeclaration v a) allDecls0 = Map.union dataDecls (toDataDecl <$> effectDecls) hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Hashing.hashDataDecls allDecls0 diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md index 081548ea11..d1a4cdd6ef 100644 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ b/unison-src/transcripts/generic-parse-errors.output.md @@ -30,12 +30,32 @@ namespace.blah = 1 Loading changes detected in scratch.u. - The identifier `namespace` used here is a reserved keyword: + I got confused here: 1 | namespace.blah = 1 - You can avoid this problem either by renaming the identifier - or wrapping it in backticks (like `namespace` ). + + I was surprised to find a = here. + I was expecting one of these instead: + + * ability + * bang + * binding + * do + * false + * force + * handle + * if + * lambda + * let + * newline or semicolon + * quote + * termLink + * true + * tuple + * type + * typeLink + * use ``` ``` unison diff --git a/unison-src/transcripts/namespace-directive.md b/unison-src/transcripts/namespace-directive.md new file mode 100644 index 0000000000..1d0ffddb25 --- /dev/null +++ b/unison-src/transcripts/namespace-directive.md @@ -0,0 +1,75 @@ +A `namespace foo` directive is optional, and may only appear at the top of a file. + +It affects the contents of the file as follows: + +1. All bindings like `x.y.z` are prefixed with the namespace; note that when this file is saved, the feedback mentions +the full bindings' names. + +```ucm +scratch/main> builtins.mergeio lib.builtins +``` + +```unison +namespace foo + +baz : Nat +baz = 17 +``` + +2. Free variables whose names exactly match bindings in the file are rewritten to refer to the prefixed binder instead. +That is, a term like `factorial = ... factorial ...` is rewritten to `foo.factorial = ... foo.factorial ...`. + +```unison +namespace foo + +factorial : Int -> Int +factorial = cases + +0 -> +1 + n -> n * factorial (n - +1) + +longer.evil.factorial : Int -> Int +longer.evil.factorial n = n +``` + +```ucm +scratch/main> add +scratch/main> view factorial +``` + +Note that in the above example, we do not want the existence of a `namespace foo` directive to determine whether the +reference to the name `factorial` within the body of `factorial` is a recursive reference (good, behavior without +namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the +bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). + +Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are +all properly handled. + +```unison +type longer.foo.Foo = Bar +type longer.foo.Baz = { qux : Nat } +``` + +```ucm +scratch/main> add +``` + +```unison +namespace foo + +type Foo = Bar +type Baz = { qux : Nat } + +type RefersToFoo = RefersToFoo Foo + +refersToBar = cases + Bar -> 17 + +refersToQux baz = + Baz.qux baz + Baz.qux baz +``` + +```ucm +scratch/main> add +scratch/main> view RefersToFoo refersToBar refersToQux +scratch/main> todo +``` diff --git a/unison-src/transcripts/namespace-directive.output.md b/unison-src/transcripts/namespace-directive.output.md new file mode 100644 index 0000000000..90e568248a --- /dev/null +++ b/unison-src/transcripts/namespace-directive.output.md @@ -0,0 +1,196 @@ +A `namespace foo` directive is optional, and may only appear at the top of a file. + +It affects the contents of the file as follows: + +1. All bindings like `x.y.z` are prefixed with the namespace; note that when this file is saved, the feedback mentions + the full bindings' names. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. + +``` +``` unison +namespace foo + +baz : Nat +baz = 17 +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo.baz : Nat + +``` +2. Free variables whose names exactly match bindings in the file are rewritten to refer to the prefixed binder instead. + That is, a term like `factorial = ... factorial ...` is rewritten to `foo.factorial = ... foo.factorial ...`. + +``` unison +namespace foo + +factorial : Int -> Int +factorial = cases + +0 -> +1 + n -> n * factorial (n - +1) + +longer.evil.factorial : Int -> Int +longer.evil.factorial n = n +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo.factorial : Int -> Int + foo.longer.evil.factorial : Int -> Int + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo.factorial : Int -> Int + foo.longer.evil.factorial : Int -> Int + +scratch/main> view factorial + + foo.factorial : Int -> Int + foo.factorial = cases + +0 -> +1 + n -> n Int.* foo.factorial (n Int.- +1) + + foo.longer.evil.factorial : Int -> Int + foo.longer.evil.factorial n = n + +``` +Note that in the above example, we do not want the existence of a `namespace foo` directive to determine whether the +reference to the name `factorial` within the body of `factorial` is a recursive reference (good, behavior without +namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the +bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). + +Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are +all properly handled. + +``` unison +type longer.foo.Foo = Bar +type longer.foo.Baz = { qux : Nat } +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type longer.foo.Baz + type longer.foo.Foo + longer.foo.Baz.qux : Baz -> Nat + longer.foo.Baz.qux.modify : (Nat ->{g} Nat) + -> Baz + ->{g} Baz + longer.foo.Baz.qux.set : Nat -> Baz -> Baz + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type longer.foo.Baz + type longer.foo.Foo + longer.foo.Baz.qux : Baz -> Nat + longer.foo.Baz.qux.modify : (Nat ->{g} Nat) -> Baz ->{g} Baz + longer.foo.Baz.qux.set : Nat -> Baz -> Baz + +``` +``` unison +namespace foo + +type Foo = Bar +type Baz = { qux : Nat } + +type RefersToFoo = RefersToFoo Foo + +refersToBar = cases + Bar -> 17 + +refersToQux baz = + Baz.qux baz + Baz.qux baz +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type foo.Baz + type foo.Foo + type foo.RefersToFoo + foo.Baz.qux : foo.Baz -> Nat + foo.Baz.qux.modify : (Nat ->{g} Nat) + -> foo.Baz + ->{g} foo.Baz + foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.refersToBar : foo.Foo -> Nat + foo.refersToQux : foo.Baz -> Nat + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type foo.Baz + type foo.Foo + type foo.RefersToFoo + foo.Baz.qux : foo.Baz -> Nat + foo.Baz.qux.modify : (Nat ->{g} Nat) + -> foo.Baz + ->{g} foo.Baz + foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.refersToBar : foo.Foo -> Nat + foo.refersToQux : foo.Baz -> Nat + +scratch/main> view RefersToFoo refersToBar refersToQux + + type foo.RefersToFoo = RefersToFoo foo.Foo + + foo.refersToBar : foo.Foo -> Nat + foo.refersToBar = cases foo.Foo.Bar -> 17 + + foo.refersToQux : foo.Baz -> Nat + foo.refersToQux baz = + use Nat + + use foo.Baz qux + qux baz + qux baz + +scratch/main> todo + + You have no pending todo items. Good work! ✅ + +``` diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index c641786505..18a5f7d0f4 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -573,6 +573,7 @@ lexemes eof = <|> symbolyKw "&&" <|> wordyKw "true" <|> wordyKw "false" + <|> wordyKw "namespace" <|> wordyKw "use" <|> wordyKw "forall" <|> wordyKw "∀" @@ -878,17 +879,19 @@ stanzas = ) ([] :| []) --- Moves type and ability declarations to the front of the token stream --- and move `use` statements to the front of each block +-- Moves type and ability declarations to the front of the token stream (but not before the leading optional namespace +-- directive) and move `use` statements to the front of each block reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] reorder = foldr fixup [] . sortWith f where - f [] = 3 :: Int + f [] = 4 :: Int f (t0 : _) = case payload $ headToken t0 of - Open mod | Set.member (Text.pack mod) typeModifiers -> 1 - Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 1 - Reserved "use" -> 0 - _ -> 3 :: Int + Open mod | Set.member (Text.pack mod) typeModifiers -> 3 + Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 3 + -- put `namespace` before `use` because the file parser only accepts a namespace directive at the top of the file + Reserved "namespace" -> 1 + Reserved "use" -> 2 + _ -> 4 :: Int -- after reordering can end up with trailing semicolon at the end of -- a block, which we remove with this pass fixup stanza [] = case Lens.unsnoc stanza of diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 1ac87e8eb2..deb1e89f4f 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -304,7 +304,7 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName -- | Parse a wordy identifier e.g. Foo, discarding any hash wordyDefinitionName :: (Var v) => P v m (L.Token v) -wordyDefinitionName = queryToken $ \case +wordyDefinitionName = queryToken \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing diff --git a/unison-syntax/src/Unison/Syntax/Var.hs b/unison-syntax/src/Unison/Syntax/Var.hs index 9fbc934d29..9f92e2c758 100644 --- a/unison-syntax/src/Unison/Syntax/Var.hs +++ b/unison-syntax/src/Unison/Syntax/Var.hs @@ -1,5 +1,6 @@ module Unison.Syntax.Var ( namespaced, + namespaced2, ) where @@ -13,3 +14,8 @@ import Unison.Var (Var) namespaced :: (Var v) => List.NonEmpty v -> v namespaced (v :| vs) = Name.toVar (foldl' Name.joinDot (Name.unsafeParseVar v) (map Name.unsafeParseVar vs)) + +-- | Like 'namespaced', but for the common case that you have two vars to join. +namespaced2 :: (Var v) => v -> v -> v +namespaced2 v1 v2 = + namespaced (v1 :| [v2])