From 9799b4f479fbdd43054f941fd548174278d2b528 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 1 Feb 2024 13:48:51 -0500 Subject: [PATCH] fix and move Var.namespaced --- .../src/Unison/DataDeclaration/Dependencies.hs | 3 ++- .../src/Unison/Syntax/DeclParser.hs | 8 +++++--- .../src/Unison/Syntax/DeclPrinter.hs | 12 +++++------- .../src/Unison/Syntax/FileParser.hs | 6 ++++-- unison-core/src/Unison/DataDeclaration.hs | 11 +++++++---- unison-core/src/Unison/Var.hs | 14 +------------- unison-syntax/src/Unison/Syntax/Var.hs | 15 +++++++++++++++ unison-syntax/unison-syntax.cabal | 1 + 8 files changed, 40 insertions(+), 30 deletions(-) create mode 100644 unison-syntax/src/Unison/Syntax/Var.hs diff --git a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs index 4eb6c6700..ae1864a79 100644 --- a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs +++ b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs @@ -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 diff --git a/parser-typechecker/src/Unison/Syntax/DeclParser.hs b/parser-typechecker/src/Unison/Syntax/DeclParser.hs index 0408211a5..dfe3acb46 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclParser.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclParser.hs @@ -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 diff --git a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs index 8ed391b44..e7be294f2 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs @@ -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 diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 58b44d18a..19fbbe25a 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -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 diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index bfeb0b1d8..88c9afd85 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -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 diff --git a/unison-core/src/Unison/Var.hs b/unison-core/src/Unison/Var.hs index e5c45090d..a78b6638e 100644 --- a/unison-core/src/Unison/Var.hs +++ b/unison-core/src/Unison/Var.hs @@ -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 diff --git a/unison-syntax/src/Unison/Syntax/Var.hs b/unison-syntax/src/Unison/Syntax/Var.hs new file mode 100644 index 000000000..9fbc934d2 --- /dev/null +++ b/unison-syntax/src/Unison/Syntax/Var.hs @@ -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)) diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 48f5d0dd2..1060586e5 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -28,6 +28,7 @@ library Unison.Syntax.Parser Unison.Syntax.ReservedWords Unison.Syntax.ShortHash + Unison.Syntax.Var Unison.UnisonFile.Error hs-source-dirs: src