fix and move Var.namespaced

This commit is contained in:
Mitchell Rosen 2024-02-01 13:48:51 -05:00
parent fb3104d593
commit 9799b4f479
8 changed files with 40 additions and 30 deletions

View File

@ -27,6 +27,7 @@ import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result qualified as Result
import Unison.Syntax.Var qualified as Var (namespaced)
import Unison.Term qualified as Term
import Unison.Type qualified as Type
import Unison.Typechecker qualified as Typechecker
@ -83,7 +84,7 @@ hashFieldAccessors ::
)
hashFieldAccessors ppe declName vars declRef dd = do
let accessors :: [(v, (), Term.Term v ())]
accessors = DD.generateRecordAccessors mempty (map (,()) vars) declName declRef
accessors = DD.generateRecordAccessors Var.namespaced mempty (map (,()) vars) declName declRef
let typeLookup :: TypeLookup v ()
typeLookup =
TypeLookup

View File

@ -5,6 +5,7 @@ where
import Control.Lens
import Control.Monad.Reader (MonadReader (..))
import Data.List.NonEmpty (pattern (:|))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Text.Megaparsec qualified as P
@ -19,10 +20,11 @@ import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
import Unison.Syntax.Parser
import Unison.Syntax.TermParser qualified as TermParser
import Unison.Syntax.TypeParser qualified as TypeParser
import Unison.Syntax.Var qualified as Var (namespaced)
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.Var qualified as Var (name, named)
import Prelude hiding (readFile)
-- The parsed form of record accessors, as in:
@ -162,7 +164,7 @@ dataDeclaration maybeUnresolvedModifier = do
ctorAnn = ann ctorName <> maybe (ann ctorName) ann (lastMay ctorArgs)
in ( ctorAnn,
( ann ctorName,
Var.namespaced [L.payload name, L.payload ctorName],
Var.namespaced (L.payload name :| [L.payload ctorName]),
Type.foralls ctorAnn typeArgVs ctorType
)
)
@ -263,7 +265,7 @@ effectDeclaration maybeUnresolvedModifier = do
<$> TypeParser.computationType
)
where
explodeToken v t = (ann v, Var.namespaced [L.payload name, L.payload v], t)
explodeToken v t = (ann v, Var.namespaced (L.payload name :| [L.payload v]), t)
-- If the effect is not syntactically present in the constructor types,
-- add them after parsing.
ensureEffect t = case t of

View File

@ -1,15 +1,12 @@
module Unison.Syntax.DeclPrinter (prettyDecl, prettyDeclW, prettyDeclHeader, prettyDeclOrBuiltinHeader, AccessorName) where
import Control.Monad.Writer (Writer, runWriter, tell)
import Data.List.NonEmpty (pattern (:|))
import Data.Map qualified as Map
import Data.Text qualified as Text
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration
( DataDeclaration,
EffectDeclaration,
toDataDecl,
)
import Unison.DataDeclaration (DataDeclaration, EffectDeclaration, toDataDecl)
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.Dependencies qualified as DD
import Unison.HashQualified qualified as HQ
@ -25,12 +22,13 @@ import Unison.Syntax.HashQualified qualified as HQ (toText, toVar, unsafeParseTe
import Unison.Syntax.NamePrinter (styleHashQualified'')
import Unison.Syntax.TypePrinter (runPretty)
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Syntax.Var qualified as Var (namespaced)
import Unison.Type qualified as Type
import Unison.Util.Pretty (Pretty)
import Unison.Util.Pretty qualified as P
import Unison.Util.SyntaxText qualified as S
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.Var qualified as Var (freshenId, name, named)
type SyntaxText = S.SyntaxText' Reference
@ -199,7 +197,7 @@ fieldNames env r name dd = do
Just
[ HQ.unsafeParseText name
| v <- vars,
Just (ref, _, _) <- [Map.lookup (Var.namespaced [HQ.toVar name, v]) hashes],
Just (ref, _, _) <- [Map.lookup (Var.namespaced (HQ.toVar name :| [v])) hashes],
Just name <- [Map.lookup ref fieldNames]
]
else Nothing

View File

@ -2,6 +2,7 @@ module Unison.Syntax.FileParser where
import Control.Lens
import Control.Monad.Reader (asks, local)
import Data.List.NonEmpty (pattern (:|))
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
@ -21,6 +22,7 @@ import Unison.Syntax.Lexer qualified as L
import Unison.Syntax.Name qualified as Name (toText, 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.Term qualified as Term
import Unison.UnisonFile (UnisonFile (..))
@ -49,7 +51,7 @@ file = do
Left es -> resolutionFailures (toList es)
let accessors :: [[(v, Ann, Term v Ann)]]
accessors =
[ DD.generateRecordAccessors Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r
[ 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)]
]
@ -215,7 +217,7 @@ stanza = watchExpression <|> unexpectedAction <|> binding
binding@((_, v), _) <- TermParser.binding
pure $ case doc of
Nothing -> Binding binding
Just (spanAnn, doc) -> Bindings [((spanAnn, Var.joinDot v (Var.named "doc")), doc), binding]
Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced (v :| [Var.named "doc"])), doc), binding]
watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann)
watched = P.try do

