mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-26 02:55:19 +03:00
allow duplicates in unison file
This commit is contained in:
parent
400e6a0f6a
commit
01d3e6e297
@ -193,8 +193,8 @@ synthesizeFile env0 uf = do
|
||||
Just kind -> (kind, tlc)
|
||||
pure $
|
||||
UF.typecheckedUnisonFile
|
||||
(UF.dataDeclarationsId uf)
|
||||
(UF.effectDeclarationsId uf)
|
||||
(coerce $ UF.dataDeclarationsId uf)
|
||||
(coerce $ UF.effectDeclarationsId uf)
|
||||
terms'
|
||||
(map tlcKind watches')
|
||||
where
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Unison.Syntax.FileParser
|
||||
( file
|
||||
) where
|
||||
( file,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.Reader (asks, local)
|
||||
@ -27,7 +28,7 @@ import Unison.Syntax.TermParser qualified as TermParser
|
||||
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.UnisonFile (UnisonFile (..))
|
||||
import Unison.UnisonFile (UnisonFile, UnisonFile' (..))
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.UnisonFile.Env qualified as UF
|
||||
import Unison.UnisonFile.Names qualified as UFN
|
||||
@ -55,7 +56,7 @@ file = do
|
||||
accessors =
|
||||
[ DD.generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r
|
||||
| (typ, fields) <- parsedAccessors,
|
||||
Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)]
|
||||
(r, _) <- fromMaybe [] (Map.lookup (L.payload typ) (UF.datas env))
|
||||
]
|
||||
toPair (tok, typ) = (L.payload tok, ann tok <> ann typ)
|
||||
let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports]
|
||||
@ -116,13 +117,12 @@ file = do
|
||||
UnisonFileId
|
||||
(UF.datasId env)
|
||||
(UF.effectsId env)
|
||||
(terms <> join accessors)
|
||||
(foldl' (\acc (a, b, c) -> Map.insertWith (++) a [(b, c)] acc) Map.empty (terms <> join accessors))
|
||||
(List.multimap watches)
|
||||
validateUnisonFile uf
|
||||
pure uf
|
||||
|
||||
-- | Final validations and sanity checks to perform before finishing parsing.
|
||||
validateUnisonFile :: (Var v) => UnisonFile v Ann -> P v m ()
|
||||
validateUnisonFile :: (Var v) => UnisonFile' [] v Ann -> P v m (UnisonFile v Ann)
|
||||
validateUnisonFile uf =
|
||||
checkForDuplicateTermsAndConstructors uf
|
||||
|
||||
@ -131,9 +131,10 @@ validateUnisonFile uf =
|
||||
-- constructors and verify that no duplicates exist in the file, triggering an error if needed.
|
||||
checkForDuplicateTermsAndConstructors ::
|
||||
forall m v.
|
||||
(Ord v) =>
|
||||
UnisonFile v Ann ->
|
||||
P v m ()
|
||||
Ord v =>
|
||||
Show v =>
|
||||
UnisonFile' [] v Ann ->
|
||||
P v m (UnisonFile v Ann)
|
||||
checkForDuplicateTermsAndConstructors uf = do
|
||||
when (not . null $ duplicates) $ do
|
||||
let dupeList :: [(v, [Ann])]
|
||||
@ -142,11 +143,19 @@ checkForDuplicateTermsAndConstructors uf = do
|
||||
& fmap Set.toList
|
||||
& Map.toList
|
||||
P.customFailure (DuplicateTermNames dupeList)
|
||||
when (not . null $ duplicateTypes) $ do
|
||||
let dupeList :: [(v, [Ann])]
|
||||
dupeList =
|
||||
duplicateTypes
|
||||
& fmap Set.toList
|
||||
& Map.toList
|
||||
P.customFailure (DuplicateTypeNames dupeList)
|
||||
pure (UF.mapF extractSingle uf)
|
||||
where
|
||||
effectDecls :: [DataDeclaration v Ann]
|
||||
effectDecls = (Map.elems . fmap (DD.toDataDecl . snd) $ (effectDeclarationsId uf))
|
||||
effectDecls = map (DD.toDataDecl . snd) . concat $ Map.elems (effectDeclarationsId uf)
|
||||
dataDecls :: [DataDeclaration v Ann]
|
||||
dataDecls = fmap snd $ Map.elems (dataDeclarationsId uf)
|
||||
dataDecls = map snd . concat $ Map.elems (dataDeclarationsId uf)
|
||||
allConstructors :: [(v, Ann)]
|
||||
allConstructors =
|
||||
(dataDecls <> effectDecls)
|
||||
@ -154,8 +163,18 @@ checkForDuplicateTermsAndConstructors uf = do
|
||||
& fmap (\(ann, v, _typ) -> (v, ann))
|
||||
allTerms :: [(v, Ann)]
|
||||
allTerms =
|
||||
UF.terms uf
|
||||
<&> (\(v, bindingAnn, _t) -> (v, bindingAnn))
|
||||
Map.foldrWithKey (\k vs b -> map (\(ann, _) -> (k, ann)) vs ++ b) [] (UF.terms uf)
|
||||
|
||||
duplicateTypes :: Map v (Set Ann)
|
||||
duplicateTypes =
|
||||
Map.filter
|
||||
((> 1) . Set.size)
|
||||
( Map.unionWith
|
||||
(<>)
|
||||
(Set.fromList . map (DD.annotation . DD.toDataDecl . snd) <$> effectDeclarationsId uf)
|
||||
(Set.fromList . map (DD.annotation . snd) <$> dataDeclarationsId uf)
|
||||
)
|
||||
|
||||
mergedTerms :: Map v (Set Ann)
|
||||
mergedTerms =
|
||||
(allConstructors <> allTerms)
|
||||
@ -166,6 +185,12 @@ checkForDuplicateTermsAndConstructors uf = do
|
||||
-- Any vars with multiple annotations are duplicates.
|
||||
Map.filter ((> 1) . Set.size) mergedTerms
|
||||
|
||||
extractSingle :: forall k v. Show k => k -> [v] -> Identity v
|
||||
extractSingle k = \case
|
||||
[] -> error ("[extractSingle] impossible: empty list at " <> show k)
|
||||
[v] -> Identity v
|
||||
_ -> error ("[extractSingle] impossible: duplicates found at " <> show k)
|
||||
|
||||
-- A stanza is either a watch expression like:
|
||||
-- > 1 + x
|
||||
-- > z = x + 1
|
||||
|
@ -5,7 +5,8 @@
|
||||
|
||||
module Unison.UnisonFile
|
||||
( -- * UnisonFile
|
||||
UnisonFile (..),
|
||||
UnisonFile' (..),
|
||||
UnisonFile,
|
||||
pattern UnisonFile,
|
||||
emptyUnisonFile,
|
||||
allWatches,
|
||||
@ -16,6 +17,9 @@ module Unison.UnisonFile
|
||||
typecheckingTerm,
|
||||
watchesOfKind,
|
||||
definitionLocation,
|
||||
traverseTerms,
|
||||
termBindings,
|
||||
mapF,
|
||||
|
||||
-- * TypecheckedUnisonFile
|
||||
TypecheckedUnisonFile (..),
|
||||
@ -60,7 +64,7 @@ import Unison.Term qualified as Term
|
||||
import Unison.Type (Type)
|
||||
import Unison.Type qualified as Type
|
||||
import Unison.Typechecker.TypeLookup qualified as TL
|
||||
import Unison.UnisonFile.Type (TypecheckedUnisonFile (..), UnisonFile (..), pattern TypecheckedUnisonFile, pattern UnisonFile)
|
||||
import Unison.UnisonFile.Type (TypecheckedUnisonFile (..), UnisonFile, UnisonFile' (..), pattern TypecheckedUnisonFile, pattern UnisonFile)
|
||||
import Unison.Util.List qualified as List
|
||||
import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var
|
||||
@ -72,15 +76,24 @@ emptyUnisonFile =
|
||||
UnisonFileId
|
||||
{ dataDeclarationsId = Map.empty,
|
||||
effectDeclarationsId = Map.empty,
|
||||
terms = [],
|
||||
terms = Map.empty,
|
||||
watches = Map.empty
|
||||
}
|
||||
|
||||
mapF :: forall f g v a. (forall x. v -> f x -> g x) -> UnisonFile' f v a -> UnisonFile' g v a
|
||||
mapF phi UnisonFileId {dataDeclarationsId, effectDeclarationsId, terms, watches} =
|
||||
UnisonFileId
|
||||
{ dataDeclarationsId = Map.mapWithKey phi dataDeclarationsId,
|
||||
effectDeclarationsId = Map.mapWithKey phi effectDeclarationsId,
|
||||
terms = Map.mapWithKey phi terms,
|
||||
watches = watches
|
||||
}
|
||||
|
||||
dataDeclarations :: UnisonFile v a -> Map v (Reference, DataDeclaration v a)
|
||||
dataDeclarations = fmap (first Reference.DerivedId) . dataDeclarationsId
|
||||
dataDeclarations = fmap (first Reference.DerivedId) . coerce . dataDeclarationsId
|
||||
|
||||
effectDeclarations :: UnisonFile v a -> Map v (Reference, EffectDeclaration v a)
|
||||
effectDeclarations = fmap (first Reference.DerivedId) . effectDeclarationsId
|
||||
effectDeclarations = fmap (first Reference.DerivedId) . coerce . effectDeclarationsId
|
||||
|
||||
watchesOfKind :: WatchKind -> UnisonFile v a -> [(v, a, Term v a)]
|
||||
watchesOfKind kind uf = Map.findWithDefault [] kind (watches uf)
|
||||
@ -95,7 +108,7 @@ allWatches = join . Map.elems . watches
|
||||
-- | Get the location of a given definition in the file.
|
||||
definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a
|
||||
definitionLocation v uf =
|
||||
terms uf ^? folded . filteredBy (_1 . only v) . _2
|
||||
terms uf ^? ix v . _Wrapping Identity . _1
|
||||
<|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2
|
||||
<|> dataDeclarations uf ^? ix v . _2 . to DD.annotation
|
||||
<|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl)
|
||||
@ -108,11 +121,14 @@ typecheckingTerm uf =
|
||||
DD.unitTerm mempty
|
||||
where
|
||||
bindings =
|
||||
terms uf <> testWatches <> watchesOfOtherKinds TestWatch uf
|
||||
termBindings uf <> testWatches <> watchesOfOtherKinds TestWatch uf
|
||||
-- we make sure each test has type Test.Result
|
||||
f w = let wa = ABT.annotation w in Term.ann wa w (DD.testResultType wa)
|
||||
testWatches = map (second f) $ watchesOfKind TestWatch uf
|
||||
|
||||
termBindings :: UnisonFile v a -> [(v, a, Term v a)]
|
||||
termBindings uf = Map.foldrWithKey (\k (Identity (a, t)) b -> (k, a, t) : b) [] (terms uf)
|
||||
|
||||
-- backwards compatibility with the old data type
|
||||
dataDeclarations' :: TypecheckedUnisonFile v a -> Map v (Reference, DataDeclaration v a)
|
||||
dataDeclarations' = fmap (first Reference.DerivedId) . dataDeclarationsId'
|
||||
@ -123,11 +139,20 @@ effectDeclarations' = fmap (first Reference.DerivedId) . effectDeclarationsId'
|
||||
hashTerms :: TypecheckedUnisonFile v a -> Map v (a, Reference, Maybe WatchKind, Term v a, Type v a)
|
||||
hashTerms = fmap (over _2 Reference.DerivedId) . hashTermsId
|
||||
|
||||
mapTerms :: (Term v a -> Term v a) -> UnisonFile v a -> UnisonFile v a
|
||||
traverseTerms ::
|
||||
Applicative f =>
|
||||
Traversable t =>
|
||||
((v, a, Term v a) -> f (a, Term v a)) ->
|
||||
UnisonFile' t v a ->
|
||||
f (UnisonFile' t v a)
|
||||
traverseTerms f uf =
|
||||
uf & #terms . itraversed <. traverse %%@~ (\k (a, t) -> f (k, a, t))
|
||||
|
||||
mapTerms :: Functor f => (Term v a -> Term v a) -> UnisonFile' f v a -> UnisonFile' f v a
|
||||
mapTerms f (UnisonFileId datas effects terms watches) =
|
||||
UnisonFileId datas effects terms' watches'
|
||||
where
|
||||
terms' = over _3 f <$> terms
|
||||
terms' = terms & mapped . mapped . _2 %~ f
|
||||
watches' = fmap (over _3 f) <$> watches
|
||||
|
||||
-- | This function should be called in preparation for a call to
|
||||
@ -157,7 +182,7 @@ mapTerms f (UnisonFileId datas effects terms watches) =
|
||||
-- then converting back to a "regular" UnisonFile with free variables in the
|
||||
-- terms.
|
||||
prepareRewrite :: (Monoid a, Var v) => UnisonFile v a -> ([v] -> Term v a -> Term v a, UnisonFile v a, UnisonFile v a -> UnisonFile v a)
|
||||
prepareRewrite uf@(UnisonFileId _datas _effects terms watches) =
|
||||
prepareRewrite uf@(UnisonFileId _datas _effects _terms watches) =
|
||||
(freshen, mapTerms substs uf, mapTerms refToVar)
|
||||
where
|
||||
-- fn to replace free vars with unique refs
|
||||
@ -178,7 +203,7 @@ prepareRewrite uf@(UnisonFileId _datas _effects terms watches) =
|
||||
varToRef =
|
||||
[(v, Term.ref () (Reference.Derived h i)) | (v, i) <- vs `zip` [0 ..]]
|
||||
where
|
||||
vs = (view _1 <$> terms) <> (toList watches >>= map (view _1))
|
||||
vs = (view _1 <$> (termBindings uf)) <> (toList watches >>= map (view _1))
|
||||
vars = Vector.fromList (fst <$> varToRef)
|
||||
-- function to convert unique refs back to free variables
|
||||
refToVar = ABT.rebuildUp' go
|
||||
@ -194,17 +219,18 @@ prepareRewrite uf@(UnisonFileId _datas _effects terms watches) =
|
||||
-- This function returns what symbols were modified.
|
||||
-- The `Set v` is symbols that should be left alone.
|
||||
rewrite :: (Var v, Eq a) => Set v -> (Term v a -> Maybe (Term v a)) -> UnisonFile v a -> ([v], UnisonFile v a)
|
||||
rewrite leaveAlone rewriteFn (UnisonFileId datas effects terms watches) =
|
||||
(rewritten, UnisonFileId datas effects (unEither terms') (unEither <$> watches'))
|
||||
rewrite leaveAlone rewriteFn uf@(UnisonFileId datas effects _terms watches) =
|
||||
(rewritten, UnisonFileId datas effects (Map.fromList $ unEitherTerms terms') (unEither <$> watches'))
|
||||
where
|
||||
terms' = go terms
|
||||
terms' = go (termBindings uf)
|
||||
watches' = go <$> watches
|
||||
go tms = [(v, a, tm') | (v, a, tm) <- tms, tm' <- f v tm]
|
||||
where
|
||||
f v tm | Set.member v leaveAlone = [Left tm]
|
||||
f _ tm = maybe [Left tm] (pure . Right) (rewriteFn tm)
|
||||
rewritten = [v | (v, _, Right _) <- terms' <> join (toList watches')]
|
||||
unEither = fmap (\(v, a, e) -> (v, a, case e of Left tm -> tm; Right tm -> tm))
|
||||
unEitherTerms = fmap (\(v, a, e) -> (v, Identity (a, either id id e)))
|
||||
unEither = fmap (\(v, a, e) -> (v, a, either id id e))
|
||||
|
||||
typecheckedUnisonFile ::
|
||||
forall v a.
|
||||
@ -299,14 +325,14 @@ dependencies :: (Monoid a, Var v) => UnisonFile v a -> Set Reference
|
||||
dependencies (UnisonFile ds es ts ws) =
|
||||
foldMap (DD.typeDependencies . snd) ds
|
||||
<> foldMap (DD.typeDependencies . DD.toDataDecl . snd) es
|
||||
<> foldMap (Term.dependencies . view _3) ts
|
||||
<> foldMap (Term.dependencies . snd) ts
|
||||
<> foldMap (foldMap (Term.dependencies . view _3)) ws
|
||||
|
||||
discardTypes :: TypecheckedUnisonFile v a -> UnisonFile v a
|
||||
discardTypes :: Ord v => TypecheckedUnisonFile v a -> UnisonFile v a
|
||||
discardTypes (TypecheckedUnisonFileId datas effects terms watches _) =
|
||||
let watches' = g . mconcat <$> List.multimap watches
|
||||
g tup3s = [(v, a, e) | (v, a, e, _t) <- tup3s]
|
||||
in UnisonFileId datas effects [(v, a, trm) | (v, a, trm, _typ) <- join terms] watches'
|
||||
in UnisonFileId (coerce datas) (coerce effects) (Map.fromList [(v, Identity (a, trm)) | (v, a, trm, _typ) <- join terms]) watches'
|
||||
|
||||
declsToTypeLookup :: (Var v) => UnisonFile v a -> TL.TypeLookup v a
|
||||
declsToTypeLookup uf =
|
||||
|
@ -13,12 +13,12 @@ import Unison.Reference qualified as Reference
|
||||
|
||||
data Env v a = Env
|
||||
-- Data declaration name to hash and its fully resolved form
|
||||
{ datasId :: Map v (Reference.Id, DataDeclaration v a),
|
||||
{ datasId :: Map v [(Reference.Id, DataDeclaration v a)],
|
||||
-- Effect declaration name to hash and its fully resolved form
|
||||
effectsId :: Map v (Reference.Id, EffectDeclaration v a),
|
||||
effectsId :: Map v [(Reference.Id, EffectDeclaration v a)],
|
||||
-- Naming environment
|
||||
names :: Names
|
||||
}
|
||||
|
||||
datas :: Env v a -> Map v (Reference, DataDeclaration v a)
|
||||
datas = fmap (first Reference.DerivedId) . datasId
|
||||
datas :: Env v a -> Map v [(Reference, DataDeclaration v a)]
|
||||
datas = (fmap . fmap) (first Reference.DerivedId) . datasId
|
||||
|
@ -21,18 +21,18 @@ import Unison.Term qualified as Term
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.UnisonFile.Env (Env (..))
|
||||
import Unison.UnisonFile.Error (Error (DupDataAndAbility, UnknownType))
|
||||
import Unison.UnisonFile.Type (TypecheckedUnisonFile (TypecheckedUnisonFileId), UnisonFile (UnisonFileId))
|
||||
import Unison.UnisonFile.Type (TypecheckedUnisonFile (TypecheckedUnisonFileId), UnisonFile, UnisonFile' (UnisonFileId))
|
||||
import Unison.Util.List qualified as List
|
||||
import Unison.Util.Relation qualified as Relation
|
||||
import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var
|
||||
import Unison.WatchKind qualified as WK
|
||||
|
||||
toNames :: (Var v) => UnisonFile v a -> Names
|
||||
toNames :: (Var v, Foldable f) => UnisonFile' f v a -> Names
|
||||
toNames uf = datas <> effects
|
||||
where
|
||||
datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf))
|
||||
effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeParseVar) (Map.toList (UF.effectDeclarationsId uf))
|
||||
datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf) >>= sequenceA . fmap toList)
|
||||
effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeParseVar) (Map.toList (UF.effectDeclarationsId uf) >>= sequenceA . fmap toList)
|
||||
|
||||
addNamesFromUnisonFile :: (Var v) => UnisonFile v a -> Names -> Names
|
||||
addNamesFromUnisonFile unisonFile names = Names.shadowing (toNames unisonFile) names
|
||||
@ -84,10 +84,9 @@ bindNames names (UnisonFileId d e ts ws) = do
|
||||
-- todo: consider having some kind of binding structure for terms & watches
|
||||
-- so that you don't weirdly have free vars to tiptoe around.
|
||||
-- The free vars should just be the things that need to be bound externally.
|
||||
let termVars = (view _1 <$> ts) ++ (Map.elems ws >>= map (view _1))
|
||||
termVarsSet = Set.fromList termVars
|
||||
let termVarsSet = (Map.keysSet ts) <> Set.fromList (Map.elems ws >>= map (view _1))
|
||||
-- todo: can we clean up this lambda using something like `second`
|
||||
ts' <- traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t) ts
|
||||
ts' <- (traverse . traverse) (\(a, t) -> (a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t) ts
|
||||
ws' <- traverse (traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t)) ws
|
||||
pure $ UnisonFileId d e ts' ws'
|
||||
|
||||
@ -162,5 +161,5 @@ environmentFor names dataDecls0 effectDecls0 = do
|
||||
]
|
||||
pure $
|
||||
if null overlaps && null unknownTypeRefs
|
||||
then pure $ Env dataDecls' effectDecls' names'
|
||||
then pure $ Env ((:[]) <$> dataDecls') ((:[]) <$> effectDecls') names'
|
||||
else Left (unknownTypeRefs ++ overlaps)
|
||||
|
@ -83,8 +83,8 @@ mkFileSummary parsed typechecked = case (parsed, typechecked) of
|
||||
}
|
||||
(Just uf@(UF.UnisonFileId {dataDeclarationsId, effectDeclarationsId, terms, watches}), _) ->
|
||||
let trms =
|
||||
terms & foldMap \(sym, ann, trm) ->
|
||||
(Map.singleton sym (ann, Nothing, trm, Nothing))
|
||||
let f sym (ann, trm) = (Map.singleton sym (ann, Nothing, trm, Nothing))
|
||||
in ifoldMapOf (itraversed <. _Wrapping Identity) f terms
|
||||
(testWatches, exprWatches) =
|
||||
watches & ifoldMap \wk tms ->
|
||||
tms & foldMap \(v, ann, trm) ->
|
||||
@ -93,10 +93,10 @@ mkFileSummary parsed typechecked = case (parsed, typechecked) of
|
||||
_ -> (mempty, [(ann, assertUserSym v, Nothing, trm, Nothing, Just wk)])
|
||||
in Just $
|
||||
FileSummary
|
||||
{ dataDeclsBySymbol = dataDeclarationsId,
|
||||
dataDeclsByReference = declsRefMap dataDeclarationsId,
|
||||
effectDeclsBySymbol = effectDeclarationsId,
|
||||
effectDeclsByReference = declsRefMap effectDeclarationsId,
|
||||
{ dataDeclsBySymbol = coerce dataDeclarationsId,
|
||||
dataDeclsByReference = declsRefMap (coerce dataDeclarationsId),
|
||||
effectDeclsBySymbol = coerce effectDeclarationsId,
|
||||
effectDeclsByReference = declsRefMap (coerce effectDeclarationsId),
|
||||
termsBySymbol = trms,
|
||||
termsByReference = termsRefMap trms,
|
||||
testWatchSummary = testWatches,
|
||||
@ -121,7 +121,7 @@ mkFileSummary parsed typechecked = case (parsed, typechecked) of
|
||||
getUserTypeAnnotation :: Symbol -> Maybe (Type Symbol Ann)
|
||||
getUserTypeAnnotation v = do
|
||||
UF.UnisonFileId {terms, watches} <- parsed
|
||||
trm <- (terms <> fold watches) ^? folded . filteredBy (_1 . only v) . _3
|
||||
trm <- terms ^? ix v . _Wrapping Identity . _2 <|> watches ^? folded . folded . filteredBy (_1 . only v) . _3
|
||||
typ <- Term.getTypeAnnotation trm
|
||||
pure typ
|
||||
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Unison.UnisonFile.Type where
|
||||
@ -15,25 +16,29 @@ import Unison.Type (Type)
|
||||
import Unison.Type qualified as Type
|
||||
import Unison.WatchKind (WatchKind)
|
||||
|
||||
data UnisonFile v a = UnisonFileId
|
||||
{ dataDeclarationsId :: Map v (TypeReferenceId, DataDeclaration v a),
|
||||
effectDeclarationsId :: Map v (TypeReferenceId, EffectDeclaration v a),
|
||||
terms :: [(v, a {- ann for whole binding -}, Term v a)],
|
||||
data UnisonFile' f v a = UnisonFileId
|
||||
{ dataDeclarationsId :: Map v (f (TypeReferenceId, DataDeclaration v a)),
|
||||
effectDeclarationsId :: Map v (f (TypeReferenceId, EffectDeclaration v a)),
|
||||
terms :: Map v (f (a {- ann for whole binding -}, Term v a)),
|
||||
watches :: Map WatchKind [(v, a {- ann for whole watch -}, Term v a)]
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
deriving (Generic)
|
||||
|
||||
deriving instance (forall x. Show x => Show (f x), Show v, Show a) => Show (UnisonFile' f v a)
|
||||
|
||||
type UnisonFile = UnisonFile' Identity
|
||||
|
||||
pattern UnisonFile ::
|
||||
Map v (TypeReference, DataDeclaration v a) ->
|
||||
Map v (TypeReference, EffectDeclaration v a) ->
|
||||
[(v, a, Term v a)] ->
|
||||
Map v (a, Term v a) ->
|
||||
Map WatchKind [(v, a, Term v a)] ->
|
||||
UnisonFile v a
|
||||
pattern UnisonFile ds es tms ws <-
|
||||
UnisonFileId
|
||||
(fmap (first Reference.DerivedId) -> ds)
|
||||
(fmap (first Reference.DerivedId) -> es)
|
||||
tms
|
||||
(fmap (first Reference.DerivedId) . coerce -> ds)
|
||||
(fmap (first Reference.DerivedId) . coerce -> es)
|
||||
(coerce -> tms)
|
||||
ws
|
||||
|
||||
{-# COMPLETE UnisonFile #-}
|
||||
|
@ -18,13 +18,13 @@ import Unison.Reference qualified as R
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Test.Common qualified as Common
|
||||
import Unison.Type qualified as Type
|
||||
import Unison.UnisonFile (UnisonFile (..))
|
||||
import Unison.UnisonFile (UnisonFile, UnisonFile' (..))
|
||||
import Unison.Var qualified as Var
|
||||
|
||||
test :: Test ()
|
||||
test =
|
||||
scope "datadeclaration" $
|
||||
let hashes = fromRight (error "Expected Right") $ Hashing.hashDataDecls . (snd <$>) . dataDeclarationsId $ file
|
||||
let hashes = fromRight (error "Expected Right") $ Hashing.hashDataDecls . (snd . runIdentity <$>) . dataDeclarationsId $ file
|
||||
hashMap = Map.fromList $ fmap (\(a, b, _) -> (a, b)) hashes
|
||||
hashOf k = Map.lookup (Var.named k) hashMap
|
||||
in tests
|
||||
|
@ -405,13 +405,13 @@ prettyLabeledDependencies ppe lds =
|
||||
LD.TermReferent r -> prettyHashQualified (PPE.termNameOrHashOnly ppe r)
|
||||
LD.TypeReference r -> "type " <> prettyHashQualified (PPE.typeNameOrHashOnly ppe r)
|
||||
|
||||
prettyUnisonFile :: forall v a. (Var v, Ord a) => PPED.PrettyPrintEnvDecl -> UF.UnisonFile v a -> P.Pretty P.ColorText
|
||||
prettyUnisonFile :: forall f v a. (Foldable f, Var v, Ord a) => PPED.PrettyPrintEnvDecl -> UF.UnisonFile' f v a -> P.Pretty P.ColorText
|
||||
prettyUnisonFile ppe uf@(UF.UnisonFileId datas effects terms watches) =
|
||||
P.sep "\n\n" (map snd . sortOn fst $ prettyEffects <> prettyDatas <> catMaybes prettyTerms <> prettyWatches)
|
||||
where
|
||||
prettyEffects = map prettyEffectDecl (Map.toList effects)
|
||||
(prettyDatas, accessorNames) = runWriter $ traverse prettyDataDecl (Map.toList datas)
|
||||
prettyTerms = map (prettyTerm accessorNames) terms
|
||||
prettyEffects = map prettyEffectDecl (Map.toList effects >>= sequenceA . fmap toList)
|
||||
(prettyDatas, accessorNames) = runWriter $ traverse prettyDataDecl (Map.toList datas >>= sequenceA . fmap toList)
|
||||
prettyTerms = map (prettyTerm accessorNames) (Map.toList terms >>= sequenceA . fmap toList)
|
||||
prettyWatches = Map.toList watches >>= \(wk, tms) -> map (prettyWatch . (wk,)) tms
|
||||
|
||||
prettyEffectDecl :: (v, (Reference.Id, DD.EffectDeclaration v a)) -> (a, P.Pretty P.ColorText)
|
||||
@ -420,8 +420,8 @@ prettyUnisonFile ppe uf@(UF.UnisonFileId datas effects terms watches) =
|
||||
prettyDataDecl :: (v, (Reference.Id, DD.DataDeclaration v a)) -> Writer (Set AccessorName) (a, P.Pretty P.ColorText)
|
||||
prettyDataDecl (n, (r, dt)) =
|
||||
(DD.annotation dt,) . st <$> (mapWriter (second Set.fromList) $ DeclPrinter.prettyDeclW ppe' (rd r) (hqv n) (Right dt))
|
||||
prettyTerm :: Set (AccessorName) -> (v, a, Term v a) -> Maybe (a, P.Pretty P.ColorText)
|
||||
prettyTerm skip (n, a, tm) =
|
||||
prettyTerm :: Set (AccessorName) -> (v, (a, Term v a)) -> Maybe (a, P.Pretty P.ColorText)
|
||||
prettyTerm skip (n, (a, tm)) =
|
||||
if traceMember isMember then Nothing else Just (a, pb hq tm)
|
||||
where
|
||||
traceMember =
|
||||
|
@ -43,7 +43,7 @@ typecheckTerm ::
|
||||
)
|
||||
typecheckTerm codebase tm = do
|
||||
let v = Symbol 0 (Var.Inference Var.Other)
|
||||
let file = UF.UnisonFileId mempty mempty [(v, External, tm)] mempty
|
||||
let file = UF.UnisonFileId mempty mempty (Map.singleton v (Identity (External, tm))) mempty
|
||||
typeLookup <- Codebase.typeLookupForDependencies codebase (UF.dependencies file)
|
||||
let typecheckingEnv =
|
||||
Typechecker.Env
|
||||
|
@ -167,8 +167,8 @@ formatFile makePPEDForFile formattingWidth currentPath inputParsedFile inputType
|
||||
mkUnisonFilesDeterministic mayUnisonFile mayTypecheckedFile =
|
||||
let sortedUF =
|
||||
mayUnisonFile
|
||||
& _Just . #dataDeclarationsId . traversed . _2 %~ sortConstructors
|
||||
& _Just . #effectDeclarationsId . traversed . _2 . Decl.asDataDecl_ %~ sortConstructors
|
||||
& _Just . #dataDeclarationsId . traversed . _Wrapping Identity . _2 %~ sortConstructors
|
||||
& _Just . #effectDeclarationsId . traversed . _Wrapping Identity . _2 . Decl.asDataDecl_ %~ sortConstructors
|
||||
sortedTF =
|
||||
mayTypecheckedFile
|
||||
& _Just . #dataDeclarationsId' . traversed . _2 %~ sortConstructors
|
||||
@ -199,8 +199,8 @@ annToInterval ann = annToRange ann <&> rangeToInterval
|
||||
-- parsed file, false otherwise.
|
||||
hasUserTypeSignature :: Eq v => UnisonFile v a -> v -> Bool
|
||||
hasUserTypeSignature parsedFile sym =
|
||||
UF.terms parsedFile
|
||||
& any (\(v, _, trm) -> v == sym && isJust (Term.getTypeAnnotation trm))
|
||||
Map.toList (UF.terms parsedFile)
|
||||
& any (\(v, Identity (_, trm)) -> v == sym && isJust (Term.getTypeAnnotation trm))
|
||||
|
||||
-- | A text replacement to apply to a file.
|
||||
data TextReplacement = TextReplacement
|
||||
|
@ -62,7 +62,6 @@ import Unison.Typechecker qualified as Typechecker
|
||||
import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.UnisonFile.Names qualified as UF
|
||||
import Unison.UnisonFile.Type (UnisonFile (UnisonFileId))
|
||||
import Unison.Util.Map qualified as Map (remap, upsert)
|
||||
import Unison.Util.Monoid (foldMapM)
|
||||
import Unison.Util.Relation qualified as R
|
||||
@ -493,17 +492,16 @@ getSlurpResultForUpdate requestedNames slurpCheckNames = do
|
||||
|
||||
let unisonFile :: UnisonFile Symbol Ann
|
||||
unisonFile =
|
||||
UnisonFileId
|
||||
{ dataDeclarationsId = UF.dataDeclarationsId' (Slurp.originalFile slurp0),
|
||||
effectDeclarationsId = UF.effectDeclarationsId' (Slurp.originalFile slurp0),
|
||||
UF.UnisonFileId
|
||||
{ dataDeclarationsId = coerce $ UF.dataDeclarationsId' (Slurp.originalFile slurp0),
|
||||
effectDeclarationsId = coerce $ UF.effectDeclarationsId' (Slurp.originalFile slurp0),
|
||||
-- Running example:
|
||||
--
|
||||
-- fresh1 = fresh3 + 4
|
||||
-- fresh2 = fresh1 + 2
|
||||
-- fresh3 = fresh2 + 3
|
||||
terms =
|
||||
Map.elems refToGeneratedNameAndTerm <&> \(v, term) ->
|
||||
(v, External, term),
|
||||
terms =
|
||||
Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v,term) -> (v, Identity (External, term)),
|
||||
-- In the context of this update, whatever watches were in the latest typechecked Unison file are
|
||||
-- irrelevant, so we don't need to copy them over.
|
||||
watches = Map.empty
|
||||
|
@ -129,7 +129,7 @@ handleUpdate2 = do
|
||||
and
|
||||
[ Map.size (UF.dataDeclarations smallUf) == Map.size (UF.dataDeclarations bigUf),
|
||||
Map.size (UF.effectDeclarations smallUf) == Map.size (UF.effectDeclarations bigUf),
|
||||
length @[] (UF.terms smallUf) == length @[] (UF.terms bigUf),
|
||||
Map.size (UF.terms smallUf) == Map.size (UF.terms bigUf),
|
||||
Map.size (UF.watches smallUf) == Map.size (UF.watches bigUf)
|
||||
]
|
||||
if noChanges
|
||||
@ -306,9 +306,9 @@ addDefinitionsToUnisonFile abort codebase doFindCtorNames (terms, types) =
|
||||
let prependTerm to = (v, Ann.External, tm) : to
|
||||
in if isTest tp
|
||||
then uf & #watches . Lens.at WK.TestWatch . Lens.non [] Lens.%~ prependTerm
|
||||
else uf & #terms Lens.%~ prependTerm
|
||||
else uf & #terms Lens.%~ Map.insert v (Identity (Ann.External, tm))
|
||||
termNames =
|
||||
Set.fromList [v | (v, _, _) <- uf.terms]
|
||||
Map.keysSet uf.terms
|
||||
<> foldMap (\x -> Set.fromList [v | (v, _, _) <- x]) uf.watches
|
||||
|
||||
isTest = Typechecker.isEqual (Decls.testResultType mempty)
|
||||
@ -332,10 +332,10 @@ addDefinitionsToUnisonFile abort codebase doFindCtorNames (terms, types) =
|
||||
addRebuiltDefinition decl uf name = case decl of
|
||||
Left ed ->
|
||||
overwriteConstructorNames name ed.toDataDecl >>= \case
|
||||
ed' -> pure uf {UF.effectDeclarationsId = Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') uf.effectDeclarationsId}
|
||||
ed' -> pure uf {UF.effectDeclarationsId = Map.insertWith (\_new old -> old) (Name.toVar name) (Identity (Reference.Id h i, Decl.EffectDeclaration ed')) uf.effectDeclarationsId}
|
||||
Right dd ->
|
||||
overwriteConstructorNames name dd >>= \case
|
||||
dd' -> pure uf {UF.dataDeclarationsId = Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') uf.dataDeclarationsId}
|
||||
dd' -> pure uf {UF.dataDeclarationsId = Map.insertWith (\_new old -> old) (Name.toVar name) (Identity (Reference.Id h i, dd')) uf.dataDeclarationsId}
|
||||
|
||||
overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann)
|
||||
overwriteConstructorNames name dd =
|
||||
|
@ -56,7 +56,7 @@ import Unison.Term (Term)
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.Type (Type)
|
||||
import Unison.Typechecker qualified as Typechecker
|
||||
import Unison.UnisonFile (UnisonFile (..))
|
||||
import Unison.UnisonFile (UnisonFile' (..))
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.Util.Monoid (foldMapM)
|
||||
import Unison.Util.Relation qualified as R
|
||||
@ -549,10 +549,9 @@ propagate patch b = case validatePatch patch of
|
||||
mempty
|
||||
mempty
|
||||
( componentMap
|
||||
& Map.toList
|
||||
& fmap
|
||||
( \(v, (_ref, tm, _)) ->
|
||||
(v, External, tm)
|
||||
<&>
|
||||
( \(_ref, tm, _) ->
|
||||
Identity (External, tm)
|
||||
)
|
||||
)
|
||||
mempty
|
||||
|
@ -444,9 +444,9 @@ mkTypeSignatureHints :: UF.UnisonFile Symbol Ann -> UF.TypecheckedUnisonFile Sym
|
||||
mkTypeSignatureHints parsedFile typecheckedFile = do
|
||||
let symbolsWithoutTypeSigs :: Map Symbol Ann
|
||||
symbolsWithoutTypeSigs =
|
||||
UF.terms parsedFile
|
||||
Map.toList (UF.terms parsedFile)
|
||||
& mapMaybe
|
||||
( \(v, ann, trm) -> do
|
||||
( \(v, Identity (ann, trm)) -> do
|
||||
-- We only want hints for terms without a user signature
|
||||
guard (isNothing $ Term.getTypeAnnotation trm)
|
||||
pure (v, ann)
|
||||
|
@ -19,7 +19,7 @@ import Unison.LSP.Types
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.UnisonFile (UnisonFile (..))
|
||||
import Unison.UnisonFile (UnisonFile' (..))
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.Var qualified as Var
|
||||
|
||||
@ -39,12 +39,12 @@ foldingRangesForFile UnisonFileId {dataDeclarationsId, effectDeclarationsId, ter
|
||||
let dataFolds =
|
||||
dataDeclarationsId
|
||||
& Map.toList
|
||||
& map \(sym, (_typ, decl)) -> (Just sym, DD.annotation decl)
|
||||
& map \(sym, Identity (_typ, decl)) -> (Just sym, DD.annotation decl)
|
||||
abilityFolds =
|
||||
effectDeclarationsId
|
||||
& Map.toList
|
||||
& map \(sym, (_typ, decl)) -> (Just sym, DD.annotation . DD.toDataDecl $ decl)
|
||||
termFolds = terms & fmap \(sym, ann, _trm) -> (Just sym, ann)
|
||||
& map \(sym, Identity (_typ, decl)) -> (Just sym, DD.annotation . DD.toDataDecl $ decl)
|
||||
termFolds = terms & Map.toList & fmap \(sym, Identity (ann, _trm)) -> (Just sym, ann)
|
||||
watchFolds =
|
||||
watches
|
||||
& fold
|
||||
|
@ -75,13 +75,13 @@ bar =
|
||||
use Nat +
|
||||
x + c.y.y.y.y
|
||||
|
||||
d.y.y.y.y : Nat
|
||||
d.y.y.y.y =
|
||||
c.y.y.y.y : Nat
|
||||
c.y.y.y.y =
|
||||
use Nat +
|
||||
foo + 10
|
||||
|
||||
c.y.y.y.y : Nat
|
||||
c.y.y.y.y =
|
||||
d.y.y.y.y : Nat
|
||||
d.y.y.y.y =
|
||||
use Nat +
|
||||
foo + 10
|
||||
|
||||
|
@ -107,12 +107,12 @@ We want the field accessors to go away; but for now they are here, causing the u
|
||||
Foo.baz : Foo -> Int
|
||||
Foo.baz = cases Foo _ baz -> baz
|
||||
|
||||
Foo.baz.set : Int -> Foo -> Foo
|
||||
Foo.baz.set baz1 = cases Foo bar _ -> Foo bar baz1
|
||||
|
||||
Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo
|
||||
Foo.baz.modify f = cases Foo bar baz -> Foo bar (f baz)
|
||||
|
||||
Foo.baz.set : Int -> Foo -> Foo
|
||||
Foo.baz.set baz1 = cases Foo bar _ -> Foo bar baz1
|
||||
|
||||
type Foo = { bar : Nat }
|
||||
```
|
||||
|
||||
|
@ -55,14 +55,14 @@ bar =
|
||||
use Nat +
|
||||
x + c.y.y.y.y
|
||||
|
||||
d.y.y.y.y : Nat
|
||||
d.y.y.y.y =
|
||||
use Nat +
|
||||
foo + 10
|
||||
|
||||
c.y.y.y.y : Nat
|
||||
c.y.y.y.y =
|
||||
use Nat +
|
||||
foo + 10
|
||||
|
||||
d.y.y.y.y : Nat
|
||||
d.y.y.y.y =
|
||||
use Nat +
|
||||
foo + 10
|
||||
```
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user