Merge pull request #5285 from unisonweb/24-08-15-namespace-directive

feat: namespace directive

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

@@ -6,14 +6,14 @@ 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
 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

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

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

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
+```