View File

@ -39,6 +39,8 @@ where
import Control.Lens (Iso', Lens', imap, iso, lens, over, _3)
import Control.Monad.State (evalState)
import Data.List.NonEmpty (pattern (:|))
import Data.List.NonEmpty qualified as List (NonEmpty)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.ABT qualified as ABT
@ -147,19 +149,20 @@ withEffectDeclM f = fmap EffectDeclaration . f . toDataDecl
-- propose to move this code to some very feature-specific module —AI
generateRecordAccessors ::
(Semigroup a, Var v) =>
(List.NonEmpty v -> v) ->
(a -> a) ->
[(v, a)] ->
v ->
Reference ->
[(v, a, Term v a)]
generateRecordAccessors generatedAnn fields typename typ =
generateRecordAccessors namespaced generatedAnn fields typename typ =
join [tm t i | (t, i) <- fields `zip` [(0 :: Int) ..]]
where
argname = Var.uncapitalize typename
tm (fname, fieldAnn) i =
[ (Var.namespaced [typename, fname], ann, get),
(Var.namespaced [typename, fname, Var.named "set"], ann, set),
(Var.namespaced [typename, fname, Var.named "modify"], ann, modify)
[ (namespaced (typename :| [fname]), ann, get),
(namespaced (typename :| [fname, Var.named "set"]), ann, set),
(namespaced (typename :| [fname, Var.named "modify"]), ann, modify)
]
where
ann = generatedAnn fieldAnn

View File

@ -16,13 +16,11 @@ module Unison.Var
inferTypeConstructor,
inferTypeConstructorArg,
isAction,
joinDot,
missingResult,
name,
nameStr,
named,
nameds,
namespaced,
rawName,
reset,
uncapitalize,
@ -32,13 +30,12 @@ module Unison.Var
)
where
import Data.Char (isLower, toLower, isAlphaNum)
import Data.Char (isAlphaNum, isLower, toLower)
import Data.Text (pack)
import Data.Text qualified as Text
import Unison.ABT qualified as ABT
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Util.Monoid (intercalateMap)
import Unison.WatchKind (WatchKind, pattern TestWatch)
-- | A class for variables. Variables may have auxiliary information which
@ -194,21 +191,12 @@ data InferenceType
reset :: (Var v) => v -> v
reset v = typed (typeOf v)
namespaced :: (Var v) => [v] -> v
namespaced vs = named $ intercalateMap "." name vs
nameStr :: (Var v) => v -> String
nameStr = Text.unpack . name
nameds :: (Var v) => String -> v
nameds s = named (Text.pack s)
joinDot :: (Var v) => v -> v -> v
joinDot prefix v2 =
if name prefix == "."
then named (name prefix `mappend` name v2)
else named (name prefix `mappend` "." `mappend` name v2)
universallyQuantifyIfFree :: forall v. (Var v) => v -> Bool
universallyQuantifyIfFree v =
Text.all isLower (Text.take 1 n) && Text.all isAlphaNum n

View File

@ -0,0 +1,15 @@
module Unison.Syntax.Var
( namespaced,
)
where
import Data.List.NonEmpty (pattern (:|))
import Data.List.NonEmpty qualified as List (NonEmpty)
import Unison.Name qualified as Name
import Unison.Prelude
import Unison.Syntax.Name qualified as Name
import Unison.Var (Var)
namespaced :: (Var v) => List.NonEmpty v -> v
namespaced (v :| vs) =
Name.toVar (foldl' Name.joinDot (Name.unsafeParseVar v) (map Name.unsafeParseVar vs))

View File

@ -28,6 +28,7 @@ library
Unison.Syntax.Parser
Unison.Syntax.ReservedWords
Unison.Syntax.ShortHash
Unison.Syntax.Var
Unison.UnisonFile.Error
hs-source-dirs:
src