Merge remote-tracking branch 'origin/trunk' into topic/calling-conven…

…tions

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

@@ -72,18 +72,18 @@ import Unison.Var qualified as Var
 
 type SyntaxText = S.SyntaxText' Reference
 
-pretty :: (Var v) => PrettyPrintEnv -> Term v a -> Pretty ColorText
+pretty :: (HasCallStack, Var v) => PrettyPrintEnv -> Term v a -> Pretty ColorText
 pretty ppe tm =
   PP.syntaxToColor . runPretty (avoidShadowing tm ppe) $ pretty0 emptyAc $ printAnnotate ppe tm
 
 prettyBlock :: (Var v) => Bool -> PrettyPrintEnv -> Term v a -> Pretty ColorText
 prettyBlock elideUnit ppe = PP.syntaxToColor . prettyBlock' elideUnit ppe
 
-prettyBlock' :: (Var v) => Bool -> PrettyPrintEnv -> Term v a -> Pretty SyntaxText
+prettyBlock' :: (HasCallStack, Var v) => Bool -> PrettyPrintEnv -> Term v a -> Pretty SyntaxText
 prettyBlock' elideUnit ppe tm =
   runPretty (avoidShadowing tm ppe) . pretty0 (emptyBlockAc {elideUnit = elideUnit}) $ printAnnotate ppe tm
 
-pretty' :: (Var v) => Maybe Width -> PrettyPrintEnv -> Term v a -> ColorText
+pretty' :: (HasCallStack, Var v) => Maybe Width -> PrettyPrintEnv -> Term v a -> ColorText
 pretty' (Just width) n t =
   PP.render width . PP.syntaxToColor . runPretty (avoidShadowing t n) $ pretty0 emptyAc (printAnnotate n t)
 pretty' Nothing n t =
