mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Adds structural keyword requirement
This commit is contained in:
parent
4eaf392e6e
commit
51e2ea0898
@ -157,7 +157,7 @@ fieldNames env r name dd = case DD.constructors dd of
|
||||
_ -> Nothing
|
||||
|
||||
prettyModifier :: DD.Modifier -> Pretty SyntaxText
|
||||
prettyModifier DD.Structural = mempty
|
||||
prettyModifier DD.Structural = fmt S.DataTypeModifier "structural"
|
||||
prettyModifier (DD.Unique _uid) =
|
||||
fmt S.DataTypeModifier "unique" -- <> ("[" <> P.text uid <> "] ")
|
||||
|
||||
|
@ -212,18 +212,22 @@ declarations = do
|
||||
[ (v, DD.annotation <$> ds) | (v, ds) <- Map.toList mdsBad ] <>
|
||||
[ (v, DD.annotation . DD.toDataDecl <$> es) | (v, es) <- Map.toList mesBad ]
|
||||
|
||||
modifier :: Var v => P v (L.Token DD.Modifier)
|
||||
-- unique[someguid] type Blah = ...
|
||||
modifier :: Var v => P v (Maybe (L.Token DD.Modifier))
|
||||
modifier = do
|
||||
o <- optional (openBlockWith "unique")
|
||||
case o of
|
||||
Nothing -> fmap (const DD.Structural) <$> P.lookAhead anyToken
|
||||
Just tok -> do
|
||||
optional (unique <|> structural)
|
||||
where
|
||||
unique = do
|
||||
tok <- openBlockWith "unique"
|
||||
uid <- do
|
||||
o <- optional (reserved "[" *> wordyIdString <* reserved "]")
|
||||
case o of
|
||||
Nothing -> uniqueName 32
|
||||
Just uid -> pure (fromString . L.payload $ uid)
|
||||
pure (DD.Unique uid <$ tok)
|
||||
structural = do
|
||||
tok <- openBlockWith "structural"
|
||||
pure (DD.Structural <$ tok)
|
||||
|
||||
declaration :: Var v
|
||||
=> P v (Either (v, DataDeclaration v Ann, Accessors v)
|
||||
@ -235,10 +239,10 @@ declaration = do
|
||||
dataDeclaration
|
||||
:: forall v
|
||||
. Var v
|
||||
=> L.Token DD.Modifier
|
||||
=> Maybe (L.Token DD.Modifier)
|
||||
-> P v (v, DataDeclaration v Ann, Accessors v)
|
||||
dataDeclaration mod = do
|
||||
_ <- fmap void (reserved "type") <|> openBlockWith "type"
|
||||
keywordTok <- fmap void (reserved "type") <|> openBlockWith "type"
|
||||
(name, typeArgs) <-
|
||||
(,) <$> TermParser.verifyRelativeVarName prefixDefinitionName
|
||||
<*> many (TermParser.verifyRelativeVarName prefixDefinitionName)
|
||||
@ -274,16 +278,19 @@ dataDeclaration mod = do
|
||||
-- otherwise ann of name
|
||||
closingAnn :: Ann
|
||||
closingAnn = last (ann eq : ((\(_,_,t) -> ann t) <$> constructors))
|
||||
pure (L.payload name,
|
||||
DD.mkDataDecl' (L.payload mod) (ann mod <> closingAnn) typeArgVs constructors,
|
||||
accessors)
|
||||
case mod of
|
||||
Nothing -> P.customFailure $ MissingTypeModifier ("type" <$ keywordTok) name
|
||||
Just mod' ->
|
||||
pure (L.payload name,
|
||||
DD.mkDataDecl' (L.payload mod') (ann mod' <> closingAnn) typeArgVs constructors,
|
||||
accessors)
|
||||
|
||||
effectDeclaration
|
||||
:: Var v => L.Token DD.Modifier -> P v (v, EffectDeclaration v Ann)
|
||||
:: Var v => Maybe (L.Token DD.Modifier) -> P v (v, EffectDeclaration v Ann)
|
||||
effectDeclaration mod = do
|
||||
_ <- fmap void (reserved "ability") <|> openBlockWith "ability"
|
||||
name <- TermParser.verifyRelativeVarName prefixDefinitionName
|
||||
typeArgs <- many (TermParser.verifyRelativeVarName prefixDefinitionName)
|
||||
keywordTok <- fmap void (reserved "ability") <|> openBlockWith "ability"
|
||||
name <- TermParser.verifyRelativeVarName prefixDefinitionName
|
||||
typeArgs <- many (TermParser.verifyRelativeVarName prefixDefinitionName)
|
||||
let typeArgVs = L.payload <$> typeArgs
|
||||
blockStart <- openBlockWith "where"
|
||||
constructors <- sepBy semi (constructor typeArgs name)
|
||||
@ -291,13 +298,17 @@ effectDeclaration mod = do
|
||||
_ <- closeBlock <* closeBlock
|
||||
let closingAnn =
|
||||
last $ ann blockStart : ((\(_, _, t) -> ann t) <$> constructors)
|
||||
pure
|
||||
( L.payload name
|
||||
, DD.mkEffectDecl' (L.payload mod)
|
||||
(ann mod <> closingAnn)
|
||||
typeArgVs
|
||||
constructors
|
||||
)
|
||||
|
||||
case mod of
|
||||
Nothing -> P.customFailure $ MissingTypeModifier ("ability" <$ keywordTok) name
|
||||
Just mod' ->
|
||||
pure
|
||||
( L.payload name
|
||||
, DD.mkEffectDecl' (L.payload mod')
|
||||
(ann mod' <> closingAnn)
|
||||
typeArgVs
|
||||
constructors
|
||||
)
|
||||
where
|
||||
constructor
|
||||
:: Var v => [L.Token v] -> L.Token v -> P v (Ann, v, Type v Ann)
|
||||
|
@ -11,6 +11,9 @@ module Unison.Lexer (
|
||||
escapeChars,
|
||||
debugFileLex, debugLex', debugLex'', debugLex''',
|
||||
showEscapeChar, touches,
|
||||
typeModifiers,
|
||||
typeOrAbilityAlt,
|
||||
typeModifiersAlt,
|
||||
-- todo: these probably don't belong here
|
||||
wordyIdChar, wordyIdStartChar,
|
||||
wordyId, symbolyId, wordyId0, symbolyId0)
|
||||
@ -330,7 +333,9 @@ lexemes' eof = P.optional space >> do
|
||||
wordyKw kw = separated wordySep (lit kw)
|
||||
subsequentTypeName = P.lookAhead . P.optional $ do
|
||||
let lit' s = lit s <* sp
|
||||
_ <- P.optional (lit' "unique") *> (wordyKw "type" <|> wordyKw "ability") <* sp
|
||||
let modifier = typeModifiersAlt lit'
|
||||
let typeOrAbility' = typeOrAbilityAlt wordyKw
|
||||
_ <- modifier <* typeOrAbility' *> sp
|
||||
wordyId
|
||||
ignore _ _ _ = []
|
||||
body = join <$> P.many (sectionElem <* CP.space)
|
||||
@ -392,7 +397,7 @@ lexemes' eof = P.optional space >> do
|
||||
pure s
|
||||
|
||||
typeLink = wrap "syntax.docEmbedTypeLink" $ do
|
||||
_ <- (lit "type" <|> lit "ability") <* CP.space
|
||||
_ <- typeOrAbilityAlt lit <* CP.space
|
||||
tok (symbolyId <|> wordyId) <* CP.space
|
||||
|
||||
termLink = wrap "syntax.docEmbedTermLink" $
|
||||
@ -792,7 +797,9 @@ lexemes' eof = P.optional space >> do
|
||||
where
|
||||
ifElse = openKw "if" <|> close' (Just "then") ["if"] (lit "then")
|
||||
<|> close' (Just "else") ["then"] (lit "else")
|
||||
typ = openKw1 wordySep "unique" <|> openTypeKw1 "type" <|> openTypeKw1 "ability"
|
||||
modKw = typeModifiersAlt (openKw1 wordySep)
|
||||
typeOrAbilityKw = typeOrAbilityAlt openTypeKw1
|
||||
typ = modKw <|> typeOrAbilityKw
|
||||
|
||||
withKw = do
|
||||
[Token _ pos1 pos2] <- wordyKw "with"
|
||||
@ -807,12 +814,14 @@ lexemes' eof = P.optional space >> do
|
||||
let opens = [Token (Open "with") pos1 pos2]
|
||||
pure $ replicate n (Token Close pos1 pos2) ++ opens
|
||||
|
||||
-- In `unique type` and `unique ability`, only the `unique` opens a layout block,
|
||||
-- In `structural/unique type` and `structural/unique ability`,
|
||||
-- only the `structural` or `unique` opens a layout block,
|
||||
-- and `ability` and `type` are just keywords.
|
||||
openTypeKw1 t = do
|
||||
b <- S.gets (topBlockName . layout)
|
||||
case b of Just "unique" -> wordyKw t
|
||||
_ -> openKw1 wordySep t
|
||||
case b of
|
||||
Just mod | Set.member mod typeModifiers -> wordyKw t
|
||||
_ -> openKw1 wordySep t
|
||||
|
||||
-- layout keyword which bumps the layout column by 1, rather than looking ahead
|
||||
-- to the next token to determine the layout column
|
||||
@ -827,7 +836,7 @@ lexemes' eof = P.optional space >> do
|
||||
env <- S.get
|
||||
case topBlockName (layout env) of
|
||||
-- '=' does not open a layout block if within a type declaration
|
||||
Just t | t == "type" || t == "unique" -> pure [Token (Reserved "=") start end]
|
||||
Just t | t == "type" || Set.member t typeModifiers -> pure [Token (Reserved "=") start end]
|
||||
Just _ -> S.put (env { opening = Just "=" }) >> pure [Token (Open "=") start end]
|
||||
_ -> err start LayoutError
|
||||
|
||||
@ -981,9 +990,8 @@ reorder :: [T (Token Lexeme)] -> [T (Token Lexeme)]
|
||||
reorder = join . sortWith f . stanzas where
|
||||
f [] = 3 :: Int
|
||||
f (t0 : _) = case payload $ headToken t0 of
|
||||
Open "type" -> 1
|
||||
Open "unique" -> 1
|
||||
Open "ability" -> 1
|
||||
Open mod | Set.member mod typeModifiers -> 1
|
||||
Open typOrA | Set.member typOrA typeOrAbility -> 1
|
||||
Reserved "use" -> 0
|
||||
_ -> 3 :: Int
|
||||
|
||||
@ -1089,11 +1097,25 @@ symbolyIdChars = Set.fromList "!$%^&*-=+<>.~\\/|:"
|
||||
keywords :: Set String
|
||||
keywords = Set.fromList [
|
||||
"if", "then", "else", "forall", "∀",
|
||||
"handle", "with", "unique",
|
||||
"handle", "with",
|
||||
"where", "use",
|
||||
"true", "false",
|
||||
"type", "ability", "alias", "typeLink", "termLink",
|
||||
"let", "namespace", "match", "cases"]
|
||||
"alias", "typeLink", "termLink",
|
||||
"let", "namespace", "match", "cases"] <> typeModifiers <> typeOrAbility
|
||||
|
||||
typeOrAbility :: Set String
|
||||
typeOrAbility = Set.fromList ["type", "ability"]
|
||||
|
||||
typeOrAbilityAlt :: Alternative f => (String -> f a) -> f a
|
||||
typeOrAbilityAlt f =
|
||||
asum $ map f (toList typeOrAbility)
|
||||
|
||||
typeModifiers :: Set String
|
||||
typeModifiers = Set.fromList ["structural", "unique"]
|
||||
|
||||
typeModifiersAlt :: Alternative f => (String -> f a) -> f a
|
||||
typeModifiersAlt f =
|
||||
asum $ map f (toList typeModifiers)
|
||||
|
||||
delimiters :: Set Char
|
||||
delimiters = Set.fromList "()[]{},?;"
|
||||
|
@ -5,6 +5,20 @@
|
||||
module Unison.Parser where
|
||||
|
||||
import Unison.Prelude
|
||||
( trace,
|
||||
join,
|
||||
foldl',
|
||||
Text,
|
||||
optional,
|
||||
Alternative((<|>), many),
|
||||
Set,
|
||||
void,
|
||||
when,
|
||||
fromMaybe,
|
||||
isJust,
|
||||
listToMaybe,
|
||||
encodeUtf8,
|
||||
lastMay )
|
||||
|
||||
import qualified Crypto.Random as Random
|
||||
import Data.Bytes.Put (runPutS)
|
||||
@ -101,6 +115,8 @@ data Error v
|
||||
| UseEmpty (L.Token String) -- an empty `use` statement
|
||||
| DidntExpectExpression (L.Token L.Lexeme) (Maybe (L.Token L.Lexeme))
|
||||
| TypeDeclarationErrors [UF.Error v Ann]
|
||||
-- MissingTypeModifier (type|ability) name
|
||||
| MissingTypeModifier (L.Token String) (L.Token v)
|
||||
| ResolutionFailures [Names.ResolutionFailure v Ann]
|
||||
| DuplicateTypeNames [(v, [Ann])]
|
||||
| DuplicateTermNames [(v, [Ann])]
|
||||
|
@ -69,6 +69,10 @@ pattern Identifier = Color.Bold
|
||||
defaultWidth :: Pr.Width
|
||||
defaultWidth = 60
|
||||
|
||||
-- Various links used in error messages, collected here for a quick overview
|
||||
structuralVsUniqueDocsLink :: IsString a => Pretty a
|
||||
structuralVsUniqueDocsLink = "https://www.unisonweb.org/docs/language-reference/#unique-types"
|
||||
|
||||
fromOverHere'
|
||||
:: Ord a
|
||||
=> String
|
||||
@ -1287,6 +1291,15 @@ prettyParseError s = \case
|
||||
missing = Set.null referents
|
||||
go (Parser.ResolutionFailures failures) =
|
||||
Pr.border 2 . prettyResolutionFailures s $ failures
|
||||
go (Parser.MissingTypeModifier keyword name) = Pr.lines
|
||||
[ Pr.wrap $
|
||||
"I expected to see `structural` or `unique` at the start of this line:"
|
||||
, ""
|
||||
, tokensAsErrorSite s [void keyword, void name]
|
||||
, Pr.wrap $ "Learn more about when to use `structural` vs `unique` in the Unison Docs: "
|
||||
<> structuralVsUniqueDocsLink
|
||||
]
|
||||
|
||||
unknownConstructor
|
||||
:: String -> L.Token (HashQualified Name) -> Pretty ColorText
|
||||
unknownConstructor ctorType tok = Pr.lines [
|
||||
|
Loading…
Reference in New Issue
Block a user