Merge branch 'main' into nitin/viewport

.github/workflows/haskell-ci-windows.yml

@@ -0,0 +1,68 @@
+name: Haskell-CI-Windows
+on:
+  push:
+    paths:
+      - '**.hs'
+      - '**.sw'
+      - '**.cabal'
+      - '*.yaml'
+      - 'data/**.yaml'
+      - '.github/workflows/haskell-ci-windows.yml'
+    branches:
+      - "main"
+  # reuse the same filter for pull-requests
+  pull_request:
+    paths:
+      - '**.hs'
+      - '**.sw'
+      - '**.cabal'
+      - 'stack.yaml'
+      - '*.yaml'
+      - 'data/**.yaml'
+      - '.github/workflows/haskell-ci-windows.yml'
+    branches:
+      - "main"
+jobs:
+  windows:
+    name: Haskell-CI - ${{ matrix.os }} - ghc-${{ matrix.ghc }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [windows-latest]
+        cabal: ["3.10.1.0"]
+        ghc: ["9.8.2"]
+    timeout-minutes:
+      60
+
+    steps:
+      - uses: actions/checkout@v4
+        if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/main'
+
+      - uses: haskell-actions/setup@v2
+        id: setup-haskell-cabal
+        name: Setup Haskell
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: ${{ matrix.cabal }}
+
+      - name: Configure
+        run: cabal configure --enable-tests --enable-benchmarks --test-show-details=direct
+
+      - name: Freeze
+        run: cabal freeze
+
+      - uses: actions/cache@v4
+        name: Cache ~/.cabal/store
+        with:
+          path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+
+      - name: Install dependencies
+        run: cabal build all --only-dependencies
+
+      - name: Build
+        run: cabal build all
+
+      - name: Test
+        run: cabal test all
+

LICENSE

@@ -1,4 +1,4 @@
-Copyright Brent Yorgey 2021-2022
+Copyright Brent Yorgey and other contributors 2021-2024
 SPDX-License-Identifier: BSD-3-Clause
 
 All rights reserved.
@@ -14,7 +14,7 @@ modification, are permitted provided that the following conditions are met:
       disclaimer in the documentation and/or other materials provided
       with the distribution.
 
-    * Neither the name of Swarm team nor the names of other
+    * Neither the name of Brent Yorgey nor the names of other
       contributors may be used to endorse or promote products derived
       from this software without specific prior written permission.
 

src/swarm-lang/Swarm/Language/Typecheck.hs

@@ -127,6 +127,19 @@ type Sourced a = (Source, a)
 
 -- | A "join" where an expected thing meets an actual thing.
 newtype Join a = Join (Source -> a)
+  deriving (Functor)
+
+instance Foldable Join where
+  foldMap :: Monoid m => (a -> m) -> Join a -> m
+  foldMap f j = f a1 <> f a2
+   where
+    (a1, a2) = getJoin j
+
+instance Traversable Join where
+  traverse :: Applicative f => (a -> f b) -> Join a -> f (Join b)
+  traverse f j = joined <$> f a1 <*> f a2
+   where
+    (a1, a2) = getJoin j
 
 instance (Show a) => Show (Join a) where
   show (getJoin -> (e, a)) = "(expected: " <> show e <> ", actual: " <> show a <> ")"
@@ -313,7 +326,9 @@ unify ::
 unify ms j = do
   res <- expected =:= actual
   case res of
-    Left _ -> throwTypeErr NoLoc $ Mismatch ms j
+    Left _ -> do
+      j' <- traverse U.applyBindings j
+      throwTypeErr NoLoc $ Mismatch ms j'
     Right ty -> return ty
  where
   (expected, actual) = getJoin j

test/integration/Main.hs

@@ -79,7 +79,7 @@ import Swarm.TUI.Model.UI (UIState)
 import Swarm.Util (findAllWithExt)
 import Swarm.Util.RingBuffer qualified as RB
 import Swarm.Util.Yaml (decodeFileEitherE)
-import System.FilePath.Posix (splitDirectories)
+import System.FilePath (splitDirectories)
 import System.Timeout (timeout)
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)

test/unit/TestLanguagePipeline.hs

@@ -482,7 +482,7 @@ testLanguagePipeline =
             "applying a pair"
             ( process
                 "(1,2) \"hi\""
-                "1:1: Type mismatch:\n  From context, expected `(1, 2)` to be a function,\n  but it is actually a pair"
+                "1:1: Type mismatch:\n  From context, expected `(1, 2)` to be a function,\n  but it actually has type `Int * Int`"
             )
         , testCase
             "providing a pair as an argument"
@@ -520,6 +520,12 @@ testLanguagePipeline =
                 "1 + (\\x. \\y. 3)"
                 "1:5: Type mismatch:\n  From context, expected `\\x. \\y. 3` to have type `Int`,\n  but it is actually a function\n"
             )
+        , testCase
+            "apply HOF to int - #1888"
+            ( process
+                "(\\f. f 3) 2"
+                "1:11: Type mismatch:\n  From context, expected `2` to have a type like `Int -> _`"
+            )
         ]
     , testGroup
         "generalize top-level binds #351 #1501"
@@ -644,7 +650,7 @@ testLanguagePipeline =
             "def at non-cmd type"
             ( process
                 "def x = 3 end; x + 2"
-                "1:16: Type mismatch:\n  From context, expected `x + 2` to have a type like"
+                "1:16: Type mismatch:\n  From context, expected `x + 2` to be a command"
             )
         , testCase
             "def at cmd type"