@@ -819,8 +819,8 @@ groupCases ::
   [MatchCase' () (Term3 v ann)] ->
   [([Pattern ()], [v], [(Maybe (Term3 v ann), ([v], Term3 v ann))])]
 groupCases = \cases
-    [] -> []
-    ms@((p1, _, AbsN' vs1 _) : _) -> go (p1, vs1) [] ms
+  [] -> []
+  ms@((p1, _, AbsN' vs1 _) : _) -> go (p1, vs1) [] ms
   where
     go (p0, vs0) acc [] = [(p0, vs0, reverse acc)]
     go (p0, vs0) acc ms@((p1, g1, AbsN' vs body) : tl)
@@ -973,7 +973,7 @@ prettyBinding' ppe width v t =
   PP.render width . PP.syntaxToColor $ prettyBinding ppe v t
 
 prettyBinding0 ::
-  (MonadPretty v m) =>
+  (HasCallStack, MonadPretty v m) =>
   AmbientContext ->
   HQ.HashQualified Name ->
   Term2 v at ap v a ->
@@ -1314,7 +1314,7 @@ instance Semigroup PrintAnnotation where
 instance Monoid PrintAnnotation where
   mempty = PrintAnnotation {usages = Map.empty}
 
-suffixCounterTerm :: (Var v) => PrettyPrintEnv -> Set Name -> Set Name -> Term2 v at ap v a -> PrintAnnotation
+suffixCounterTerm :: (HasCallStack, Var v) => PrettyPrintEnv -> Set Name -> Set Name -> Term2 v at ap v a -> PrintAnnotation
 suffixCounterTerm n usedTm usedTy = \case
   Ref' r -> countHQ usedTm $ PrettyPrintEnv.termName n (Referent.Ref r)
   Constructor' r | noImportRefs (r ^. ConstructorReference.reference_) -> mempty
@@ -1326,14 +1326,14 @@ suffixCounterTerm n usedTm usedTy = \case
      in foldMap (countPatternUsages n usedTm . pat) bs
   _ -> mempty
 
-suffixCounterType :: (Var v) => PrettyPrintEnv -> Set Name -> Type v a -> PrintAnnotation
+suffixCounterType :: (HasCallStack, Var v) => PrettyPrintEnv -> Set Name -> Type v a -> PrintAnnotation
 suffixCounterType n used = \case
   Type.Var' v -> countHQ used $ HQ.unsafeFromVar v
   Type.Ref' r | noImportRefs r || r == Type.listRef -> mempty
   Type.Ref' r -> countHQ used $ PrettyPrintEnv.typeName n r
   _ -> mempty
 
-printAnnotate :: (Var v, Ord v) => PrettyPrintEnv -> Term2 v at ap v a -> Term3 v PrintAnnotation
+printAnnotate :: (HasCallStack, Var v, Ord v) => PrettyPrintEnv -> Term2 v at ap v a -> Term3 v PrintAnnotation
 printAnnotate n tm =
   fmap snd (go (reannotateUp (suffixCounterTerm n usedTermNames usedTypeNames) tm))
   where
@@ -1350,7 +1350,7 @@ printAnnotate n tm =
 countTypeUsages :: (Var v, Ord v) => PrettyPrintEnv -> Set Name -> Type v a -> PrintAnnotation
 countTypeUsages n usedTy t = snd $ annotation $ reannotateUp (suffixCounterType n usedTy) t
 
-countPatternUsages :: PrettyPrintEnv -> Set Name -> Pattern loc -> PrintAnnotation
+countPatternUsages :: (HasCallStack) => PrettyPrintEnv -> Set Name -> Pattern loc -> PrintAnnotation
 countPatternUsages n usedTm = Pattern.foldMap' f
   where
     f = \case
@@ -1372,22 +1372,23 @@ countPatternUsages n usedTm = Pattern.foldMap' f
           then mempty
           else countHQ usedTm $ PrettyPrintEnv.patternName n r
 
-countHQ :: Set Name -> HQ.HashQualified Name -> PrintAnnotation
+countHQ :: (HasCallStack) => Set Name -> HQ.HashQualified Name -> PrintAnnotation
 countHQ used (HQ.NameOnly n)
   -- Names that are marked 'used' aren't considered for `use` clause insertion
   -- So if a variable 'foo' is used, then we won't insert a `use` clause for
   -- the reference `Qux.quaffle.foo`.
   | Just n' <- Set.lookupLE n used, Name.endsWith n n' = mempty
-countHQ _ hq = foldMap countName (HQ.toName hq)
-
-countName :: Name -> PrintAnnotation
-countName n =
-  PrintAnnotation
-    { usages =
-        Map.fromList do
-          (p, s) <- Name.splits n
-          pure (Name.toText s, Map.singleton (map NameSegment.toEscapedText p) 1)
-    }
+countHQ _ hq =
+  HQ.toName hq & foldMap \n ->
+    if Name.isRelative n
+      then
+        PrintAnnotation
+          { usages =
+              Map.fromList do
+                (p, s) <- Name.splits n
+                pure (Name.toText s, Map.singleton (map NameSegment.toEscapedText p) 1)
+          }
+      else mempty
 
 joinName :: Prefix -> Suffix -> Name
 joinName p s = Name.unsafeParseText $ dotConcat $ p ++ [s]

scripts/make-release.sh

@@ -52,16 +52,16 @@ echo "Kicking off release workflow in unisonweb/unison"
 git fetch origin trunk
 git tag "${tag}" "${src}"
 git push origin "${tag}"
-gh workflow run release --repo unisonweb/unison \
+gh workflow run release.yaml --repo unisonweb/unison \
   --ref "${tag}" \
   --field "version=${version}"
 
 echo "Kicking off Homebrew update task"
-gh workflow run release --repo unisonweb/homebrew-unison --field "version=${version}"
+gh workflow run release.yaml --repo unisonweb/homebrew-unison --field "version=${version}"
 
 echo "Opening relevant workflows in browser"
-gh workflow view release --web --repo unisonweb/homebrew-unison || true
-gh workflow view release --web --repo unisonweb/unison || true
+gh workflow view release.yaml --web --repo unisonweb/homebrew-unison || true
+gh workflow view release.yaml --web --repo unisonweb/unison || true
 
 echo "Okay! All the work has been kicked off, it may take several hours to complete."
 echo "Run '$0 --status' to see job status."

unison-core/src/Unison/Name.hs

@@ -453,11 +453,14 @@ sortNames toText =
 -- /Precondition/: the name is relative.
 splits :: (HasCallStack) => Name -> [([NameSegment], Name)]
 splits (Name p ss0) =
-  ss0
-    & List.NonEmpty.toList
-    & reverse
-    & splits0
-    & over (mapped . _2) (Name p . List.NonEmpty.reverse)
+  case p of
+    Absolute -> error (reportBug "E243149" ("Name.splits called with an absolute name: " ++ show ss0))
+    Relative ->
+      ss0
+        & List.NonEmpty.toList
+        & reverse
+        & splits0
+        & over (mapped . _2) (Name p . List.NonEmpty.reverse)
   where
     -- splits a.b.c
     -- ([], a.b.c) : over (mapped . _1) (a.) (splits b.c)

unison-runtime/src/Unison/Runtime/Builtin.hs

@@ -38,6 +38,7 @@ import Unison.Runtime.Builtin.Types
 import Unison.Runtime.Foreign.Function.Type (ForeignFunc (..), foreignFuncBuiltinName)
 import Unison.Runtime.Stack (UnboxedTypeTag (..), Val (..), unboxedTypeTagToInt)
 import Unison.Runtime.Stack qualified as Closure
+import Unison.Runtime.TypeTags qualified as TT
 import Unison.Symbol
 import Unison.Type qualified as Ty
 import Unison.Util.EnumContainers as EC
@@ -1081,7 +1082,7 @@ declareForeign sand arity func = declareForeignWrap sand wrap func
        | otherwise = argNDirect arity
 
 unitValue :: Val
-unitValue = BoxedVal $ Closure.Enum Ty.unitRef (PackedTag 0)
+unitValue = BoxedVal $ Closure.Enum Ty.unitRef TT.unitTag
 
 natValue :: Word64 -> Val
 natValue w = NatVal w

unison-runtime/src/Unison/Runtime/Foreign/Function.hs

@@ -146,7 +146,7 @@ import Unison.Runtime.Foreign qualified as F
 import Unison.Runtime.Foreign.Function.Type (ForeignFunc (..))
 import Unison.Runtime.MCode
 import Unison.Runtime.Stack
-import Unison.Runtime.TypeTags
+import Unison.Runtime.TypeTags qualified as TT
 import Unison.Symbol
 import Unison.Type
   ( anyRef,
@@ -1363,25 +1363,25 @@ instance
     ForeignConvention b
   ) => ForeignConvention (Either a b) where
   decodeVal (BoxedVal (Data1 _ t v))
-    | t == leftTag = Left <$> decodeVal v
+    | t == TT.leftTag = Left <$> decodeVal v
     | otherwise = Right <$> decodeVal v
   decodeVal v = foreignConventionError "Either" v
 
   encodeVal (Left x) =
-    BoxedVal . Data1 Ty.eitherRef leftTag $ encodeVal x
+    BoxedVal . Data1 Ty.eitherRef TT.leftTag $ encodeVal x
   encodeVal (Right y) =
-    BoxedVal . Data1 Ty.eitherRef rightTag $ encodeVal y
+    BoxedVal . Data1 Ty.eitherRef TT.rightTag $ encodeVal y
 
   readAtIndex stk i = bpeekOff stk i >>= \case
     Data1 _ t v
-      | t == leftTag -> Left <$> decodeVal v
+      | t == TT.leftTag -> Left <$> decodeVal v
       | otherwise -> Right <$> decodeVal v
     c -> foreignConventionError "Either" (BoxedVal c)
 
   writeBack stk (Left x) =
-    bpoke stk . Data1 Ty.eitherRef leftTag $ encodeVal x
+    bpoke stk . Data1 Ty.eitherRef TT.leftTag $ encodeVal x
   writeBack stk (Right y) =
-    bpoke stk . Data1 Ty.eitherRef rightTag $ encodeVal y
+    bpoke stk . Data1 Ty.eitherRef TT.rightTag $ encodeVal y
 
 instance ForeignConvention a => ForeignConvention (Maybe a) where
   decodeVal (BoxedVal (Enum _ _)) = pure Nothing
@@ -1400,13 +1400,13 @@ instance ForeignConvention a => ForeignConvention (Maybe a) where
   writeBack stk (Just v) = bpoke stk (someClo (encodeVal v))
 
 noneClo :: Closure
-noneClo = Enum Ty.optionalRef noneTag
+noneClo = Enum Ty.optionalRef TT.noneTag
 
 noneVal :: Val
 noneVal = BoxedVal noneClo
 
 someClo :: Val -> Closure
-someClo v = Data1 Ty.optionalRef someTag v
+someClo v = Data1 Ty.optionalRef TT.someTag v
 
 someVal :: Val -> Val
 someVal v = BoxedVal (someClo v)
@@ -1463,7 +1463,7 @@ instance ForeignConvention Char where
   writeBack = pokeC
 
 unitClo :: Closure
-unitClo = Enum Ty.unitRef unitTag
+unitClo = Enum Ty.unitRef TT.unitTag
 
 unitVal :: Val
 unitVal = BoxedVal unitClo
@@ -1481,7 +1481,7 @@ instance ForeignConvention () where
 pattern ConsC :: Val -> Val -> Closure
 pattern ConsC x y <- Data2 _ _ x y
   where
-    ConsC x y = Data2 Ty.pairRef pairTag x y
+    ConsC x y = Data2 Ty.pairRef TT.pairTag x y
 
 pattern ConsV x y = BoxedVal (ConsC x y)
 
@@ -1623,7 +1623,7 @@ decodeFailure (DataG _ _ (_, args)) =
 decodeFailure c = foreignConventionError "Failure" (BoxedVal c)
 
 encodeFailure :: ForeignConvention a => F.Failure a -> Closure
-encodeFailure (F.Failure r msg v) = DataG Ty.failureRef failureTag payload
+encodeFailure (F.Failure r msg v) = DataG Ty.failureRef TT.failureTag payload
   where
     payload = boxedSeg [encodeTypeLink r, encodeText msg, encodeAny v]
 
@@ -1637,7 +1637,7 @@ encodeTypeLink :: Reference -> Closure
 encodeTypeLink rf = Foreign (Wrap typeLinkRef rf)
 
 encodeAny :: ForeignConvention a => a -> Closure
-encodeAny v = Data1 anyRef anyTag (encodeVal v)
+encodeAny v = Data1 anyRef TT.anyTag (encodeVal v)
 
 decodeAny :: ForeignConvention a => Closure -> IO a
 decodeAny (Data1 _ _ v) = decodeVal v
@@ -1748,24 +1748,24 @@ instance ForeignConvention POSIXTime where
 
 decodeBufferMode :: Closure -> IO BufferMode
 decodeBufferMode (Enum _ t)
-  | t == noBufTag = pure NoBuffering
-  | t == lineBufTag = pure LineBuffering
-  | t == blockBufTag = pure $ BlockBuffering Nothing
+  | t == TT.noBufTag = pure NoBuffering
+  | t == TT.lineBufTag = pure LineBuffering
+  | t == TT.blockBufTag = pure $ BlockBuffering Nothing
 decodeBufferMode (Data1 _ t (NatVal i))
-  | t == sizedBlockBufTag = pure . BlockBuffering $ Just (fromIntegral i)
+  | t == TT.sizedBlockBufTag = pure . BlockBuffering $ Just (fromIntegral i)
 decodeBufferMode c = foreignConventionError "BufferMode" (BoxedVal c)
 
 encodeBufferMode :: BufferMode -> Closure
 encodeBufferMode NoBuffering = no'buf
 encodeBufferMode LineBuffering = line'buf
 encodeBufferMode (BlockBuffering Nothing) = block'buf
 encodeBufferMode (BlockBuffering (Just n)) =
-  Data1 Ty.bufferModeRef sizedBlockBufTag . NatVal $ fromIntegral n
+  Data1 Ty.bufferModeRef TT.sizedBlockBufTag . NatVal $ fromIntegral n
 
 no'buf, line'buf, block'buf :: Closure
-no'buf = Enum Ty.bufferModeRef noBufTag
-line'buf = Enum Ty.bufferModeRef lineBufTag
-block'buf = Enum Ty.bufferModeRef blockBufTag
+no'buf = Enum Ty.bufferModeRef TT.noBufTag
+line'buf = Enum Ty.bufferModeRef TT.lineBufTag
+block'buf = Enum Ty.bufferModeRef TT.blockBufTag
 
 instance ForeignConvention BufferMode where
   decodeVal (BoxedVal c) = decodeBufferMode c
@@ -1778,10 +1778,10 @@ instance ForeignConvention BufferMode where
 
 decodeIOMode :: Closure -> IO IOMode
 decodeIOMode (Enum _ t)
-  | t == readModeTag = pure ReadMode
-  | t == writeModeTag = pure WriteMode
-  | t == appendModeTag = pure AppendMode
-  | t == readWriteModeTag = pure ReadWriteMode
+  | t == TT.readModeTag = pure ReadMode
+  | t == TT.writeModeTag = pure WriteMode
+  | t == TT.appendModeTag = pure AppendMode
+  | t == TT.readWriteModeTag = pure ReadWriteMode
 decodeIOMode c = foreignConventionError "IOMode" (BoxedVal c)
 
 encodeIOMode :: IOMode -> Closure
@@ -1791,10 +1791,10 @@ encodeIOMode AppendMode = append'mode
 encodeIOMode ReadWriteMode = read'write'mode
 
 read'mode, write'mode, append'mode, read'write'mode :: Closure
-read'mode = Enum Ty.bufferModeRef readModeTag
-write'mode = Enum Ty.bufferModeRef writeModeTag
-append'mode = Enum Ty.bufferModeRef appendModeTag
-read'write'mode = Enum Ty.bufferModeRef readWriteModeTag
+read'mode = Enum Ty.bufferModeRef TT.readModeTag
+write'mode = Enum Ty.bufferModeRef TT.writeModeTag
+append'mode = Enum Ty.bufferModeRef TT.appendModeTag
+read'write'mode = Enum Ty.bufferModeRef TT.readWriteModeTag
 
 instance ForeignConvention IOMode where
   decodeVal (BoxedVal c) = decodeIOMode c
@@ -1807,9 +1807,9 @@ instance ForeignConvention IOMode where
 
 decodeSeekMode :: Closure -> IO SeekMode
 decodeSeekMode (Enum _ t)
-  | t == seekAbsoluteTag = pure AbsoluteSeek
-  | t == seekRelativeTag = pure RelativeSeek
-  | t == seekEndTag = pure SeekFromEnd
+  | t == TT.seekAbsoluteTag = pure AbsoluteSeek
+  | t == TT.seekRelativeTag = pure RelativeSeek
+  | t == TT.seekEndTag = pure SeekFromEnd
 decodeSeekMode v = foreignConventionError "SeekMode" (BoxedVal v)
 
 encodeSeekMode :: SeekMode -> Closure
@@ -1818,9 +1818,9 @@ encodeSeekMode RelativeSeek = relative'seek
 encodeSeekMode SeekFromEnd = seek'from'end
 
 absolute'seek, relative'seek, seek'from'end :: Closure
-absolute'seek = Enum Ty.seekModeRef seekAbsoluteTag
-relative'seek = Enum Ty.seekModeRef seekRelativeTag
-seek'from'end = Enum Ty.seekModeRef seekEndTag
+absolute'seek = Enum Ty.seekModeRef TT.seekAbsoluteTag
+relative'seek = Enum Ty.seekModeRef TT.seekRelativeTag
+seek'from'end = Enum Ty.seekModeRef TT.seekEndTag
 
 instance ForeignConvention SeekMode where
   decodeVal (BoxedVal c) = decodeSeekMode c
@@ -1835,9 +1835,9 @@ data StdHnd = StdIn | StdOut | StdErr
 
 decodeStdHnd :: Closure -> IO StdHnd
 decodeStdHnd (Enum _ t)
-  | t == stdInTag = pure StdIn
-  | t == stdOutTag = pure StdOut
-  | t == stdErrTag = pure StdErr
+  | t == TT.stdInTag = pure StdIn
+  | t == TT.stdOutTag = pure StdOut
+  | t == TT.stdErrTag = pure StdErr
 decodeStdHnd c = foreignConventionError "StdHandle" (BoxedVal c)
 
 encodeStdHnd :: StdHnd -> Closure
@@ -1846,9 +1846,9 @@ encodeStdHnd StdOut = std'out
 encodeStdHnd StdErr = std'err
 
 std'in, std'out, std'err :: Closure
-std'in = Enum Ty.stdHandleRef stdInTag
-std'out = Enum Ty.stdHandleRef stdOutTag
-std'err = Enum Ty.stdHandleRef stdErrTag
+std'in = Enum Ty.stdHandleRef TT.stdInTag
+std'out = Enum Ty.stdHandleRef TT.stdOutTag
+std'err = Enum Ty.stdHandleRef TT.stdErrTag
 
 instance ForeignConvention StdHnd where
   decodeVal (BoxedVal c) = decodeStdHnd c