mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
⅄ trunk → 22-10-18-backticky-parser
This commit is contained in:
commit
cf15f30261
@ -67,6 +67,7 @@ The format for this list: name, GitHub handle
|
||||
* Nicole Prindle (@nprindle)
|
||||
* Harald Gliebe (@hagl)
|
||||
* Phil de Joux (@philderbeast)
|
||||
* Daroc Alden (@setupminimal)
|
||||
* Travis Staton (@tstat)
|
||||
* Dan Freeman (@dfreeman)
|
||||
* Emil Hotkowski (@emilhotkowski)
|
||||
|
@ -1,6 +1,18 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Unison.PrintError where
|
||||
module Unison.PrintError
|
||||
( Env,
|
||||
defaultWidth,
|
||||
prettyParseError,
|
||||
prettyResolutionFailures,
|
||||
prettyVar,
|
||||
printNoteWithSource,
|
||||
renderCompilerBug,
|
||||
renderNoteAsANSI,
|
||||
renderParseErrorAsANSI,
|
||||
renderParseErrors,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens ((%~))
|
||||
import Control.Lens.Tuple (_1, _2, _3)
|
||||
@ -19,7 +31,6 @@ import Data.Text qualified as Text
|
||||
import Text.Megaparsec qualified as P
|
||||
import Unison.ABT qualified as ABT
|
||||
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'
|
||||
@ -80,12 +91,6 @@ pattern Type2 = Color.Green
|
||||
pattern ErrorSite :: Color
|
||||
pattern ErrorSite = Color.HiRed
|
||||
|
||||
pattern TypeKeyword :: Color
|
||||
pattern TypeKeyword = Color.Yellow
|
||||
|
||||
pattern AbilityKeyword :: Color
|
||||
pattern AbilityKeyword = Color.Green
|
||||
|
||||
pattern Identifier :: Color
|
||||
pattern Identifier = Color.Bold
|
||||
|
||||
@ -114,18 +119,6 @@ fromOverHere src spots0 removing =
|
||||
1 -> "\n from right here:\n\n" <> showSource src spots
|
||||
_ -> "\n from these spots, respectively:\n\n" <> showSource src spots
|
||||
|
||||
showTypeWithProvenance ::
|
||||
(Var v, Annotated a, Ord style) =>
|
||||
Env ->
|
||||
String ->
|
||||
style ->
|
||||
Type v a ->
|
||||
Pretty (AnnotatedText style)
|
||||
showTypeWithProvenance env src color typ =
|
||||
style color (renderType' env typ)
|
||||
<> ".\n"
|
||||
<> fromOverHere' src [styleAnnotated color typ] []
|
||||
|
||||
styleAnnotated :: (Annotated a) => sty -> a -> Maybe (Range, sty)
|
||||
styleAnnotated sty a = (,sty) <$> rangeForAnnotated a
|
||||
|
||||
@ -1210,9 +1203,6 @@ renderSuggestion env sug =
|
||||
spaces :: (IsString a, Monoid a) => (b -> a) -> [b] -> a
|
||||
spaces = intercalateMap " "
|
||||
|
||||
arrows :: (IsString a, Monoid a) => (b -> a) -> [b] -> a
|
||||
arrows = intercalateMap " ->"
|
||||
|
||||
commas :: (IsString a, Monoid a) => (b -> a) -> [b] -> a
|
||||
commas = intercalateMap ", "
|
||||
|
||||
@ -1243,17 +1233,6 @@ showConstructor env r =
|
||||
fromString . Text.unpack . HQ.toText $
|
||||
PPE.patternName env r
|
||||
|
||||
styleInOverallType ::
|
||||
(Var v, Annotated a, Eq a) =>
|
||||
Env ->
|
||||
C.Type v a ->
|
||||
C.Type v a ->
|
||||
Color ->
|
||||
Pretty ColorText
|
||||
styleInOverallType e overallType leafType c = renderType e f overallType
|
||||
where
|
||||
f loc s = if loc == ABT.annotation leafType then Color.style c <$> s else s
|
||||
|
||||
_posToEnglish :: (IsString s) => L.Pos -> s
|
||||
_posToEnglish (L.Pos l c) =
|
||||
fromString $ "Line " ++ show l ++ ", Column " ++ show c
|
||||
@ -1928,15 +1907,6 @@ showSource src annotations =
|
||||
showSource1 :: (Ord a) => String -> (Range, a) -> Pretty (AnnotatedText a)
|
||||
showSource1 src annotation = showSource src [annotation]
|
||||
|
||||
findTerm :: Seq (C.PathElement v loc) -> Maybe loc
|
||||
findTerm = go
|
||||
where
|
||||
go (C.InSynthesize t :<| _) = Just $ ABT.annotation t
|
||||
go (C.InCheck t _ :<| _) = Just $ ABT.annotation t
|
||||
go (C.InSynthesizeApp _ t _ :<| _) = Just $ ABT.annotation t
|
||||
go (_ :<| t) = go t
|
||||
go Empty = Nothing
|
||||
|
||||
prettyTypecheckError ::
|
||||
(Var v, Ord loc, Show loc, Parser.Annotated loc) =>
|
||||
C.ErrorNote v loc ->
|
||||
@ -2026,6 +1996,3 @@ useExamples =
|
||||
(Pr.blue "use .foo bar.baz", Pr.wrap "Introduces `bar.baz` as a local alias for the absolute name `.foo.bar.baz`")
|
||||
]
|
||||
]
|
||||
|
||||
prettyPath' :: Path.Path' -> Pretty ColorText
|
||||
prettyPath' p' = Pr.blue (Pr.shown p')
|
||||
|
@ -1,4 +1,6 @@
|
||||
module Unison.Syntax.FileParser where
|
||||
module Unison.Syntax.FileParser
|
||||
( file
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.Reader (asks, local)
|
||||
|
@ -1,4 +1,10 @@
|
||||
module Unison.Syntax.TypeParser where
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Unison.Syntax.TypeParser
|
||||
( computationType
|
||||
, valueType
|
||||
, valueTypeLeaf
|
||||
) where
|
||||
|
||||
import Control.Monad.Reader (asks)
|
||||
import Data.Set qualified as Set
|
||||
|
@ -6,6 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Update2
|
||||
-- * Misc helpers to be organized later
|
||||
addDefinitionsToUnisonFile,
|
||||
findCtorNames,
|
||||
findCtorNamesMaybe,
|
||||
forwardCtorNames,
|
||||
makeParsingEnv,
|
||||
prettyParseTypecheck,
|
||||
@ -143,7 +144,7 @@ handleUpdate2 = do
|
||||
Cli.respond Output.UpdateTypecheckingSuccess
|
||||
pure secondTuf
|
||||
|
||||
saveTuf (findCtorNames Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf
|
||||
saveTuf (findCtorNamesMaybe Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf
|
||||
Cli.respond Output.Success
|
||||
|
||||
-- TODO: find a better module for this function, as it's used in a couple places
|
||||
@ -183,7 +184,7 @@ makeParsingEnv path names = do
|
||||
}
|
||||
|
||||
-- save definitions and namespace
|
||||
saveTuf :: (Name -> Either Output [Name]) -> TypecheckedUnisonFile Symbol Ann -> Cli ()
|
||||
saveTuf :: (Name -> Either Output (Maybe [Name])) -> TypecheckedUnisonFile Symbol Ann -> Cli ()
|
||||
saveTuf getConstructors tuf = do
|
||||
Cli.Env {codebase} <- ask
|
||||
currentPath <- Cli.getCurrentPath
|
||||
@ -206,7 +207,10 @@ saveTuf getConstructors tuf = do
|
||||
-- [ ("foo.bar", insert-term("baz",<#foo>)) ]
|
||||
typecheckedUnisonFileToBranchUpdates ::
|
||||
(forall void. Output -> Transaction void) ->
|
||||
(Name -> Either Output [Name]) ->
|
||||
-- | Returns 'Nothing' if the decl isn't in namesExcludingLibdeps,
|
||||
-- in which case we know the decl is new and do not need to generate
|
||||
-- delete actions for it.
|
||||
(Name -> Either Output (Maybe [Name])) ->
|
||||
TypecheckedUnisonFile Symbol Ann ->
|
||||
Transaction [(Path, Branch0 m -> Branch0 m)]
|
||||
typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
|
||||
@ -225,7 +229,7 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
|
||||
makeDeclUpdates (symbol, (typeRefId, decl)) = do
|
||||
-- some decls will be deleted, we want to delete their
|
||||
-- constructors as well
|
||||
deleteConstructorActions <- case map (BranchUtil.makeAnnihilateTermName . Path.splitFromName) <$> getConstructors (Name.unsafeParseVar symbol) of
|
||||
deleteConstructorActions <- case maybe [] (map (BranchUtil.makeAnnihilateTermName . Path.splitFromName)) <$> getConstructors (Name.unsafeParseVar symbol) of
|
||||
Left err -> abort err
|
||||
Right actions -> pure actions
|
||||
let deleteTypeAction = BranchUtil.makeAnnihilateTypeName split
|
||||
@ -363,9 +367,13 @@ forwardCtorNames names =
|
||||
]
|
||||
|
||||
-- | given a decl name, find names for all of its constructors, in order.
|
||||
--
|
||||
-- Precondition: 'n' is an element of 'names'
|
||||
findCtorNames :: Output.UpdateOrUpgrade -> Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name]
|
||||
findCtorNames operation names forwardCtorNames ctorCount n =
|
||||
let declRef = Set.findMin $ Relation.lookupDom n names.types
|
||||
let declRef = case Set.lookupMin (Relation.lookupDom n names.types) of
|
||||
Nothing -> error "[findCtorNames] precondition violation: n is not an element of names"
|
||||
Just x -> x
|
||||
f = ForwardName.fromName n
|
||||
(_, centerRight) = Map.split f forwardCtorNames
|
||||
(center, _) = Map.split (incrementLastSegmentChar f) centerRight
|
||||
@ -385,6 +393,18 @@ findCtorNames operation names forwardCtorNames ctorCount n =
|
||||
then Right $ Map.elems m
|
||||
else Left $ Output.UpdateIncompleteConstructorSet operation n m ctorCount
|
||||
|
||||
findCtorNamesMaybe ::
|
||||
Output.UpdateOrUpgrade ->
|
||||
Names ->
|
||||
Map ForwardName (Referent, Name) ->
|
||||
Maybe Int ->
|
||||
Name ->
|
||||
Either Output.Output (Maybe [Name])
|
||||
findCtorNamesMaybe operation names forwardCtorNames ctorCount name =
|
||||
case Relation.memberDom name (Names.types names) of
|
||||
True -> Just <$> findCtorNames operation names forwardCtorNames ctorCount name
|
||||
False -> Right Nothing
|
||||
|
||||
-- Used by `findCtorNames` to filter `forwardCtorNames` to a narrow range which will be searched linearly.
|
||||
-- >>> incrementLastSegmentChar $ ForwardName.fromName $ Name.unsafeFromText "foo.bar.quux"
|
||||
-- ForwardName {toList = "foo" :| ["bar","quuy"]}
|
||||
|
@ -25,6 +25,7 @@ import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch
|
||||
import Unison.Codebase.Editor.HandleInput.Update2
|
||||
( addDefinitionsToUnisonFile,
|
||||
findCtorNames,
|
||||
findCtorNamesMaybe,
|
||||
forwardCtorNames,
|
||||
getNamespaceDependentsOf,
|
||||
makeComplicatedPPE,
|
||||
@ -202,7 +203,7 @@ handleUpgrade oldDepName newDepName = do
|
||||
Codebase.addDefsToCodebase codebase typecheckedUnisonFile
|
||||
typecheckedUnisonFileToBranchUpdates
|
||||
abort
|
||||
(findCtorNames Output.UOUUpgrade namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
|
||||
(findCtorNamesMaybe Output.UOUUpgrade namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
|
||||
typecheckedUnisonFile
|
||||
Cli.stepAt
|
||||
textualDescriptionOfUpgrade
|
||||
|
21
unison-src/transcripts/fix4618.md
Normal file
21
unison-src/transcripts/fix4618.md
Normal file
@ -0,0 +1,21 @@
|
||||
```ucm:hide
|
||||
.> builtins.merge
|
||||
```
|
||||
|
||||
```unison
|
||||
foo = 5
|
||||
unique type Bugs.Zonk = Bugs
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
```
|
||||
|
||||
```unison
|
||||
foo = 4
|
||||
unique type Bugs =
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> update
|
||||
```
|
60
unison-src/transcripts/fix4618.output.md
Normal file
60
unison-src/transcripts/fix4618.output.md
Normal file
@ -0,0 +1,60 @@
|
||||
```unison
|
||||
foo = 5
|
||||
unique type Bugs.Zonk = Bugs
|
||||
```
|
||||
|
||||
```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 Bugs.Zonk
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
type Bugs.Zonk
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```unison
|
||||
foo = 4
|
||||
unique type Bugs =
|
||||
```
|
||||
|
||||
```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 Bugs
|
||||
|
||||
⍟ These names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> update
|
||||
|
||||
Okay, I'm searching the branch for code that needs to be
|
||||
updated...
|
||||
|
||||
Done.
|
||||
|
||||
```
|
Loading…
Reference in New Issue
Block a user