[WIP] Records prototype

codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs

@@ -84,6 +84,7 @@ v2ToH2Type' mkReference = ABT.transform convertF
       V2.Type.Effects a -> H2.TypeEffects a
       V2.Type.Forall a -> H2.TypeForall a
       V2.Type.IntroOuter a -> H2.TypeIntroOuter a
+      V2.Type.Record fields -> H2.TypeRecord fields
 
 convertKind :: V2.Kind -> H2.Kind
 convertKind = \case
@@ -179,6 +180,7 @@ v2ToH2Term = ABT.transform convertF
       V2.Term.Char c -> H2.TermChar c
       V2.Term.Ref r -> H2.TermRef (v2ToH2Reference r)
       V2.Term.Constructor r cid -> H2.TermConstructor (v2ToH2Reference r) cid
+      V2.Term.Record fields -> H2.TermRecord fields
       V2.Term.Request r cid -> H2.TermRequest (v2ToH2Reference r) cid
       V2.Term.Handle a b -> H2.TermHandle a b
       V2.Term.App a b -> H2.TermApp a b
@@ -209,6 +211,7 @@ v2ToH2Term = ABT.transform convertF
       V2.Term.PText t -> H2.PatternText () t
       V2.Term.PChar c -> H2.PatternChar () c
       V2.Term.PConstructor r cid ps -> H2.PatternConstructor () (v2ToH2Reference r) cid (convertPattern <$> ps)
+      V2.Term.PRecord fieldPats -> H2.PatternRecord () (convertPattern <$> fieldPats)
       V2.Term.PAs pat -> H2.PatternAs () (convertPattern pat)
       V2.Term.PEffectPure pat -> H2.PatternEffectPure () (convertPattern pat)
       V2.Term.PEffectBind r conId pats pat -> H2.PatternEffectBind () (v2ToH2Reference r) conId (convertPattern <$> pats) (convertPattern pat)

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -2738,6 +2738,7 @@ c2sDecl saveText saveDefn (C.Decl.DataDeclaration dt m b cts) = do
       C.Type.Effects es -> pure $ C.Type.Effects es
       C.Type.Forall a -> pure $ C.Type.Forall a
       C.Type.IntroOuter a -> pure $ C.Type.IntroOuter a
