mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-26 11:07:48 +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 (Referent)
|
||||||
import Unison.Referent qualified as Referent
|
import Unison.Referent qualified as Referent
|
||||||
import Unison.Result qualified as Result
|
import Unison.Result qualified as Result
|
||||||
|
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||||
import Unison.Term qualified as Term
|
import Unison.Term qualified as Term
|
||||||
import Unison.Type qualified as Type
|
import Unison.Type qualified as Type
|
||||||
import Unison.Typechecker qualified as Typechecker
|
import Unison.Typechecker qualified as Typechecker
|
||||||
@ -83,7 +84,7 @@ hashFieldAccessors ::
|
|||||||
)
|
)
|
||||||
hashFieldAccessors ppe declName vars declRef dd = do
|
hashFieldAccessors ppe declName vars declRef dd = do
|
||||||
let accessors :: [(v, (), Term.Term v ())]
|
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 ()
|
let typeLookup :: TypeLookup v ()
|
||||||
typeLookup =
|
typeLookup =
|
||||||
TypeLookup
|
TypeLookup
|
||||||
|
@ -5,6 +5,7 @@ where
|
|||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Control.Monad.Reader (MonadReader (..))
|
import Control.Monad.Reader (MonadReader (..))
|
||||||
|
import Data.List.NonEmpty (pattern (:|))
|
||||||
import Data.List.NonEmpty qualified as NonEmpty
|
import Data.List.NonEmpty qualified as NonEmpty
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
import Text.Megaparsec qualified as P
|
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.Parser
|
||||||
import Unison.Syntax.TermParser qualified as TermParser
|
import Unison.Syntax.TermParser qualified as TermParser
|
||||||
import Unison.Syntax.TypeParser qualified as TypeParser
|
import Unison.Syntax.TypeParser qualified as TypeParser
|
||||||
|
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||||
import Unison.Type (Type)
|
import Unison.Type (Type)
|
||||||
import Unison.Type qualified as Type
|
import Unison.Type qualified as Type
|
||||||
import Unison.Var (Var)
|
import Unison.Var (Var)
|
||||||
import Unison.Var qualified as Var
|
import Unison.Var qualified as Var (name, named)
|
||||||
import Prelude hiding (readFile)
|
import Prelude hiding (readFile)
|
||||||
|
|
||||||
-- The parsed form of record accessors, as in:
|
-- The parsed form of record accessors, as in:
|
||||||
@ -162,7 +164,7 @@ dataDeclaration maybeUnresolvedModifier = do
|
|||||||
ctorAnn = ann ctorName <> maybe (ann ctorName) ann (lastMay ctorArgs)
|
ctorAnn = ann ctorName <> maybe (ann ctorName) ann (lastMay ctorArgs)
|
||||||
in ( ctorAnn,
|
in ( ctorAnn,
|
||||||
( ann ctorName,
|
( ann ctorName,
|
||||||
Var.namespaced [L.payload name, L.payload ctorName],
|
Var.namespaced (L.payload name :| [L.payload ctorName]),
|
||||||
Type.foralls ctorAnn typeArgVs ctorType
|
Type.foralls ctorAnn typeArgVs ctorType
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@ -263,7 +265,7 @@ effectDeclaration maybeUnresolvedModifier = do
|
|||||||
<$> TypeParser.computationType
|
<$> TypeParser.computationType
|
||||||
)
|
)
|
||||||
where
|
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,
|
-- If the effect is not syntactically present in the constructor types,
|
||||||
-- add them after parsing.
|
-- add them after parsing.
|
||||||
ensureEffect t = case t of
|
ensureEffect t = case t of
|
||||||
|
@ -1,15 +1,12 @@
|
|||||||
module Unison.Syntax.DeclPrinter (prettyDecl, prettyDeclW, prettyDeclHeader, prettyDeclOrBuiltinHeader, AccessorName) where
|
module Unison.Syntax.DeclPrinter (prettyDecl, prettyDeclW, prettyDeclHeader, prettyDeclOrBuiltinHeader, AccessorName) where
|
||||||
|
|
||||||
import Control.Monad.Writer (Writer, runWriter, tell)
|
import Control.Monad.Writer (Writer, runWriter, tell)
|
||||||
|
import Data.List.NonEmpty (pattern (:|))
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
import Data.Text qualified as Text
|
import Data.Text qualified as Text
|
||||||
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
|
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
|
||||||
import Unison.ConstructorType qualified as CT
|
import Unison.ConstructorType qualified as CT
|
||||||
import Unison.DataDeclaration
|
import Unison.DataDeclaration (DataDeclaration, EffectDeclaration, toDataDecl)
|
||||||
( DataDeclaration,
|
|
||||||
EffectDeclaration,
|
|
||||||
toDataDecl,
|
|
||||||
)
|
|
||||||
import Unison.DataDeclaration qualified as DD
|
import Unison.DataDeclaration qualified as DD
|
||||||
import Unison.DataDeclaration.Dependencies qualified as DD
|
import Unison.DataDeclaration.Dependencies qualified as DD
|
||||||
import Unison.HashQualified qualified as HQ
|
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.NamePrinter (styleHashQualified'')
|
||||||
import Unison.Syntax.TypePrinter (runPretty)
|
import Unison.Syntax.TypePrinter (runPretty)
|
||||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||||
|
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||||
import Unison.Type qualified as Type
|
import Unison.Type qualified as Type
|
||||||
import Unison.Util.Pretty (Pretty)
|
import Unison.Util.Pretty (Pretty)
|
||||||
import Unison.Util.Pretty qualified as P
|
import Unison.Util.Pretty qualified as P
|
||||||
import Unison.Util.SyntaxText qualified as S
|
import Unison.Util.SyntaxText qualified as S
|
||||||
import Unison.Var (Var)
|
import Unison.Var (Var)
|
||||||
import Unison.Var qualified as Var
|
import Unison.Var qualified as Var (freshenId, name, named)
|
||||||
|
|
||||||
type SyntaxText = S.SyntaxText' Reference
|
type SyntaxText = S.SyntaxText' Reference
|
||||||
|
|
||||||
@ -199,7 +197,7 @@ fieldNames env r name dd = do
|
|||||||
Just
|
Just
|
||||||
[ HQ.unsafeParseText name
|
[ HQ.unsafeParseText name
|
||||||
| v <- vars,
|
| 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]
|
Just name <- [Map.lookup ref fieldNames]
|
||||||
]
|
]
|
||||||
else Nothing
|
else Nothing
|
||||||
|
@ -2,6 +2,7 @@ module Unison.Syntax.FileParser where
|
|||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Control.Monad.Reader (asks, local)
|
import Control.Monad.Reader (asks, local)
|
||||||
|
import Data.List.NonEmpty (pattern (:|))
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
import Data.Set qualified as Set
|
import Data.Set qualified as Set
|
||||||
import Data.Text qualified as Text
|
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.Name qualified as Name (toText, unsafeParseVar)
|
||||||
import Unison.Syntax.Parser
|
import Unison.Syntax.Parser
|
||||||
import Unison.Syntax.TermParser qualified as TermParser
|
import Unison.Syntax.TermParser qualified as TermParser
|
||||||
|
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||||
import Unison.Term (Term)
|
import Unison.Term (Term)
|
||||||
import Unison.Term qualified as Term
|
import Unison.Term qualified as Term
|
||||||
import Unison.UnisonFile (UnisonFile (..))
|
import Unison.UnisonFile (UnisonFile (..))
|
||||||
@ -49,7 +51,7 @@ file = do
|
|||||||
Left es -> resolutionFailures (toList es)
|
Left es -> resolutionFailures (toList es)
|
||||||
let accessors :: [[(v, Ann, Term v Ann)]]
|
let accessors :: [[(v, Ann, Term v Ann)]]
|
||||||
accessors =
|
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,
|
| (typ, fields) <- parsedAccessors,
|
||||||
Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)]
|
Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)]
|
||||||
]
|
]
|
||||||
@ -215,7 +217,7 @@ stanza = watchExpression <|> unexpectedAction <|> binding
|
|||||||
binding@((_, v), _) <- TermParser.binding
|
binding@((_, v), _) <- TermParser.binding
|
||||||
pure $ case doc of
|
pure $ case doc of
|
||||||
Nothing -> Binding binding
|
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 :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann)
|
||||||
watched = P.try do
|
watched = P.try do
|
||||||
|
@ -39,6 +39,8 @@ where
|
|||||||
|
|
||||||
import Control.Lens (Iso', Lens', imap, iso, lens, over, _3)
|
import Control.Lens (Iso', Lens', imap, iso, lens, over, _3)
|
||||||
import Control.Monad.State (evalState)
|
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.Map qualified as Map
|
||||||
import Data.Set qualified as Set
|
import Data.Set qualified as Set
|
||||||
import Unison.ABT qualified as ABT
|
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
|
-- propose to move this code to some very feature-specific module —AI
|
||||||
generateRecordAccessors ::
|
generateRecordAccessors ::
|
||||||
(Semigroup a, Var v) =>
|
(Semigroup a, Var v) =>
|
||||||
|
(List.NonEmpty v -> v) ->
|
||||||
(a -> a) ->
|
(a -> a) ->
|
||||||
[(v, a)] ->
|
[(v, a)] ->
|
||||||
v ->
|
v ->
|
||||||
Reference ->
|
Reference ->
|
||||||
[(v, a, Term v a)]
|
[(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) ..]]
|
join [tm t i | (t, i) <- fields `zip` [(0 :: Int) ..]]
|
||||||
where
|
where
|
||||||
argname = Var.uncapitalize typename
|
argname = Var.uncapitalize typename
|
||||||
tm (fname, fieldAnn) i =
|
tm (fname, fieldAnn) i =
|
||||||
[ (Var.namespaced [typename, fname], ann, get),
|
[ (namespaced (typename :| [fname]), ann, get),
|
||||||
(Var.namespaced [typename, fname, Var.named "set"], ann, set),
|
(namespaced (typename :| [fname, Var.named "set"]), ann, set),
|
||||||
(Var.namespaced [typename, fname, Var.named "modify"], ann, modify)
|
(namespaced (typename :| [fname, Var.named "modify"]), ann, modify)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
ann = generatedAnn fieldAnn
|
ann = generatedAnn fieldAnn
|
||||||
|
@ -16,13 +16,11 @@ module Unison.Var
|
|||||||
inferTypeConstructor,
|
inferTypeConstructor,
|
||||||
inferTypeConstructorArg,
|
inferTypeConstructorArg,
|
||||||
isAction,
|
isAction,
|
||||||
joinDot,
|
|
||||||
missingResult,
|
missingResult,
|
||||||
name,
|
name,
|
||||||
nameStr,
|
nameStr,
|
||||||
named,
|
named,
|
||||||
nameds,
|
nameds,
|
||||||
namespaced,
|
|
||||||
rawName,
|
rawName,
|
||||||
reset,
|
reset,
|
||||||
uncapitalize,
|
uncapitalize,
|
||||||
@ -32,13 +30,12 @@ module Unison.Var
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Char (isLower, toLower, isAlphaNum)
|
import Data.Char (isAlphaNum, isLower, toLower)
|
||||||
import Data.Text (pack)
|
import Data.Text (pack)
|
||||||
import Data.Text qualified as Text
|
import Data.Text qualified as Text
|
||||||
import Unison.ABT qualified as ABT
|
import Unison.ABT qualified as ABT
|
||||||
import Unison.Prelude
|
import Unison.Prelude
|
||||||
import Unison.Reference qualified as Reference
|
import Unison.Reference qualified as Reference
|
||||||
import Unison.Util.Monoid (intercalateMap)
|
|
||||||
import Unison.WatchKind (WatchKind, pattern TestWatch)
|
import Unison.WatchKind (WatchKind, pattern TestWatch)
|
||||||
|
|
||||||
-- | A class for variables. Variables may have auxiliary information which
|
-- | A class for variables. Variables may have auxiliary information which
|
||||||
@ -194,21 +191,12 @@ data InferenceType
|
|||||||
reset :: (Var v) => v -> v
|
reset :: (Var v) => v -> v
|
||||||
reset v = typed (typeOf v)
|
reset v = typed (typeOf v)
|
||||||
|
|
||||||
namespaced :: (Var v) => [v] -> v
|
|
||||||
namespaced vs = named $ intercalateMap "." name vs
|
|
||||||
|
|
||||||
nameStr :: (Var v) => v -> String
|
nameStr :: (Var v) => v -> String
|
||||||
nameStr = Text.unpack . name
|
nameStr = Text.unpack . name
|
||||||
|
|
||||||
nameds :: (Var v) => String -> v
|
nameds :: (Var v) => String -> v
|
||||||
nameds s = named (Text.pack s)
|
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 :: forall v. (Var v) => v -> Bool
|
||||||
universallyQuantifyIfFree v =
|
universallyQuantifyIfFree v =
|
||||||
Text.all isLower (Text.take 1 n) && Text.all isAlphaNum n
|
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.Parser
|
||||||
Unison.Syntax.ReservedWords
|
Unison.Syntax.ReservedWords
|
||||||
Unison.Syntax.ShortHash
|
Unison.Syntax.ShortHash
|
||||||
|
Unison.Syntax.Var
|
||||||
Unison.UnisonFile.Error
|
Unison.UnisonFile.Error
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src
|
src
|
||||||
|
Loading…
Reference in New Issue
Block a user