⅄ trunk → 24-08-01-merge-api

.github/workflows/nix-dev-cache.yaml

@@ -24,6 +24,12 @@ jobs:
           - macOS-14
     steps:
     - uses: actions/checkout@v4
+    - name: mount Nix store on larger partition
+      # on the Linux runner `/` doesn't have enough space, but there's a `/mnt` which does.
+      if: runner.os == 'Linux'
+      run: |
+        sudo mkdir /nix /mnt/nix
+        sudo mount --bind /mnt/nix /nix
     - uses: cachix/install-nix-action@v27
       if: runner.os == 'Linux'
       with:
@@ -38,3 +44,5 @@ jobs:
         authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
     - name: build all packages and development shells
       run: nix -L build --accept-flake-config --no-link --keep-going '.#all'
+    - name: print disk free status
+      run: df -h

development.markdown

@@ -42,7 +42,7 @@ Some tests are executables instead:
 
 * `stack exec transcripts` runs the transcripts-related integration tests, found in `unison-src/transcripts`. You can add more tests to this directory.
 * `stack exec transcripts -- prefix-of-filename` runs only transcript tests with a matching filename prefix.
-* `stack exec integration-tests` runs the additional integration tests for cli. These tests are not triggered by `tests` or `transcripts`.
+* `stack exec cli-integration-tests` runs the additional integration tests for cli. These tests are not triggered by `tests` or `transcripts`.
 * `stack exec unison -- transcript unison-src/transcripts-round-trip/main.md` runs the pretty-printing round trip tests
 * `stack exec unison -- transcript unison-src/transcripts-manual/benchmarks.md` runs the benchmark suite. Output goes in unison-src/transcripts-manual/benchmarks/output.txt.
 
@@ -220,3 +220,7 @@ nix develop '.#cabal-unison-parser-typechecker'
 cd unison-cli
 cabal run --enable-profiling unison-cli-main:exe:unison -- +RTS -p
 ```
+
+## Native compilation
+
+See the [readme](scheme-libs/racket/unison/Readme.md).

parser-typechecker/src/Unison/PatternMatchCoverage.hs

@@ -35,6 +35,7 @@ module Unison.PatternMatchCoverage
   )
 where
 
+import Data.List.NonEmpty (nonEmpty)
 import Data.Set qualified as Set
 import Debug.Trace
 import Unison.Debug
@@ -53,34 +54,40 @@ import Unison.Util.Pretty qualified as P
 checkMatch ::
   forall vt v loc m.
   (Pmc vt v loc m) =>
-  -- | the match location
-  loc ->
   -- | scrutinee type
   Type.Type vt loc ->
   -- | match cases
   [Term.MatchCase loc (Term.Term' vt v loc)] ->
   -- | (redundant locations, inaccessible locations, inhabitants of uncovered refinement type)
   m ([loc], [loc], [Pattern ()])
-checkMatch matchLocation scrutineeType cases = do
+checkMatch scrutineeType cases = do
   ppe <- getPrettyPrintEnv
   v0 <- fresh
-  grdtree0 <- desugarMatch matchLocation scrutineeType v0 cases
-  doDebug (P.hang (title "desugared:") (prettyGrdTree (prettyPmGrd ppe) (\_ -> "<loc>") grdtree0)) (pure ())
-  (uncovered, grdtree1) <- uncoverAnnotate (Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints)) grdtree0
+  mgrdtree0 <- traverse (desugarMatch scrutineeType v0) (nonEmpty cases)
+  doDebug (P.hang (title "desugared:") (prettyGrdTreeMaybe (prettyPmGrd ppe) (\_ -> "<loc>") mgrdtree0)) (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
   doDebug
     ( P.sep
         "\n"
-        [ P.hang (title "annotated:") (prettyGrdTree (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1),
+        [ P.hang (title "annotated:") (prettyGrdTreeMaybe (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) = classify grdtree1
+  let (_accessible, inaccessible, redundant) = case grdtree1 of
+        Nothing -> ([], [], [])
+        Just x -> classify x
   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

@@ -20,19 +20,14 @@ import Unison.Type qualified as Type
 desugarMatch ::
   forall loc vt v m.
   (Pmc vt v loc m) =>
-  -- | loc of match
-  loc ->
   -- | scrutinee type
   Type vt loc ->
   -- | scrutinee variable
   v ->
   -- | match cases
-  [MatchCase loc (Term' vt v loc)] ->
+  NonEmpty (MatchCase loc (Term' vt v loc)) ->
   m (GrdTree (PmGrd vt v loc) loc)
-desugarMatch loc0 scrutineeType v0 cs0 =
-  traverse desugarClause cs0 >>= \case
-    [] -> pure $ Leaf loc0
-    x : xs -> pure $ Fork (x :| xs)
+desugarMatch scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0
   where
     desugarClause :: MatchCase loc (Term' vt v loc) -> m (GrdTree (PmGrd vt v loc) loc)
     desugarClause MatchCase {matchPattern, matchGuard} =

parser-typechecker/src/Unison/PrintError.hs

@@ -54,7 +54,7 @@ import Unison.Result qualified as Result
 import Unison.Settings qualified as Settings
 import Unison.Symbol (Symbol)
 import Unison.Syntax.HashQualified qualified as HQ (toText)
-import Unison.Syntax.Lexer qualified as L
+import Unison.Syntax.Lexer.Unison qualified as L
 import Unison.Syntax.Name qualified as Name (toText)
 import Unison.Syntax.NamePrinter (prettyHashQualified0)
 import Unison.Syntax.Parser (Annotated, ann)
@@ -1336,7 +1336,7 @@ prettyParseError s e =
     lexerOutput :: Pretty (AnnotatedText a)
     lexerOutput =
       if showLexerOutput
-        then "\nLexer output:\n" <> fromString (L.debugLex' s)
+        then "\nLexer output:\n" <> fromString (L.debugPreParse' s)
         else mempty
 
 renderParseErrors ::
@@ -1861,6 +1861,14 @@ renderParseErrors s = \case
                     <> structuralVsUniqueDocsLink
               ]
        in (msg, rangeForToken <$> [void keyword, void name])
+    go (Parser.TypeNotAllowed tok) =
+      let msg =
+            Pr.lines
+              [ Pr.wrap "I expected to see a term here, but instead it’s a type:",
+                "",
+                tokenAsErrorSite s $ HQ.toText <$> tok
+              ]
+       in (msg, [rangeForToken tok])
 
     unknownConstructor ::
       String -> L.Token (HashQualified Name) -> Pretty ColorText