Merge pull request #3720 from unisonweb/22-12-21-lex-names

Lex wordy/symboly identifiers into names, not strings

parser-typechecker/src/Unison/PrintError.hs

@@ -20,11 +20,13 @@ import Unison.Builtin.Decls (unitRef, pattern TupleType')
 import Unison.Codebase.Path qualified as Path
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import Unison.HashQualified (HashQualified)
+import Unison.HashQualified' qualified as HQ'
 import Unison.Kind (Kind)
 import Unison.Kind qualified as Kind
 import Unison.KindInference.Error.Pretty (prettyKindError)
 import Unison.Name (Name)
 import Unison.Name qualified as Name
+import Unison.NameSegment (NameSegment (..))
 import Unison.Names qualified as Names
 import Unison.Names.ResolutionResult qualified as Names
 import Unison.Parser.Ann (Ann (..))
@@ -1629,16 +1631,17 @@ renderParseErrors s = \case
                   then unknownTypesMsg
                   else unknownTypesMsg <> "\n\n" <> dupDataAndAbilitiesMsg
        in (msgs, allRanges)
-    go (Parser.DidntExpectExpression _tok (Just t@(L.payload -> L.SymbolyId "::" Nothing))) =
-      let msg =
-            mconcat
-              [ "This looks like the start of an expression here but I was expecting a binding.",
-                "\nDid you mean to use a single " <> style Code ":",
-                " here for a type signature?",
-                "\n\n",
-                tokenAsErrorSite s t
-              ]
-       in (msg, [rangeForToken t])
+    go (Parser.DidntExpectExpression _tok (Just t@(L.payload -> L.SymbolyId (HQ'.NameOnly name))))
+      | name == Name.fromSegment (NameSegment "::") =
+          let msg =
+                mconcat
+                  [ "This looks like the start of an expression here but I was expecting a binding.",
+                    "\nDid you mean to use a single " <> style Code ":",
+                    " here for a type signature?",
+                    "\n\n",
+                    tokenAsErrorSite s t
+                  ]
+           in (msg, [rangeForToken t])
     go (Parser.DidntExpectExpression tok _nextTok) =
       let msg =
             mconcat

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

@@ -6,7 +6,6 @@ where
 import Control.Lens
 import Control.Monad.Reader (MonadReader (..))
 import Data.Map qualified as Map
-import Data.Text qualified as Text
 import Text.Megaparsec qualified as P
 import Unison.ABT qualified as ABT
 import Unison.DataDeclaration (DataDeclaration, EffectDeclaration)
@@ -113,11 +112,11 @@ modifier = do
   where
     unique = do
       tok <- openBlockWith "unique"
-      optional (openBlockWith "[" *> wordyIdString <* closeBlock) >>= \case
+      optional (openBlockWith "[" *> importWordyId <* closeBlock) >>= \case
         Nothing -> do
           guid <- uniqueName 32
           pure (UnresolvedModifier'UniqueWithoutGuid guid <$ tok)
-        Just guid -> pure (UnresolvedModifier'UniqueWithGuid (Text.pack (L.payload guid)) <$ tok)
+        Just guid -> pure (UnresolvedModifier'UniqueWithGuid (Name.toText (L.payload guid)) <$ tok)
     structural = do
       tok <- openBlockWith "structural"
       pure (UnresolvedModifier'Structural <$ tok)

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

@@ -9,14 +9,15 @@ import Unison.ABT qualified as ABT
 import Unison.DataDeclaration (DataDeclaration)
 import Unison.DataDeclaration qualified as DD
 import Unison.Name qualified as Name
+import Unison.NameSegment (NameSegment (..))
 import Unison.Names qualified as Names
 import Unison.Names.ResolutionResult qualified as Names
 import Unison.NamesWithHistory qualified as Names
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.Syntax.DeclParser (declarations)
 import Unison.Syntax.Lexer qualified as L
-import Unison.Syntax.Name qualified as Name (unsafeFromVar)
+import Unison.Syntax.Name qualified as Name (toString, unsafeFromVar)
 import Unison.Syntax.Parser
 import Unison.Syntax.TermParser qualified as TermParser
 import Unison.Term (Term)
@@ -216,10 +217,10 @@ stanza = watchExpression <|> unexpectedAction <|> binding
 
 watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann)
 watched = P.try do
-  kind <- optional wordyIdString
+  kind <- (fmap . fmap . fmap) Name.toString (optional importWordyId)
   guid <- uniqueName 10
-  op <- optional (L.payload <$> P.lookAhead symbolyIdString)
-  guard (op == Just ">")
+  op <- optional (L.payload <$> P.lookAhead importSymbolyId)
+  guard (op == Just (Name.fromSegment (NameSegment ">")))
   tok <- anyToken
   guard $ maybe True (`L.touches` tok) kind
   pure (maybe UF.RegularWatch L.payload kind, guid, maybe mempty ann kind <> ann tok)

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

@@ -30,8 +30,11 @@ import Unison.Builtin.Decls qualified as DD
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import Unison.ConstructorType qualified as CT
 import Unison.HashQualified qualified as HQ
+import Unison.HashQualified' qualified as HQ'
 import Unison.Name (Name)
 import Unison.Name qualified as Name
+import Unison.NameSegment (NameSegment (..))
+import Unison.NameSegment qualified as NameSegment
 import Unison.Names (Names)
 import Unison.Names qualified as Names
 import Unison.NamesWithHistory qualified as Names
@@ -402,16 +405,22 @@ hashQualifiedPrefixTerm = resolveHashQualified =<< hqPrefixId
 hashQualifiedInfixTerm :: (Monad m, Var v) => TermP v m
 hashQualifiedInfixTerm = resolveHashQualified =<< hqInfixId
 
-quasikeyword :: (Ord v) => String -> P v m (L.Token ())
+quasikeyword :: Ord v => Text -> P v m (L.Token ())
 quasikeyword kw = queryToken \case
-  L.WordyId s Nothing | s == kw -> Just ()
+  L.WordyId (HQ'.NameOnly n) | nameIsKeyword n kw -> Just ()
   _ -> Nothing
 
-symbolyQuasikeyword :: (Ord v) => String -> P v m (L.Token ())
+symbolyQuasikeyword :: (Ord v) => Text -> P v m (L.Token ())
 symbolyQuasikeyword kw = queryToken \case
-  L.SymbolyId s Nothing | s == kw -> Just ()
+  L.SymbolyId (HQ'.NameOnly n) | nameIsKeyword n kw -> Just ()
   _ -> Nothing
 
+nameIsKeyword :: Name -> Text -> Bool
+nameIsKeyword name keyword =
+  case (Name.isRelative name, Name.reverseSegments name) of
+    (True, segment NonEmpty.:| []) -> NameSegment.toText segment == keyword
+    _ -> False
+
 -- If the hash qualified is name only, it is treated as a var, if it
 -- has a short hash, we resolve that short hash immediately and fail
 -- committed if that short hash can't be found in the current environment
@@ -960,9 +969,9 @@ bang = P.label "bang" do
 
 seqOp :: (Ord v) => P v m Pattern.SeqOp
 seqOp =
-  (Pattern.Snoc <$ matchToken (L.SymbolyId ":+" Nothing))
-    <|> (Pattern.Cons <$ matchToken (L.SymbolyId "+:" Nothing))
-    <|> (Pattern.Concat <$ matchToken (L.SymbolyId "++" Nothing))
+  Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment (NameSegment ":+"))))
+    <|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment (NameSegment "+:"))))
+    <|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment (NameSegment "++"))))
 
 term4 :: (Monad m, Var v) => TermP v m
 term4 = f <$> some termLeaf

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

@@ -5,6 +5,9 @@ import Data.Set qualified as Set
 import Text.Megaparsec qualified as P
 import Unison.Builtin.Decls qualified as DD
 import Unison.HashQualified qualified as HQ
+import Unison.HashQualified' qualified as HQ'
+import Unison.Name qualified as Name
+import Unison.NameSegment (NameSegment (NameSegment))
 import Unison.NamesWithHistory qualified as Names
 import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
@@ -113,6 +116,6 @@ forall :: (Var v) => TypeP v m -> TypeP v m
 forall rec = do
   kw <- reserved "forall" <|> reserved "∀"
   vars <- fmap (fmap L.payload) . some $ prefixDefinitionName
-  _ <- matchToken $ L.SymbolyId "." Nothing
+  _ <- matchToken $ L.SymbolyId (HQ'.fromName (Name.fromSegment (NameSegment ".")))
   t <- rec
   pure $ Type.foralls (ann kw <> ann t) vars t

unison-core/src/Unison/HashQualified'.hs

@@ -79,6 +79,11 @@ fromNamedReference n r = HashQualified n (Reference.toShortHash r)
 fromName :: n -> HashQualified n
 fromName = NameOnly
 
+fromNameHash :: n -> Maybe ShortHash -> HashQualified n
+fromNameHash name = \case
+  Nothing -> NameOnly name
+  Just hash -> HashQualified name hash
+
 matchesNamedReferent :: (Eq n) => n -> Referent -> HashQualified n -> Bool
 matchesNamedReferent n r = \case
   NameOnly n' -> n' == n

unison-core/src/Unison/Name.hs

@@ -5,6 +5,7 @@ module Unison.Name
 
     -- * Basic construction
     cons,
+    snoc,
     joinDot,
     fromSegment,
     fromSegments,
@@ -120,6 +121,13 @@ cons x name =
           ("cannot cons " ++ show x ++ " onto absolute name" ++ show name)
     Name Relative (y :| ys) -> Name Relative (y :| ys ++ [x])
 
+-- | Snoc a name segment onto the end of a name.
+--
+-- /O(1)/.
+snoc :: Name -> NameSegment -> Name
+snoc (Name pos (s1 :| ss)) s0 =
+  Name pos (s0 :| s1 : ss)
+
 -- | Return the number of name segments in a name.
 --
 -- /O(n)/, where /n/ is the number of name segments.