Merge pull request #4310 from unisonweb/23-08-31-one-reference-type

refactor: one reference type

codebase2/codebase/unison-codebase.cabal

@@ -20,7 +20,6 @@ library
       U.Codebase.Causal
       U.Codebase.Decl
       U.Codebase.Kind
-      U.Codebase.Reference
       U.Codebase.Referent
       U.Codebase.Reflog
       U.Codebase.Term

codebase2/core/U/Codebase/Reference.hs

@@ -0,0 +1,150 @@
+module U.Codebase.Reference
+  ( Reference,
+    RReference,
+    TermReference,
+    TermRReference,
+    TermReferenceId,
+    TypeReference,
+    TypeRReference,
+    TypeReferenceId,
+    Reference' (..),
+    pattern Derived,
+    Id,
+    Id' (..),
+    Pos,
+    _ReferenceDerived,
+    _RReferenceReference,
+    t_,
+    h_,
+    idH,
+    idToHash,
+    idToShortHash,
+    isBuiltin,
+    toShortHash,
+    toId,
+    unsafeId,
+  )
+where
+
+import Control.Lens (Lens, Prism, Prism', Traversal, lens, preview, prism)
+import Data.Bifoldable (Bifoldable (..))
+import Data.Bitraversable (Bitraversable (..))
+import Data.Text qualified as Text
+import Unison.Hash (Hash)
+import Unison.Hash qualified as Hash
+import Unison.Prelude
+import Unison.ShortHash (ShortHash)
+import Unison.ShortHash qualified as SH
+
+-- | This is the canonical representation of Reference
+type Reference = Reference' Text Hash
+
+-- | A possibly-self (R = "recursive") reference.
+type RReference = Reference' Text (Maybe Hash)
+
+-- | A term reference.
+type TermReference = Reference
+
+-- | A possibly-self term reference.
+type TermRReference = RReference
+
+-- | A type declaration reference.
+type TypeReference = Reference
+
+-- | A possibly-self type declaration reference.
+type TypeRReference = RReference
+
+type Id = Id' Hash
+
+-- | A term reference id.
+type TermReferenceId = Id
+
+-- | A type declaration reference id.
+type TypeReferenceId = Id
+
+-- | Either a builtin or a user defined (hashed) top-level declaration. Used for both terms and types.
+data Reference' t h
+  = ReferenceBuiltin t
+  | ReferenceDerived (Id' h)
+  deriving stock (Eq, Generic, Ord, Show)
+
+_RReferenceReference :: Prism' (Reference' t (Maybe h)) (Reference' t h)
+_RReferenceReference = prism embed project
+  where
+    embed = \case
+      ReferenceBuiltin x -> ReferenceBuiltin x
+      ReferenceDerived (Id h p) -> ReferenceDerived (Id (Just h) p)
+
+    project = \case
+      ReferenceBuiltin x -> Right (ReferenceBuiltin x)
+      ReferenceDerived (Id mh p) -> case mh of
+        Nothing -> Left (ReferenceDerived (Id mh p))
+        Just h -> Right (ReferenceDerived (Id h p))
+
+_ReferenceDerived :: Prism (Reference' t h) (Reference' t h') (Id' h) (Id' h')
+_ReferenceDerived = prism embed project
+  where
+    embed (Id h pos) = ReferenceDerived (Id h pos)
+    project (ReferenceDerived id') = Right id'
+    project (ReferenceBuiltin t) = Left (ReferenceBuiltin t)
+
+pattern Derived :: h -> Pos -> Reference' t h
+pattern Derived h i = ReferenceDerived (Id h i)
+
+{-# COMPLETE ReferenceBuiltin, Derived #-}
+
+type Pos = Word64
+
+-- | @Pos@ is a position into a cycle, as cycles are hashed together.
+data Id' h = Id h Pos
+  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+t_ :: Traversal (Reference' t h) (Reference' t' h) t t'
+t_ f = \case
+  ReferenceBuiltin t -> ReferenceBuiltin <$> f t
+  ReferenceDerived id -> pure (ReferenceDerived id)
+
+h_ :: Traversal (Reference' t h) (Reference' t h') h h'
+h_ f = \case
+  ReferenceBuiltin t -> pure (ReferenceBuiltin t)
+  Derived h i -> Derived <$> f h <*> pure i
+
+idH :: Lens (Id' h) (Id' h') h h'
+idH = lens (\(Id h _w) -> h) (\(Id _h w) h -> Id h w)
+
+idToHash :: Id -> Hash
+idToHash (Id h _) = h
+
+idToShortHash :: Id -> ShortHash
+idToShortHash = toShortHash . ReferenceDerived
+
+isBuiltin :: Reference -> Bool
+isBuiltin (ReferenceBuiltin _) = True
+isBuiltin _ = False
+
+toId :: Reference -> Maybe Id
+toId =
+  preview _ReferenceDerived
+
+toShortHash :: Reference -> ShortHash
+toShortHash = \case
+  ReferenceBuiltin b -> SH.Builtin b
+  ReferenceDerived (Id h 0) -> SH.ShortHash (Hash.toBase32HexText h) Nothing Nothing
+  ReferenceDerived (Id h i) -> SH.ShortHash (Hash.toBase32HexText h) (Just i) Nothing
+
+unsafeId :: Reference -> Id
+unsafeId = \case
+  ReferenceBuiltin b -> error $ "Tried to get the hash of builtin " <> Text.unpack b <> "."
+  ReferenceDerived x -> x
+
+instance Bifunctor Reference' where
+  bimap f _ (ReferenceBuiltin t) = ReferenceBuiltin (f t)
+  bimap _ g (ReferenceDerived id) = ReferenceDerived (g <$> id)
+
+instance Bifoldable Reference' where
+  bifoldMap f _ (ReferenceBuiltin t) = f t
+  bifoldMap _ g (ReferenceDerived id) = foldMap g id
+
+instance Bitraversable Reference' where
+  bitraverse f _ (ReferenceBuiltin t) = ReferenceBuiltin <$> f t
+  bitraverse _ g (ReferenceDerived id) = ReferenceDerived <$> traverse g id

codebase2/core/package.yaml

@@ -10,13 +10,14 @@ library:
 dependencies:
   - base
   - containers
+  - lens
+  - recover-rtti
   - rfc5051
   - text
-  - vector
-  - recover-rtti
   - unison-hash
   - unison-prelude
   - unison-util-base32hex
+  - vector
 
 default-extensions:
   - ApplicativeDo
@@ -37,8 +38,8 @@ default-extensions:
   - MultiParamTypeClasses
   - NamedFieldPuns
   - OverloadedStrings
-  - QuantifiedConstraints
   - PatternSynonyms
+  - QuantifiedConstraints
   - RankNTypes
   - ScopedTypeVariables
   - StandaloneDeriving

codebase2/core/unison-core.cabal

@@ -17,6 +17,7 @@ source-repository head
 library
   exposed-modules:
       U.Codebase.HashTags
+      U.Codebase.Reference
       U.Core.ABT
       U.Core.ABT.Var
       Unison.Core.Project
@@ -44,8 +45,8 @@ library
       MultiParamTypeClasses
       NamedFieldPuns
       OverloadedStrings
-      QuantifiedConstraints
       PatternSynonyms
+      QuantifiedConstraints
       RankNTypes
       ScopedTypeVariables
       StandaloneDeriving
@@ -55,6 +56,7 @@ library
   build-depends:
       base
     , containers
+    , lens
     , recover-rtti
     , rfc5051
     , text

parser-typechecker/src/Unison/Runtime/ANF.hs

@@ -100,7 +100,7 @@ import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes)
 import Unison.Pattern (SeqOp (..))
 import Unison.Pattern qualified as P
 import Unison.Prelude hiding (Text)
-import Unison.Reference (Id, Reference (..))
+import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId))
 import Unison.Referent (Referent, pattern Con, pattern Ref)
 import Unison.Symbol (Symbol)
 import Unison.Term hiding (List, Ref, Text, float, fresh, resolve)

parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs

@@ -21,7 +21,7 @@ import Data.Text (Text)
 import Data.Word (Word16, Word32, Word64)
 import GHC.Stack
 import Unison.ABT.Normalized (Term (..))
-import Unison.Reference (Reference (Builtin), pattern Derived)
+import Unison.Reference (Reference, Reference' (Builtin), pattern Derived)
 import Unison.Runtime.ANF as ANF hiding (Tag)
 import Unison.Runtime.Exception
 import Unison.Runtime.Serialize

parser-typechecker/src/Unison/Runtime/MCode.hs

@@ -46,7 +46,7 @@ import Data.Primitive.PrimArray
 import Data.Word (Word16, Word64)
 import GHC.Stack (HasCallStack)
 import Unison.ABT.Normalized (pattern TAbss)
-import Unison.Reference (Reference (..))
+import Unison.Reference (Reference)
 import Unison.Referent (Referent)
 import Unison.Runtime.ANF
   ( ANormal,

parser-typechecker/src/Unison/Runtime/Machine.hs

@@ -27,7 +27,7 @@ import Unison.Builtin.Decls (exceptionRef, ioFailureRef)
 import Unison.Builtin.Decls qualified as Rf
 import Unison.ConstructorReference qualified as CR
 import Unison.Prelude hiding (Text)
-import Unison.Reference (Reference (Builtin), toShortHash)
+import Unison.Reference (Reference, Reference' (Builtin), toShortHash)
 import Unison.Referent (pattern Con, pattern Ref)
 import Unison.Runtime.ANF as ANF
   ( CompileExn (..),

parser-typechecker/src/Unison/Runtime/Pattern.hs

@@ -38,7 +38,7 @@ import Unison.ConstructorReference qualified as ConstructorReference
 import Unison.DataDeclaration (declFields)
 import Unison.Pattern
 import Unison.Pattern qualified as P
-import Unison.Reference (Reference (..))
+import Unison.Reference (Reference, Reference' (Builtin, DerivedId))
 import Unison.Runtime.ANF (internalBug)
 import Unison.Term hiding (Term, matchPattern)
 import Unison.Term qualified as Tm

parser-typechecker/src/Unison/Runtime/Serialize.hs

@@ -25,7 +25,7 @@ import Unison.ConstructorReference (ConstructorReference, GConstructorReference
 import Unison.ConstructorType qualified as CT
 import Unison.Hash (Hash)
 import Unison.Hash qualified as Hash
-import Unison.Reference (Id (..), Reference (..), pattern Derived)
+import Unison.Reference (Id' (..), Reference, Reference' (Builtin, DerivedId), pattern Derived)
 import Unison.Referent (Referent, pattern Con, pattern Ref)
 import Unison.Runtime.Exception
 import Unison.Runtime.MCode

parser-typechecker/src/Unison/Syntax/DeclPrinter.hs

@@ -18,7 +18,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv)
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
 import Unison.PrettyPrintEnvDecl qualified as PPED
-import Unison.Reference (Reference (DerivedId))
+import Unison.Reference (Reference, Reference' (DerivedId))
 import Unison.Referent qualified as Referent
 import Unison.Result qualified as Result
 import Unison.Syntax.HashQualified qualified as HQ (toString, toVar, unsafeFromString)
@@ -76,7 +76,7 @@ prettyGADT env ctorType r name dd =
     constructor (n, (_, _, t)) =
       prettyPattern (PPED.unsuffixifiedPPE env) ctorType name (ConstructorReference r n)
         <> fmt S.TypeAscriptionColon " :"
-        `P.hang` TypePrinter.prettySyntax (PPED.suffixifiedPPE env) t
+          `P.hang` TypePrinter.prettySyntax (PPED.suffixifiedPPE env) t
     header = prettyEffectHeader name (DD.EffectDeclaration dd) <> fmt S.ControlKeyword " where"
 
 prettyPattern ::
@@ -130,7 +130,7 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
       P.group $
         styleHashQualified'' (fmt (S.TypeReference r)) fname
           <> fmt S.TypeAscriptionColon " :"
-          `P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ)
+            `P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ)
     header = prettyDataHeader name dd <> fmt S.DelimiterChar (" = " `P.orElse` "\n  = ")
 
 -- Comes up with field names for a data declaration which has the form of a

parser-typechecker/tests/Unison/Test/ANF.hs

@@ -13,7 +13,7 @@ import Unison.ABT qualified as ABT
 import Unison.ABT.Normalized (Term (TAbs))
 import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.Pattern qualified as P
-import Unison.Reference (Reference (Builtin))
+import Unison.Reference (Reference, Reference' (Builtin))
 import Unison.Runtime.ANF as ANF
 import Unison.Runtime.MCode (RefNums (..), emitCombs)
 import Unison.Term qualified as Term

parser-typechecker/tests/Unison/Test/MCode.hs

@@ -8,7 +8,7 @@ module Unison.Test.MCode where
 import Control.Concurrent.STM
 import Data.Map.Strict qualified as Map
 import EasyTest
-import Unison.Reference (Reference (Builtin))
+import Unison.Reference (Reference, Reference' (Builtin))
 import Unison.Runtime.ANF
   ( SuperGroup (..),
     lamLift,

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -151,7 +151,7 @@ import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty)
 import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.PrettyPrintEnvDecl.Names qualified as PPED
 import Unison.Project (ProjectBranchNameOrLatestRelease (..))
-import Unison.Reference (Reference (..), TermReference)
+import Unison.Reference (Reference, TermReference)
 import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent