Merged trunk branch and resolved conflicts.

.github/workflows/bundle-ucm.yaml

@@ -246,7 +246,7 @@ jobs:
           file: ucm.cmd
           content: |
             @echo off
-            SET UCM_WEB_UI="%~dp0ui"
+            SET UCM_WEB_UI=%~dp0ui
             "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" %*
       - name: package everything together
         run: |

CONTRIBUTORS.markdown

@@ -87,4 +87,5 @@ The format for this list: name, GitHub handle
 * Dan Doel (@dolio)
 * Eric Torreborre (@etorreborre)
 * Eduard Nicodei (@neduard)
+* Brian McKenna (@puffnfresh)
 * Ruslan Simchuk (@SimaDovakin)

CREDITS.md

@@ -52,7 +52,6 @@ These are listed in alphabetical order.
 | [comonad-5.0.6](https://hackage.haskell.org/package/comonad-5.0.6) | [BSD3](https://hackage.haskell.org/package/comonad-5.0.6/src/LICENSE) |
 | [concurrent-supply-0.1.8](https://hackage.haskell.org/package/concurrent-supply-0.1.8) | [BSD3](https://hackage.haskell.org/package/concurrent-supply-0.1.8/src/LICENSE) |
 | [conduit-1.3.2](https://hackage.haskell.org/package/conduit-1.3.2) | [MIT](https://hackage.haskell.org/package/conduit-1.3.2/src/LICENSE) |
-| [configurator-0.3.0.0](https://hackage.haskell.org/package/configurator-0.3.0.0) | [BSD3](https://hackage.haskell.org/package/configurator-0.3.0.0/src/LICENSE) |
 | [containers-0.6.2.1](https://hackage.haskell.org/package/containers-0.6.2.1) | [BSD3](https://hackage.haskell.org/package/containers-0.6.2.1/src/LICENSE) |
 | [contravariant-1.5.2](https://hackage.haskell.org/package/contravariant-1.5.2) | [BSD3](https://hackage.haskell.org/package/contravariant-1.5.2/src/LICENSE) |
 | [cryptohash-md5-0.11.100.1](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1) | [BSD3](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1/src/LICENSE) |

contrib/cabal.project

@@ -36,11 +36,6 @@ packages:
   unison-syntax
   yaks/easytest
 
-source-repository-package
-  type: git
-  location: https://github.com/unisonweb/configurator.git
-  tag: e47e9e9fe1f576f8c835183b9def52d73c01327a
-
 source-repository-package
   type: git
   location: https://github.com/unisonweb/haskeline.git

dev-ui-install.sh

@@ -1,3 +1,6 @@
+#!/usr/bin/env sh
+set -eu
+
 echo "This script downloads the latest Unison Local UI release"
 echo "and puts it in the correct spot next to the unison"
 echo "executable built by stack."
@@ -7,4 +10,4 @@ stack build
 curl -L https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip --output unisonLocal.zip
 parent_dir="$(dirname -- $(stack exec which unison))"
 mkdir -p "$parent_dir/ui"
-unzip -o unisonLocal.zip -d "$parent_dir/ui"
+unzip -q -o unisonLocal.zip -d "$parent_dir/ui"

nix/unison-project.nix

@@ -25,7 +25,6 @@ in
       }
     ];
     branchMap = {
-      "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison";
       "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand";
     };
   }

parser-typechecker/package.yaml

@@ -37,7 +37,6 @@ dependencies:
   - cereal
   - clock
   - concurrent-output
-  - configurator
   - containers >= 0.6.3
   - cryptonite
   - data-default

parser-typechecker/src/Unison/PatternMatchCoverage.hs

@@ -35,7 +35,6 @@ module Unison.PatternMatchCoverage
   )
 where
 
-import Data.List.NonEmpty (nonEmpty)
 import Data.Set qualified as Set
 import Debug.Trace
 import Unison.Debug
@@ -63,31 +62,24 @@ checkMatch ::
 checkMatch scrutineeType cases = do
   ppe <- getPrettyPrintEnv
   v0 <- fresh
-  mgrdtree0 <- traverse (desugarMatch scrutineeType v0) (nonEmpty cases)
-  doDebug (P.hang (title "desugared:") (prettyGrdTreeMaybe (prettyPmGrd ppe) (\_ -> "<loc>") mgrdtree0)) (pure ())
+  grdtree0 <- desugarMatch scrutineeType v0 cases
+  doDebug (P.hang (title "desugared:") (prettyGrdTree (prettyPmGrd ppe) (\_ -> "<loc>") grdtree0)) (pure ())
   let initialUncovered = Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints)
-  (uncovered, grdtree1) <- case mgrdtree0 of
-    Nothing -> pure (initialUncovered, Nothing)
-    Just grdtree0 -> fmap Just <$> uncoverAnnotate initialUncovered grdtree0
+  (uncovered, grdtree1) <- uncoverAnnotate initialUncovered grdtree0
   doDebug
     ( P.sep
         "\n"
-        [ P.hang (title "annotated:") (prettyGrdTreeMaybe (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1),
+        [ P.hang (title "annotated:") (prettyGrdTree (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1),
           P.hang (title "uncovered:") (NC.prettyDnf ppe uncovered)
         ]
     )
     (pure ())
   uncoveredExpanded <- concat . fmap Set.toList <$> traverse (expandSolution v0) (Set.toList uncovered)
   doDebug (P.hang (title "uncovered expanded:") (NC.prettyDnf ppe (Set.fromList uncoveredExpanded))) (pure ())
   let sols = map (generateInhabitants v0) uncoveredExpanded
-  let (_accessible, inaccessible, redundant) = case grdtree1 of
-        Nothing -> ([], [], [])
-        Just x -> classify x
+  let (_accessible, inaccessible, redundant) = classify grdtree1
   pure (redundant, inaccessible, sols)
   where
-    prettyGrdTreeMaybe prettyNode prettyLeaf = \case
-      Nothing -> "<empty>"
-      Just x -> prettyGrdTree prettyNode prettyLeaf x
     title = P.bold
     doDebug out = case shouldDebug PatternCoverage of
       True -> trace (P.toAnsiUnbroken out)

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

@@ -3,7 +3,6 @@ module Unison.PatternMatchCoverage.Desugar
   )
 where
 
-import Data.List.NonEmpty (NonEmpty (..))
 import U.Core.ABT qualified as ABT
 import Unison.Pattern
 import Unison.Pattern qualified as Pattern
@@ -25,7 +24,7 @@ desugarMatch ::
   -- | scrutinee variable
   v ->
   -- | match cases
-  NonEmpty (MatchCase loc (Term' vt v loc)) ->
+  [MatchCase loc (Term' vt v loc)] ->
   m (GrdTree (PmGrd vt v loc) loc)
 desugarMatch scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0
   where

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

@@ -10,8 +10,6 @@ module Unison.PatternMatchCoverage.GrdTree
   )
 where
 
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.List.NonEmpty qualified as NEL
 import Data.ListLike (ListLike)
 import Unison.PatternMatchCoverage.Fix
 import Unison.Prelude
@@ -55,7 +53,7 @@ data GrdTreeF n l a
   | -- | A constraint of some kind (structural pattern match, boolan guard, etc)
     GrdF n a
   | -- | A list of alternative matches, tried in order
-    ForkF (NonEmpty a)
+    ForkF [a]
   deriving stock (Functor, Show)
 
 prettyGrdTree :: forall n l s. (ListLike s Char, IsString s) => (n -> Pretty s) -> (l -> Pretty s) -> GrdTree n l -> Pretty s
@@ -64,7 +62,7 @@ prettyGrdTree prettyNode prettyLeaf = cata phi
     phi = \case
       LeafF l -> prettyLeaf l
       GrdF n rest -> sep " " [prettyNode n, "──", rest]
-      ForkF xs -> "──" <> group (sep "\n" (makeTree $ NEL.toList xs))
+      ForkF xs -> "──" <> group (sep "\n" $ makeTree xs)
     makeTree :: [Pretty s] -> [Pretty s]
     makeTree = \case
       [] -> []
@@ -82,7 +80,7 @@ pattern Leaf x = Fix (LeafF x)
 pattern Grd :: n -> GrdTree n l -> GrdTree n l
 pattern Grd x rest = Fix (GrdF x rest)
 
-pattern Fork :: NonEmpty (GrdTree n l) -> GrdTree n l
+pattern Fork :: [GrdTree n l] -> GrdTree n l
 pattern Fork alts = Fix (ForkF alts)
 
 {-# COMPLETE Leaf, Grd, Fork #-}

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

@@ -16,7 +16,6 @@ import Data.Foldable
 import Data.Function
 import Data.Functor
 import Data.Functor.Compose
-import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map qualified as Map
 import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
@@ -74,12 +73,11 @@ uncoverAnnotate z grdtree0 = cata phi grdtree0 z
       LeafF l -> \nc -> do
         nc' <- ensureInhabited' nc
         pure (Set.empty, Leaf (nc', l))
-      ForkF (kinit :| ks) -> \nc0 -> do
+      ForkF ks -> \nc0 -> do
         -- depth-first fold in match-case order to acculate the
         -- constraints for a match failure at every case.
-        (nc1, t1) <- kinit nc0
-        (ncfinal, ts) <- foldlM (\(nc, ts) a -> a nc >>= \(nc', t) -> pure (nc', t : ts)) (nc1, []) ks
-        pure (ncfinal, Fork (t1 :| reverse ts))
+        (ncfinal, ts) <- foldlM (\(nc, ts) a -> a nc >>= \(nc', t) -> pure (nc', t : ts)) (nc0, []) ks
+        pure (ncfinal, Fork $ reverse ts)
       GrdF grd k -> \nc0 -> case grd of
         PmEffect var con convars -> handleGrd (PosEffect var (Effect con) convars) (NegEffect var (Effect con)) k nc0
         PmEffectPure var resume -> handleGrd (PosEffect var NoEffect [resume]) (NegEffect var NoEffect) k nc0

parser-typechecker/src/Unison/PrintError.hs

@@ -59,6 +59,7 @@ import Unison.Syntax.Name qualified as Name (toText)
 import Unison.Syntax.NamePrinter (prettyHashQualified0)
 import Unison.Syntax.Parser (Annotated, ann)
 import Unison.Syntax.Parser qualified as Parser
+import Unison.Syntax.Precedence qualified as Precedence
 import Unison.Syntax.TermPrinter qualified as TermPrinter
 import Unison.Term qualified as Term
 import Unison.Type (Type)
@@ -1132,7 +1133,7 @@ renderTerm env e =
         else fromString s
 
 renderPattern :: Env -> Pattern ann -> ColorText
-renderPattern env e = Pr.renderUnbroken . Pr.syntaxToColor . fst $ TermPrinter.prettyPattern env TermPrinter.emptyAc 0 ([] :: [Symbol]) e
+renderPattern env e = Pr.renderUnbroken . Pr.syntaxToColor . fst $ TermPrinter.prettyPattern env TermPrinter.emptyAc Precedence.Annotation ([] :: [Symbol]) e
 
 -- | renders a type with no special styling
 renderType' :: (IsString s, Var v) => Env -> Type v loc -> s
@@ -1786,21 +1787,6 @@ renderParseErrors s = \case
                 tokenAsErrorSite s tok
               ]
        in (msg, [rangeForToken tok])
-    go (Parser.EmptyMatch tok) =
-      let msg =
-            Pr.indentN 2 . Pr.callout "😶" $
-              Pr.lines
-                [ Pr.wrap
-                    ( "I expected some patterns after a "
-                        <> style ErrorSite "match"
-                        <> "/"
-                        <> style ErrorSite "with"
-                        <> " or cases but I didn't find any."
-                    ),
-                  "",
-                  tokenAsErrorSite s tok
-                ]
-       in (msg, [rangeForToken tok])
     go (Parser.EmptyWatch tok) =
       let msg =
             Pr.lines

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

@@ -0,0 +1,71 @@
+module Unison.Syntax.Precedence where
+
+import Data.Map qualified as Map
+import Unison.Prelude
+
+-- Precedence rules for infix operators.
+-- Lower number means higher precedence (tighter binding).
+-- Operators not in this list have no precedence and will simply be parsed
+-- left-to-right.
+infixRules :: Map Text Precedence
+infixRules =
+  Map.fromList do
+    (ops, prec) <- zip infixLevels (map (InfixOp . Level) [0 ..])
+    map (,prec) ops
+
+-- | Indicates this is the RHS of a top-level definition.
+isTopLevelPrecedence :: Precedence -> Bool
+isTopLevelPrecedence i = i == Basement
+
+increment :: Precedence -> Precedence
+increment = \case
+  Basement -> Bottom
+  Bottom -> Annotation
+  Annotation -> Statement
+  Statement -> Control
+  Control -> InfixOp Lowest
+  InfixOp Lowest -> InfixOp (Level 0)
+  InfixOp (Level n) -> InfixOp (Level (n + 1))
+  InfixOp Highest -> Application
+  Application -> Prefix
+  Prefix -> Top
+  Top -> Top
+
+data Precedence
+  = -- | The lowest precedence, used for top-level bindings
+    Basement
+  | -- | Used for terms that never need parentheses
+    Bottom
+  | -- | Type annotations
+    Annotation
+  | -- | A statement in a block
+    Statement
+  | -- | Control flow constructs like `if`, `match`, `case`
+    Control
+  | -- | Infix operators
+    InfixOp InfixPrecedence
+  | -- | Function application
+    Application
+  | -- | Prefix operators like `'`, `!`
+    Prefix
+  | -- | The highest precedence, used for let bindings and blocks
+    Top
+  deriving (Eq, Ord, Show)
+
+data InfixPrecedence = Lowest | Level Int | Highest
+  deriving (Eq, Ord, Show)
+
+infixLevels :: [[Text]]
+infixLevels =
+  [ ["||", "|"],
+    ["&&", "&"],
+    ["==", "!==", "!=", "==="],
+    ["<", ">", ">=", "<="],
+    ["+", "-"],
+    ["*", "/", "%"],
+    ["^", "^^", "**"]
+  ]
+
+-- | Returns the precedence of an infix operator, if it has one.
+operatorPrecedence :: Text -> Maybe Precedence
+operatorPrecedence op = Map.lookup op infixRules