mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
fix and move Var.namespaced
This commit is contained in:
parent
fb3104d593
commit
9799b4f479
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
15
unison-syntax/src/Unison/Syntax/Var.hs
Normal file
15
unison-syntax/src/Unison/Syntax/Var.hs
Normal 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))
|
@ -28,6 +28,7 @@ library
|
||||
Unison.Syntax.Parser
|
||||
Unison.Syntax.ReservedWords
|
||||
Unison.Syntax.ShortHash
|
||||
Unison.Syntax.Var
|
||||
Unison.UnisonFile.Error
|
||||
hs-source-dirs:
|
||||
src
|
||||
|
Loading…
Reference in New Issue
Block a user