Merge branch 'dev' into eq_gen_language_server

Author: TimWhiting

Diff for: .github/workflows/bundle.yaml

@@ -0,0 +1,86 @@
+on:
+  workflow_dispatch:   # so we can run the workflow manually as well
+  push:
+    tags:
+      - 'v*'
+
+permissions:
+  contents: write
+
+env:
+  VCPKG_BINARY_SOURCES: "clear;x-gha,readwrite"
+
+name: bundle
+jobs:
+  build:
+    name: Bundle Koka
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        # macOS 13 is x64, later versions are arm64
+        # we build on the oldest ubuntu version for better binary compatibility.
+        os: [windows-latest, macOS-latest, macOS-13, ubuntu-20.04, ubuntu-22.04-arm]
+
+    steps:
+      # Checkout
+      - name: Checkout repository
+        uses: actions/checkout@v4
+        with:
+          submodules: true
+
+      # Cache setup for vcpkg (https://learn.microsoft.com/en-us/vcpkg/consume/binary-caching-github-actions-cache)
+      - name: Setup vcpkg cache
+        uses: actions/github-script@v7
+        with:
+          script: |
+            core.exportVariable('ACTIONS_CACHE_URL', process.env.ACTIONS_CACHE_URL || '');
+            core.exportVariable('ACTIONS_RUNTIME_TOKEN', process.env.ACTIONS_RUNTIME_TOKEN || '');
+
+      # Use a VS shell on Windows (so `cl` is on the PATH): https://github.com/egor-tensin/vs-shell (MIT license)
+      - name: Set up Visual Studio shell
+        uses: egor-tensin/vs-shell@v2
+        if: runner.os == 'Windows' && runner.arch == 'X64'
+        with:
+          arch: x64
+
+      # Set up stack and cache dependencies: https://github.com/freckle/stack-action (MIT license)
+      - name: Build compiler
+        uses: freckle/stack-action@v5
+        with:
+          test: false
+          stack-build-arguments: ""
+          cache-save-always: true
+
+      # Bundle
+      - name: Build libraries
+        if: runner.os == 'Windows'
+        run: |
+          $env:VCPKG_ROOT=$env:VCPKG_INSTALLATION_ROOT
+          stack exec koka -- -e -O2 util/bundle
+
+      - name: Build libraries
+        if: runner.os != 'Windows'
+        run: |
+          stack exec koka -- -e -O2 util/bundle
+
+      # VS code extension
+      - name: Package VS code extension
+        if: runner.os == 'Windows' && runner.arch == 'X64'
+        working-directory: support/vscode/koka.language-koka
+        run: |
+          npm install
+          npm run build
+
+      # Create a release: https://github.com/softprops/action-gh-release (MIT license)
+      - name: Release
+        uses: softprops/action-gh-release@v2
+        if: startsWith(github.ref, 'refs/tags/')  # only release if tagged with a version
+        with:
+          files: |
+            bundle/**/*.tar.gz
+            support/vscode/koka.language-koka/*.vsix
+            util/install.bat
+            util/install.sh
+          draft: true
+          body_path: util/release.md
+

Diff for: .gitignore

@@ -5,6 +5,7 @@
 .vs/
 .vscode/
 support/vscode/koka.language-koka/whatsnew.md
+support/vscode/koka.language-koka/dist
 src/Syntax/Lexer.hs.gen
 node_modules/
 out/

Diff for: kklib/include/kklib/platform.h

@@ -147,12 +147,12 @@
 #define WIN32  1
 #endif
 
-#if defined(__amd64__) || defined(__amd64) || defined(__x86_64__) || defined(__x86_64) || defined(_M_X64) || defined(_M_AMD64)
+#if defined(__aarch64__) || defined(_M_ARM64) || defined(_M_HYBRID_X86_ARM64) || defined(_M_ARM64EC) // must come first as we consider ARM64EC as ARM64
+  #define KK_ARCH_ARM64     1
+#elif defined(__amd64__) || defined(__amd64) || defined(__x86_64__) || defined(__x86_64) || defined(_M_X64) || defined(_M_AMD64)
   #define KK_ARCH_X64       1
 #elif defined(__i386__) || defined(__i386) || defined(_M_IX86) || defined(_X86_) || defined(__X86__)
   #define KK_ARCH_X86       1
-#elif defined(__aarch64__) || defined(_M_ARM64) || defined(_M_HYBRID_X86_ARM64) || defined(_M_ARM64EC)
-  #define KK_ARCH_ARM64     1
 #elif defined(__arm__) || defined(_ARM) || defined(_M_ARM)  || defined(_M_ARMT) || defined(__arm)
   #define KK_ARCH_ARM32     1
 #elif defined(__riscv) || defined(_M_RISCV)

Diff for: kklib/src/bytes.c

@@ -152,8 +152,16 @@ kk_ssize_t kk_decl_pure kk_bytes_count_pattern_borrow(kk_bytes_t b, kk_bytes_t p
 kk_bytes_t kk_bytes_cat(kk_bytes_t b1, kk_bytes_t b2, kk_context_t* ctx) {
   kk_ssize_t len1;
   const uint8_t* s1 = kk_bytes_buf_borrow(b1, &len1, ctx);
+  if(len1 == 0) {
+    kk_bytes_drop(b1, ctx);
+    return b2;
+  }
   kk_ssize_t len2;
   const uint8_t* s2 = kk_bytes_buf_borrow(b2, &len2, ctx);
+  if(len2 == 0) {
+    kk_bytes_drop(b2, ctx);
+    return b1;
+  }
   uint8_t* p;
   kk_bytes_t t = kk_bytes_alloc_buf(len1 + len2, &p, ctx );
   kk_memcpy(p, s1, len1);

Diff for: kklib/src/os.c

@@ -246,15 +246,36 @@ kk_decl_export int kk_os_write_text_file(kk_string_t path, kk_string_t content,
 
 kk_decl_export int kk_os_read_line(kk_string_t* result, kk_context_t* ctx)
 {
+  kk_string_t line = kk_string_empty();
   char buf[1024];
-  if (fgets(buf, 1023, stdin) == NULL) return errno;
-  buf[1023] = 0;      // ensure zero termination
-  const size_t len = strlen(buf);
-  if (len > 0 && buf[len-1] == '\n') {
-    buf[len-1] = 0;   // remove possible ending newline character
+  bool newline_found = false;
+
+  // read until '\n', EOF, or error
+  while (!newline_found && fgets(buf, sizeof buf, stdin) != NULL) {
+    kk_ssize_t len = kk_sstrlen(buf); // assumes no embedded '\0' characters
+
+    // check if we have a reached a newline character
+    if (len > 0 && buf[len-1] == '\n') {
+      newline_found = true;
+      buf[--len] = '\0';  // remove newline
+    }
+
+    // append buf to line
+    kk_string_t buf_str = kk_string_alloc_from_qutf8n(len, buf, ctx);
+    line = kk_string_cat(line, buf_str, ctx);
+  }
+
+  // success if we reach '\n', or EOF with a non-empty line
+  // this mimics the behaviour of `fgets`
+  if(newline_found || (feof(stdin) && !kk_string_is_empty_borrow(line, ctx))) {
+    *result = line;
+    return 0;
+  }
+  else {
+    // error or EOF with an empty line
+    kk_string_drop(line, ctx);
+    return ferror(stdin) ? errno : EOF;
   }
-  *result = kk_string_alloc_from_qutf8(buf, ctx);
-  return 0;
 }
 
 

Diff for: lib/std/core/delayed.kk

@@ -17,28 +17,43 @@ import std/core/unsafe
 // Delayed values
 // ----------------------------------------------------------------------------
 
+reference type computation<e, a>
+  con XComputation( action : () -> e a )
+  con XDone( value : a )
+  con XBlocking
+
 // Delayed (or _lazy_) values are computed (with effect `:e`) only the first time
 // `force` is called and cached afterwards.
 abstract value type delayed<e,a>
-  con XDelay( dref : ref<global,either<() -> e a,a>> )
+  con XDelay( dref : ref<global,computation<e,a>> )
 
 // Create a new `:delayed` value.
 pub fun delay( action : () -> e a ) : delayed<e,a>
   unsafe-total
-    val r : ref<global,either<_,_>> = ref(Left(action))
+    val r : ref<global,computation<_,_>> = ref(XComputation(action))
     XDelay(r)
 
+// Create a new `:delayed` value.
+pub fun memo( value : a ) : delayed<e, a>
+  unsafe-total
+    val r : ref<global,computation<_,_>> = ref(XDone(value))
+    XDelay(r)
+
+pub fun force/go( delayed : delayed<e,a> ) : <div,read<global>,write<global>,alloc<global>|e> a
+  val r = delayed.dref
+  match !r
+    XDone(x) -> x
+    XBlocking -> delayed.go()
+    XComputation(action) ->
+      r := XBlocking // ensure that action can be unique
+      val x = mask-st{ mask<div>(action) }()
+      r := XDone(x)
+      x
+
 // Force a delayed value; the value is computed only on the first
 // call to `force` and cached afterwards.
 pub fun force( delayed : delayed<e,a> ) : e a
-  unsafe-total
-    val r = delayed.dref
-    match !r
-      Right(x) -> x
-      Left(action) ->
-        val x = mask-st{ mask<div>(action) }()
-        r := Right(x)
-        x
+  unsafe-total(fn() -> force/go(delayed))
 
 // Given a total function to calculate a value `:a`, return
 // a total function that only calculates the value once and then

Diff for: lib/std/core/hnd.kk

@@ -463,7 +463,7 @@ fun prompt-local-var(loc:local-var<s,a>, res : b  ) : <div,local<s>|e> b
   val v = loc
   yield-cont(fn(cont,x){ loc := v; prompt-local-var(std/core/types/@byref(loc),cont(x)) } )  // restore state early before the resume
 
-pub inline fun local-var(init:a, action: (l:local-var<s,a>) -> <local<s>|e> b ) : <local<s>|e> b
+pub inline fun local-var(init:a, action: (@local-var:local-var<s,a>) -> <local<s>|e> b ) : <local<s>|e> b
   pretend-no-div
     val loc : local-var<_,_> = local-new(init)
     val res = cast-ev1(action)(std/core/types/@byref(loc))

Diff for: lib/std/core/list.kk

@@ -20,19 +20,19 @@ import std/core/vector
 
 
 // Return the head of list if the list is not empty.
-pub fun head( xs : list<a> ) : maybe<a>
+pub fbip fun head( xs : list<a> ) : maybe<a>
   match xs
     Cons(x) -> Just(x)
     _       -> Nothing
 
 // Return the head of list with a default value in case the list is empty.
-pub fun default/head( xs : list<a>, default : a ) : a
+pub fbip fun default/head( xs : list<a>, default : a ) : a
   match xs
     Cons(x) -> x
     _       -> default
 
 // Return the tail of list. Returns the empty list if `xs` is empty.
-pub fun tail( xs : list<a> ) : list<a>
+pub fbip fun tail( xs : list<a> ) : list<a>
   match xs
     Cons(_,xx) -> xx
     _          -> []
@@ -49,7 +49,7 @@ pub fip fun is-empty( ^xs : list<a> ) : bool
 // ----------------------------------------------------------------------------
 
 // Returns a singleton list.
-pub fun single(x)
+pub fip(1) fun single(x)
   [x]
 
 // Returns the length of a list.
@@ -130,7 +130,7 @@ pub fun show-list( xs : list<a>, show-elem : (a) -> e string ) : e string
 
 // Zip two lists together by pairing the corresponding elements.
 // The returned list is only as long as the smallest input list.
-pub fun zip( xs : list<a>, ys : list<b> ) : list<(a,b)>
+pub fbip fun zip( xs : list<a>, ys : list<b> ) : list<(a,b)>
   match xs
     Cons(x,xx) -> match ys
       Cons(y,yy) -> Cons((x,y),zip(xx,yy))
@@ -139,7 +139,7 @@ pub fun zip( xs : list<a>, ys : list<b> ) : list<(a,b)>
 
 // Zip two lists together by apply a function `f` to all corresponding elements.
 // The returned list is only as long as the smallest input list.
-pub fun zipwith( xs : list<a>, ys :list<b>, f : (a,b) -> e c ) : e list<c>
+pub fbip fun zipwith( xs : list<a>, ys :list<b>, ^f : (a,b) -> e c ) : e list<c>
   match xs
     Cons(x,xx) -> match ys
       Cons(y,yy) -> Cons(f(x,y),zipwith(xx,yy,f))
@@ -149,18 +149,18 @@ pub fun zipwith( xs : list<a>, ys :list<b>, f : (a,b) -> e c ) : e list<c>
 // Zip two lists together by apply a function `f` to all corresponding elements
 // and their index in the list.
 // The returned list is only as long as the smallest input list.
-pub fun zipwith-indexed( xs0 : list<a>, ys0 :list<b>, f : (int,a,b) -> e c ) : e list<c>
-  fun zipwith-iter( i, xs, ys )
-    match xs
-      Cons(x,xx) -> match ys
-        Cons(y,yy) -> Cons(f(i,x,y),zipwith-iter(i+1,xx,yy))
-        Nil -> Nil
+pub fbip fun zipwith-indexed( xs0 : list<a>, ys0 :list<b>, ^f : (int,a,b) -> e c ) : e list<c>
+  zipwith-iter(0,xs0,ys0,f)
+
+fbip fun zipwith-iter( i, xs, ys, ^f )
+  match xs
+    Cons(x,xx) -> match ys
+      Cons(y,yy) -> Cons(f(i,x,y),zipwith-iter(i+1,xx,yy,f))
       Nil -> Nil
-  zipwith-iter(0,xs0,ys0)
+    Nil -> Nil
 
 // Unzip a list of pairs into two lists
 pub fun unzip( xs : list<(a,b)> ) : (list<a>,list<b>)
-  // todo: implement TRMC for multiple results
   fun iter( ys, acc1, acc2 )
     match ys
       Cons((x,y),xx) -> iter(xx,acc1 ++ ctx Cons(x,_),acc2 ++ ctx Cons(y,_))
@@ -169,7 +169,6 @@ pub fun unzip( xs : list<(a,b)> ) : (list<a>,list<b>)
 
 // Unzip a list of triples into three lists
 pub fun unzip3( xs : list<(a,b,c)>) : (list<a>,list<b>,list<c>)
-  // todo: implement TRMC for multiple results
   fun iter( ys, acc1, acc2, acc3 )
     match ys
       Cons((x,y,z),xx) -> iter(xx,acc1 ++ ctx Cons(x,_),acc2 ++ ctx Cons(y,_),acc3 ++ ctx Cons(z,_))
@@ -178,7 +177,6 @@ pub fun unzip3( xs : list<(a,b,c)>) : (list<a>,list<b>,list<c>)
 
 // Unzip a list of quadruples into four lists
 pub fun unzip4( xs : list<(a,b,c,d)>) : (list<a>,list<b>,list<c>,list<d>)
-  // todo: implement TRMC for multiple results
   fun iter( ys, acc1, acc2, acc3, acc4 )
     match ys
       Cons((x,y,z,w),xx) -> iter(xx,acc1 ++ ctx Cons(x,_),acc2 ++ ctx Cons(y,_),acc3 ++ ctx Cons(z,_),acc4 ++ ctx Cons(w,_))
@@ -198,7 +196,7 @@ pub fun drop( xs : list<a>, n : int ) : list<a>
     _ -> xs
 
 // Apply a function `f` to each element of the input list in sequence.
-pub fun map(xs : list<a>, f : a -> e b) : e list<b>
+pub fip fun map(xs : list<a>, ^f : a -> e b) : e list<b>
   match xs
     Cons(x,xx) -> Cons(f(x), xx.map(f))
     Nil -> Nil
@@ -285,12 +283,11 @@ pub fun split( xs : list<a>, n : int ) : (list<a>, list<a>)
   (xs.take(n), xs.drop(n))
 
 pub fun span( xs : list<a>, predicate : a -> e bool ) : e (list<a>,list<a>)
-  // todo: implement TRMC with multiple results to avoid the reverse
-  fun span-acc( ys, acc)
+  fun span-acc( ys, acc )
     match ys
-      Cons(y,yy) -> if y.predicate then yy.span-acc(Cons(y,acc)) else (acc.reverse,ys)
-      _ -> (acc.reverse, ys)
-  xs.span-acc( [] )
+      Cons(y,yy) -> if y.predicate then yy.span-acc(acc ++ ctx Cons(y, _)) else (acc ++. [],ys)
+      _ -> (acc ++. [], ys)
+  xs.span-acc( ctx _ )
 
 // Keep only those initial elements that satisfy `predicate`
 pub fun take-while( xs : list<a>, predicate : a -> e bool ) : e list<a>

Diff for: lib/std/core/maybe.kk

@@ -26,10 +26,16 @@ pub fun default( m : maybe<a>, nothing : a ) : a
     Just(x) -> x
 
 // Get the value of the `Just` constructor or raise an exception
-pub fun unjust( m : maybe<a> ) : exn a
+pub fun unjust( m : maybe<a>, ?kk-file-line: string) : exn a
   match m
     Just(x) -> x
-    Nothing -> throw("unexpected Nothing in std/core/maybe/unjust")
+    Nothing -> throw("unexpected Nothing in " ++ ?kk-file-line)
+
+// Get the value of the `Just` constructor or raise an exception with `error-msg`
+pub fun expect( m : maybe<a>, error-msg: string) : exn a
+  match m
+    Just(x) -> x
+    Nothing -> throw(error-msg)
 
 pub fun map( m : maybe<a>, f : a -> e b ) : e maybe<b>
   match m

Diff for: lib/std/core/maybe2.kk

@@ -26,10 +26,16 @@ pub fun default( m : maybe2<a,b>, nothing : (a,b) ) : (a,b)
     Just2(x,y) -> (x,y)
 
 // Get the value of the `Just` constructor or raise an exception
-pub fun unjust2( m : maybe2<a,b> ) : exn (a,b)
+pub fun unjust( m : maybe2<a,b>, ?kk-file-line: string) : exn (a,b)
   match m
     Just2(x,y) -> (x,y)
-    Nothing2   -> throw("unexpected Nothing2 in std/core/maybe/unjust2")
+    Nothing2   -> throw("unexpected Nothing2 in " ++ ?kk-file-line)
+
+// Get the value of the `Just` constructor or raise an exception
+pub fun expect( m : maybe2<a,b>, error-msg: string) : exn (a,b)
+  match m
+    Just2(x,y) -> (x,y)
+    Nothing2   -> throw(error-msg)
 
 pub fun map( m : maybe2<a,b>, f : (a,b) -> e (c,d) ) : e maybe2<c,d>
   match m