+      C.Type.Record fields -> pure $ C.Type.Record fields
     done :: (S.Decl.Decl Symbol, (Seq Text, Seq Hash)) -> m (LocalIds' t d, S.Decl.Decl Symbol)
     done (decl, (localTextValues, localDefnValues)) = do
       textIds <- traverse saveText localTextValues
@@ -2771,6 +2772,7 @@ c2xTerm saveText saveDefn tm tp =
         C.Term.Constructor
           <$> bitraverse lookupText lookupDefn typeRef
           <*> pure cid
+      C.Term.Record fields -> pure $ C.Term.Record fields
       C.Term.Request typeRef cid ->
         C.Term.Request <$> bitraverse lookupText lookupDefn typeRef <*> pure cid
       C.Term.Handle a a2 -> pure $ C.Term.Handle a a2
@@ -2806,6 +2808,7 @@ c2xTerm saveText saveDefn tm tp =
       C.Type.Effects es -> pure $ C.Type.Effects es
       C.Type.Forall a -> pure $ C.Type.Forall a
       C.Type.IntroOuter a -> pure $ C.Type.IntroOuter a
+      C.Type.Record fields -> pure $ C.Type.Record fields
     goCase ::
       forall m w s a.
       ( MonadState s m,
@@ -2841,6 +2844,7 @@ c2xTerm saveText saveDefn tm tp =
       C.Term.PText t -> C.Term.PText <$> lookupText t
       C.Term.PChar c -> pure $ C.Term.PChar c
       C.Term.PConstructor r i ps -> C.Term.PConstructor <$> bitraverse lookupText lookupDefn r <*> pure i <*> traverse goPat ps
+      C.Term.PRecord fields -> C.Term.PRecord <$> traverse goPat fields
       C.Term.PAs p -> C.Term.PAs <$> goPat p
       C.Term.PEffectPure p -> C.Term.PEffectPure <$> goPat p
       C.Term.PEffectBind r i bindings k -> C.Term.PEffectBind <$> bitraverse lookupText lookupDefn r <*> pure i <*> traverse goPat bindings <*> goPat k

codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs

@@ -58,6 +58,7 @@ import Data.Bytes.Put (MonadPut, putByteString, putWord8)
 import Data.Bytes.Serial (SerialEndian (serializeBE), deserialize, deserializeBE, serialize)
 import Data.Bytes.VarInt (VarInt (VarInt), unVarInt)
 import Data.List (elemIndex)
+import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Vector (Vector)
 import U.Codebase.Decl (Modifier)
@@ -280,6 +281,8 @@ putSingleTerm t = putABT putSymbol putUnit putF t
         putWord8 20 *> putReferent' putRecursiveReference putReference r
       Term.TypeLink r ->
         putWord8 21 *> putReference r
+      Term.Record fields ->
+        putWord8 22 *> putFoldable (\(name, val) -> putText name *> putChild val) (Map.toList fields)
     putMatchCase :: (MonadPut m) => (a -> m ()) -> Term.MatchCase LocalTextId TermFormat.TypeRef a -> m ()
     putMatchCase putChild (Term.MatchCase pat guard body) =
       putPattern pat *> putMaybe putChild guard *> putChild body
@@ -313,6 +316,10 @@ putSingleTerm t = putABT putSymbol putUnit putF t
           *> putPattern r
       Term.PText t -> putWord8 12 *> putVarInt t
       Term.PChar c -> putWord8 13 *> putChar c
+      Term.PRecord fields ->
+        putWord8 14
+          *> putFoldable (\(name, pat) -> putText name *> putPattern pat) (Map.toList fields)
+
     putSeqOp :: (MonadPut m) => Term.SeqOp -> m ()
     putSeqOp Term.PCons = putWord8 0
     putSeqOp Term.PSnoc = putWord8 1
@@ -364,6 +371,11 @@ getSingleTerm = getABT getSymbol getUnit getF
         19 -> Term.Char <$> getChar
         20 -> Term.TermLink <$> getReferent
         21 -> Term.TypeLink <$> getReference
+        22 ->
+          getList
+            ( (,) <$> getText <*> getChild
+            )
+            <&> Term.Record . Map.fromList
         tag -> unknownTag "getSingleTerm" tag
       where
         getReferent :: (MonadGet m) => m (Referent' TermFormat.TermRef TermFormat.TypeRef)
@@ -398,6 +410,7 @@ getSingleTerm = getABT getSymbol getUnit getF
                 <*> getPattern
             12 -> Term.PText <$> getVarInt
             13 -> Term.PChar <$> getChar
+            14 -> Term.PRecord . Map.fromList <$> (getList ((,) <$> getText <*> getPattern))
             x -> unknownTag "Pattern" x
           where
             getSeqOp :: (MonadGet m) => m Term.SeqOp
@@ -444,6 +457,7 @@ getType getReference = getABT getSymbol getUnit go
         5 -> Type.Effects <$> getList getChild
         6 -> Type.Forall <$> getChild
         7 -> Type.IntroOuter <$> getChild
+        8 -> Type.Record . Map.fromList <$> getList (getPair getText getChild)
         tag -> unknownTag "getType" tag
     getKind :: (MonadGet m) => m Kind
     getKind =
@@ -1120,6 +1134,7 @@ putType putReference putVar = putABT putVar putUnit go
       Type.Effects es -> putWord8 5 *> putFoldable putChild es
       Type.Forall body -> putWord8 6 *> putChild body
       Type.IntroOuter body -> putWord8 7 *> putChild body
+      Type.Record fields -> putWord8 8 *> putFoldable (\(l, t) -> putText l *> putChild t) (Map.toAscList fields)
     putKind :: (MonadPut m) => Kind -> m ()
     putKind k = case k of
       Kind.Star -> putWord8 0

codebase2/codebase/U/Codebase/Decl.hs

@@ -145,3 +145,4 @@ unhashComponent componentHash refToVar m =
             Type.Effects as -> ABT.tm () $ Type.Effects as
             Type.Forall a -> ABT.tm () $ Type.Forall a
             Type.IntroOuter a -> ABT.tm () $ Type.IntroOuter a
+            Type.Record fields -> ABT.tm () $ Type.Record fields

codebase2/codebase/U/Codebase/Term.hs

@@ -64,6 +64,7 @@ data F' text termRef typeRef termLink typeLink vt a
   | -- First argument identifies the data type,
     -- second argument identifies the constructor
     Constructor typeRef ConstructorId
+  | Record (Map Text {- field name -} a {- field value -})
   | Request typeRef ConstructorId
   | Handle a a
   | App a a
@@ -107,6 +108,7 @@ data Pattern t r
   | PText !t
   | PChar !Char
   | PConstructor !r !ConstructorId [Pattern t r]
+  | PRecord (Map Text (Pattern t r))
   | PAs (Pattern t r)
   | PEffectPure (Pattern t r)
   | PEffectBind !r !ConstructorId [Pattern t r] (Pattern t r)
@@ -187,6 +189,7 @@ extraMapM ftext ftermRef ftypeRef ftermLink ftypeLink fvt = go'
       Char c -> pure $ Char c
       Ref r -> Ref <$> ftermRef r
       Constructor r cid -> Constructor <$> (ftypeRef r) <*> pure cid
+      Record fields -> pure $ Record fields
       Request r cid -> Request <$> ftypeRef r <*> pure cid
       Handle e h -> pure $ Handle e h
       App f a -> pure $ App f a
@@ -221,6 +224,7 @@ rmapPatternM ft fr = go
       PText t -> PText <$> ft t
       PChar c -> pure $ PChar c
       PConstructor r i ps -> PConstructor <$> fr r <*> pure i <*> (traverse go ps)
+      PRecord fields -> PRecord <$> (traverse go fields)
       PAs p -> PAs <$> go p
       PEffectPure p -> PEffectPure <$> go p
       PEffectBind r i ps p -> PEffectBind <$> fr r <*> pure i <*> traverse go ps <*> go p
@@ -329,6 +333,7 @@ unhashComponent componentHash refToVar m =
             Text t -> ABT.tm () $ Text t
             Char c -> ABT.tm () $ Char c
             Constructor typeRef conId -> ABT.tm () $ Constructor typeRef conId
+            Record fields -> ABT.tm () $ Record fields
             Request typeRef conId -> ABT.tm () $ Request typeRef conId
             Handle e h -> ABT.tm () $ Handle e h
             App f a -> ABT.tm () $ App f a

codebase2/codebase/U/Codebase/Type.hs

@@ -27,6 +27,7 @@ data F' r a
   | IntroOuter a -- binder like ∀, used to introduce variables that are
   -- bound by outer type signatures, to support scoped type
   -- variables
+  | Record (Map Text a)
   deriving (Foldable, Functor, Eq, Ord, Show, Traversable)
 
 -- | Non-recursive type

lib/unison-pretty-printer/src/Unison/Util/ColorText.hs

@@ -201,3 +201,5 @@ defaultColors = \case
   ST.Parenthesis -> Nothing
   ST.DocDelimiter -> Just Green
   ST.DocKeyword -> Just HiCyan
+  ST.RecordFieldName {} -> Just HiCyan
+  ST.RecordFieldValueColon -> Just HiPurple

lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs

@@ -51,6 +51,8 @@ data Element r
   | DocDelimiter
   | -- the 'source' in @source{…}, etc
     DocKeyword
+  | RecordFieldName Text
+  | RecordFieldValueColon
   deriving (Eq, Ord, Show, Functor)
 
 syntax :: Element r -> SyntaxText' r -> SyntaxText' r

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs

@@ -102,6 +102,7 @@ term1to2 h =
       V1.Term.Char c -> V2.Term.Char c
       V1.Term.Ref r -> V2.Term.Ref (rreference1to2 h r)
       V1.Term.Constructor (V1.ConstructorReference r i) -> V2.Term.Constructor (reference1to2 r) (fromIntegral i)
+      V1.Term.Record fields -> V2.Term.Record fields
       V1.Term.Request (V1.ConstructorReference r i) -> V2.Term.Request (reference1to2 r) (fromIntegral i)
       V1.Term.Handle b h -> V2.Term.Handle b h
       V1.Term.App f a -> V2.Term.App f a
@@ -133,6 +134,8 @@ term1to2 h =
       V1.Pattern.Char _ c -> V2.Term.PChar c
       V1.Pattern.Constructor _ (V1.ConstructorReference r i) ps ->
         V2.Term.PConstructor (reference1to2 r) i (goPat <$> ps)
+      V1.Pattern.Record _loc fields ->
+        V2.Term.PRecord (goPat <$> fields)
       V1.Pattern.As _ p -> V2.Term.PAs (goPat p)
       V1.Pattern.EffectPure _ p -> V2.Term.PEffectPure (goPat p)
       V1.Pattern.EffectBind _ (V1.ConstructorReference r i) ps k ->
@@ -165,6 +168,7 @@ term2to1 h lookupCT =
           V2.Term.Ref r -> pure $ V1.Term.Ref (rreference2to1 h r)
           V2.Term.Constructor r i ->
             pure (V1.Term.Constructor (V1.ConstructorReference (reference2to1 r) (fromIntegral i)))
+          V2.Term.Record fields -> pure $ V1.Term.Record fields
           V2.Term.Request r i ->
             pure (V1.Term.Request (V1.ConstructorReference (reference2to1 r) (fromIntegral i)))
           V2.Term.Handle a a4 -> pure $ V1.Term.Handle a a4
@@ -194,6 +198,8 @@ term2to1 h lookupCT =
           V2.Term.PChar c -> pure $ V1.Pattern.Char a c
           V2.Term.PConstructor r i ps ->
             V1.Pattern.Constructor a (V1.ConstructorReference (reference2to1 r) i) <$> traverse goPat ps
+          V2.Term.PRecord fields ->
+            V1.Pattern.Record a <$> traverse goPat fields
           V2.Term.PAs p -> V1.Pattern.As a <$> goPat p
           V2.Term.PEffectPure p -> V1.Pattern.EffectPure a <$> goPat p
           V2.Term.PEffectBind r i ps p ->
@@ -357,6 +363,7 @@ type2to1' convertRef =
       V2.Type.Effects as -> V1.Type.Effects as
       V2.Type.Forall a -> V1.Type.Forall a
       V2.Type.IntroOuter a -> V1.Type.IntroOuter a
+      V2.Type.Record fields -> V1.Type.Record fields
       where
         convertKind = \case
           V2.Kind.Star -> V1.Kind.Star
@@ -384,6 +391,7 @@ type1to2' convertRef =
       V1.Type.Effects as -> V2.Type.Effects as
       V1.Type.Forall a -> V2.Type.Forall a
       V1.Type.IntroOuter a -> V2.Type.IntroOuter a
+      V1.Type.Record fields -> V2.Type.Record fields
       where
         convertKind = \case
           V1.Kind.Star -> V2.Kind.Star

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2.hs

@@ -776,6 +776,7 @@ patternReferences_ f = \case
     (\newRef newPatterns -> Pattern.Constructor loc newRef newPatterns)
       <$> (ref & someRefCon_ %%~ f)
       <*> (patterns & traversed . patternReferences_ %%~ f)
+  Pattern.Record {} -> error "Impossible: encountered unexpected record patterns in old code"
   (Pattern.As loc pat) -> Pattern.As loc <$> patternReferences_ f pat
   (Pattern.EffectPure loc pat) -> Pattern.EffectPure loc <$> patternReferences_ f pat
   (Pattern.EffectBind loc ref patterns pat) ->

parser-typechecker/src/Unison/Hashing/V2/Convert.hs

@@ -119,6 +119,7 @@ m2hTerm = ABT.transformM \case
   Memory.Term.Blank b -> pure (Hashing.TermBlank b)
   Memory.Term.Ref r -> pure (Hashing.TermRef (m2hReference r))
   Memory.Term.Constructor (Memory.ConstructorReference.ConstructorReference r i) -> pure (Hashing.TermConstructor (m2hReference r) i)
+  Memory.Term.Record fields -> pure (Hashing.TermRecord fields)
   Memory.Term.Request (Memory.ConstructorReference.ConstructorReference r i) -> pure (Hashing.TermRequest (m2hReference r) i)
   Memory.Term.Handle x y -> pure (Hashing.TermHandle x y)
   Memory.Term.App f x -> pure (Hashing.TermApp f x)
@@ -149,6 +150,7 @@ m2hPattern = \case
   Memory.Pattern.Char loc c -> Hashing.PatternChar loc c
   Memory.Pattern.Constructor loc (Memory.ConstructorReference.ConstructorReference r i) ps ->
     Hashing.PatternConstructor loc (m2hReference r) i (fmap m2hPattern ps)
+  Memory.Pattern.Record loc fields -> Hashing.PatternRecord loc (m2hPattern <$> fields)
   Memory.Pattern.As loc p -> Hashing.PatternAs loc (m2hPattern p)
   Memory.Pattern.EffectPure loc p -> Hashing.PatternEffectPure loc (m2hPattern p)
   Memory.Pattern.EffectBind loc (Memory.ConstructorReference.ConstructorReference r i) ps k ->
@@ -181,6 +183,7 @@ h2mTerm getCT = ABT.transform \case
   Hashing.TermRef r -> Memory.Term.Ref (h2mReference r)
   Hashing.TermConstructor r i -> Memory.Term.Constructor (Memory.ConstructorReference.ConstructorReference (h2mReference r) i)
   Hashing.TermRequest r i -> Memory.Term.Request (Memory.ConstructorReference.ConstructorReference (h2mReference r) i)
+  Hashing.TermRecord fields -> Memory.Term.Record fields
   Hashing.TermHandle x y -> Memory.Term.Handle x y
   Hashing.TermApp f x -> Memory.Term.App f x
   Hashing.TermAnn e t -> Memory.Term.Ann e (h2mType t)
@@ -210,6 +213,7 @@ h2mPattern = \case
   Hashing.PatternChar loc c -> Memory.Pattern.Char loc c
   Hashing.PatternConstructor loc r i ps ->
     Memory.Pattern.Constructor loc (Memory.ConstructorReference.ConstructorReference (h2mReference r) i) (h2mPattern <$> ps)
+  Hashing.PatternRecord loc fields -> Memory.Pattern.Record loc (h2mPattern <$> fields)
   Hashing.PatternAs loc p -> Memory.Pattern.As loc (h2mPattern p)
   Hashing.PatternEffectPure loc p -> Memory.Pattern.EffectPure loc (h2mPattern p)
   Hashing.PatternEffectBind loc r i ps k ->
@@ -278,6 +282,7 @@ m2hType = ABT.transform \case
   Memory.Type.Effects a1s -> Hashing.TypeEffects a1s
   Memory.Type.Forall a1 -> Hashing.TypeForall a1
   Memory.Type.IntroOuter a1 -> Hashing.TypeIntroOuter a1
+  Memory.Type.Record a1 -> Hashing.TypeRecord a1
 
 m2hKind :: Memory.Kind.Kind -> Hashing.Kind
 m2hKind = \case
@@ -316,6 +321,7 @@ h2mType = ABT.transform \case
   Hashing.TypeEffects a1s -> Memory.Type.Effects a1s
   Hashing.TypeForall a1 -> Memory.Type.Forall a1
   Hashing.TypeIntroOuter a1 -> Memory.Type.IntroOuter a1
+  Hashing.TypeRecord a1 -> Memory.Type.Record a1
 
 h2mKind :: Hashing.Kind -> Memory.Kind.Kind
 h2mKind = \case

parser-typechecker/src/Unison/KindInference/Constraint/Context.hs

@@ -3,6 +3,7 @@ module Unison.KindInference.Constraint.Context
   )
 where
 
+import Data.Text (Text)
 import Unison.KindInference.UVar (UVar)
 import Unison.Type (Type)
 
@@ -19,4 +20,6 @@ data ConstraintContext v loc
   | DeclDefinition
   | Builtin
   | ContextLookup
+  | Record
+  | RecordField Text
   deriving stock (Show, Eq, Ord)

parser-typechecker/src/Unison/KindInference/Generate.hs

@@ -10,6 +10,7 @@ where
 
 import Control.Monad.Except
 import Data.Foldable (foldlM)
+import Data.Map qualified as Map
 import Data.Set qualified as Set
 import U.Core.ABT qualified as ABT
 import Unison.Builtin.Decls (rewriteTypeRef)
@@ -111,6 +112,12 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do
           effKind <- freshVar eff
           effConstraints <- typeConstraintTree effKind eff
           pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints
+      Type.Record fields -> do
+        ParentConstraint (IsType resultVar (Provenance Record annotation)) . Node <$> for (Map.toList fields) \(fieldName, fieldType) -> do
+          fieldKind <- freshVar fieldType
+          fieldConstraints <- typeConstraintTree fieldKind fieldType
+          let fieldAnn = ABT.annotation fieldType
+          pure $ ParentConstraint (IsType fieldKind (Provenance (RecordField fieldName) fieldAnn)) fieldConstraints
 
 handleIntroOuter :: (Var v) => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r
 handleIntroOuter v loc k = do

parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs

@@ -69,6 +69,7 @@ desugarPattern typ v0 pat k vs = case pat of
         tpatvars = zipWith (\(v, p) t -> (v, p, t)) patvars contyps
     rest <- foldr (\(v, pat, t) b -> desugarPattern t v pat b) k tpatvars vs
     pure (Grd c rest)
+  Record _loc _fields -> error "desugarPattern: Record patterns not implemented"
   As _ rest -> desugarPattern typ v0 rest k (v0 : vs)
   EffectPure _ resume -> do
     v <- fresh