@effekt-lang/effekt 0.64.0 → 0.66.0

package/libraries/chez/cps/effekt.ss

@@ -47,6 +47,7 @@
                    [r (diff-ref realDiff)]
                    [oldValue (ref-value r)])
                 (ref-value-set! r (diff-value realDiff))
+                (ref-generation-set! r (diff-generation realDiff))
                 (set-box! n (make-diff r oldValue (ref-generation r) currentDiff))
                 (applyDiffs currentDiff (cdr diffs)))]))
 
@@ -60,10 +61,11 @@
            [store (snap-store snap)]
            [storeRoot (store-root store)])
         (reroot snapRoot storeRoot)
-        (store-root-set! store snapRoot)))
+        (store-root-set!       store snapRoot)
+        (store-generation-set! store (+ (snap-generation snap) 1))))
 
 ; Cont a = a, MetaCont -> #
-; Prompt = Int
+; Prompt = Symbol
 
 ; MetaCont = Cont * Prompt * Store | Snapshot * MetaCont?
 ; Holds a "copy" of k, as well as its prompt and store
@@ -102,14 +104,8 @@
 ; Ref | MetaCont -> void
 (define (deallocate _) (void))
 
-(define _prompt 1)
-(define (new-prompt)
-    (let ([prompt _prompt])
-         (set! _prompt (+ prompt 1))
-         prompt))
-
 (define (top-level-k x _) x)
-(define top-level-ks (make-meta-cont top-level-k 0 (create-store) '()))
+(define top-level-ks (make-meta-cont top-level-k (gensym "toplevel") (create-store) '()))
 
 ; a, MetaCont -> #
 (define (return x ks)
@@ -121,7 +117,7 @@
 
 ; Program Prompt b, MetaCont, Cont b -> #
 (define (reset prog ks k)
-    (let ([prompt (new-prompt)])
+    (let ([prompt (gensym)])
          (meta-cont-cont-set! ks k)
          (prog prompt (make-meta-cont return prompt (create-store) ks) return)))
 
@@ -132,7 +128,7 @@
               [snap (snapshot (meta-cont-store below))])
              (meta-cont-store-set! below snap)
              (meta-cont-rest-set! below above)
-             (if (= (meta-cont-prompt below) p)
+             (if (symbol=? (meta-cont-prompt below) p)
                  (values below new-below)
                  (worker below new-below))))
     (worker '() ks))
@@ -166,4 +162,4 @@
 
 ; Block b -> b
 (define (run-top-level p)
-    (p top-level-ks top-level-k))
+    (p top-level-ks top-level-k))

package/libraries/common/array.effekt

@@ -677,18 +677,27 @@ def feed[T, R](array: Array[T]) { reader: () => R / read[T] }: R = {
   }
 }
 
+/// Collects elements emitted by a push stream producer `stream` into a new array,
+/// discarding the result of the producer.
+/// The provided capacity is a hint for the expected number of elements.
+/// It must be strictly larger than zero.
+def collect[A](capacity: Int) { stream: () => Unit / emit[A] }: Array[A] =
+  returning::collect[A, Unit](capacity){stream}.second
+
 /// Collects elements emitted by a push stream producer `stream` into a new array,
 /// discarding the result of the producer.
 def collect[A] { stream: () => Unit / emit[A] }: Array[A] =
-  returning::collect[A, Unit]{stream}.second
+  collect[A](4){stream}
 
 namespace returning {
 
   /// Collects elements emitted by a push stream producer `stream` into a new array,
   /// returning the result of the producer as well as the collected array.
-  def collect[A, R] { stream: () => R / emit[A] }: (R, Array[A]) = {
+  /// The provided capacity is a hint for the expected number of elements.
+  /// It must be strictly larger than zero.
+  def collect[A, R](capacity: Int) { stream: () => R / emit[A] }: (R, Array[A]) = {
     var i = 0
-    var a = unsafeAllocate(1)
+    var a = unsafeAllocate(capacity)
     try {
       (stream(), a.resize(i))
     } with emit[A] { (v) =>
@@ -698,4 +707,10 @@ namespace returning {
       resume(())
     }
   }
+
+  /// Collects elements emitted by a push stream producer `stream` into a new array,
+  /// returning the result of the producer as well as the collected array.
+  def collect[A, R] { stream: () => R / emit[A] }: (R, Array[A]) =
+    returning::collect[A, R](4){stream}
+
 }

package/libraries/common/bytearray.effekt

@@ -300,13 +300,17 @@ def feed[R](bytes: ByteArray) { reader: () => R / read[Byte] }: R = {
   }
 }
 
+def collect(capacity: Int) { stream: () => Unit / emit[Byte] }: ByteArray =
+  returning::collect[Unit](capacity){stream}.second
+
 def collect { stream: () => Unit / emit[Byte] }: ByteArray =
-  returning::collect[Unit]{stream}.second
+  collect(4){stream}
 
 namespace returning {
-  def collect[R] { stream: () => R / emit[Byte] }: (R, ByteArray) = {
+
+  def collect[R](capacity: Int) { stream: () => R / emit[Byte] }: (R, ByteArray) = {
     var i = 0
-    var a = allocate(1)
+    var a = allocate(capacity)
     try {
       (stream(), a.resize(i))
     } with emit[Byte] { (v) =>
@@ -316,4 +320,8 @@ namespace returning {
       resume(())
     }
   }
+
+  def collect[R] { stream: () => R / emit[Byte] }: (R, ByteArray) =
+    returning::collect(4){stream}
+
 }

package/libraries/common/effekt.effekt

@@ -139,16 +139,20 @@ extern def show[R](value: R) at {}: String =
   chez "(show_impl ${value})"
   llvm "ret %Pos poison"
 
+extern def genericShow[R](value: R) at {}: String =
+  js "$effekt.show(${value})"
+  chez "(show_impl ${value})"
+
 // Strings
 // =======
-extern def infixConcat(s1: String, s2: String) at {}: String =
+extern def infixPlusPlus(s1: String, s2: String) at {}: String =
   js "${s1} + ${s2}"
   chez "(string-append ${s1} ${s2})"
   llvm """
     %spz = call %Pos @c_bytearray_concatenate(%Pos ${s1}, %Pos ${s2})
     ret %Pos %spz
   """
-  vm "effekt::infixConcat(String, String)"
+  vm "effekt::infixPlusPlus(String, String)"
 
 extern def length(str: String) at {}: Int =
   js "${str}.length"
@@ -231,13 +235,10 @@ def println(o: Ordering): Unit = println(o.show)
 // ==============
 
 /// Structural equality: Not available in the LLVM backend
-extern def equals[R](x: R, y: R) at {}: Bool =
+extern def genericEquals[R](x: R, y: R) at {}: Bool =
   js "$effekt.equals(${x}, ${y})"
   chez "(equal_impl ${x} ${y})"
 
-def differsFrom[R](x: R, y: R): Bool =
-  not(equals(x, y))
-
 // TODO fix this in the pattern matching compiler
 extern def infixEq(x: Unit, y: Unit) at {}: Bool =
   default { true }
@@ -345,29 +346,29 @@ extern def infixNeq(x: Byte, y: Byte) at {}: Bool =
 
 // Math ops
 // ========
-extern def infixAdd(x: Int, y: Int) at {}: Int =
+extern def infixPlus(x: Int, y: Int) at {}: Int =
   js "(${x} + ${y})"
   chez "(+ ${x} ${y})"
   llvm "%z = add  %Int ${x}, ${y} ret %Int %z"
-  vm "effekt::infixAdd(Int, Int)"
+  vm "effekt::infixPlus(Int, Int)"
 
-extern def infixMul(x: Int, y: Int) at {}: Int =
+extern def infixStar(x: Int, y: Int) at {}: Int =
   js "(${x} * ${y})"
   chez "(* ${x} ${y})"
   llvm "%z = mul  %Int ${x}, ${y} ret %Int %z"
-  vm "effekt::infixMul(Int, Int)"
+  vm "effekt::infixStar(Int, Int)"
 
-extern def infixDiv(x: Int, y: Int) at {}: Int =
+extern def infixSlash(x: Int, y: Int) at {}: Int =
   js "Math.floor(${x} / ${y})"
   chez "(floor (/ ${x} ${y}))"
   llvm "%z = sdiv %Int ${x}, ${y} ret %Int %z"
-  vm "effekt::infixDiv(Int, Int)"
+  vm "effekt::infixSlash(Int, Int)"
 
-extern def infixSub(x: Int, y: Int) at {}: Int =
+extern def infixMinus(x: Int, y: Int) at {}: Int =
   js "(${x} - ${y})"
   chez "(- ${x} ${y})"
   llvm "%z = sub  %Int ${x}, ${y} ret %Int %z"
-  vm "effekt::infixSub(Int, Int)"
+  vm "effekt::infixMinus(Int, Int)"
 
 extern def mod(x: Int, y: Int) at {}: Int =
   js "(${x} % ${y})"
@@ -375,29 +376,29 @@ extern def mod(x: Int, y: Int) at {}: Int =
   llvm "%z = srem %Int ${x}, ${y} ret %Int %z"
   vm "effekt::mod(Int, Int)"
 
-extern def infixAdd(x: Double, y: Double) at {}: Double =
+extern def infixPlus(x: Double, y: Double) at {}: Double =
   js "(${x} + ${y})"
   chez "(+ ${x} ${y})"
   llvm "%z = fadd %Double ${x}, ${y} ret %Double %z"
-  vm "effekt::infixAdd(Double, Double)"
+  vm "effekt::infixPlus(Double, Double)"
 
-extern def infixMul(x: Double, y: Double) at {}: Double =
+extern def infixStar(x: Double, y: Double) at {}: Double =
   js "(${x} * ${y})"
   chez "(* ${x} ${y})"
   llvm "%z = fmul %Double ${x}, ${y} ret %Double %z"
-  vm "effekt::infixMul(Double, Double)"
+  vm "effekt::infixStar(Double, Double)"
 
-extern def infixSub(x: Double, y: Double) at {}: Double =
+extern def infixMinus(x: Double, y: Double) at {}: Double =
   js "(${x} - ${y})"
   chez "(- ${x} ${y})"
   llvm "%z = fsub %Double ${x}, ${y} ret %Double %z"
-  vm "effekt::infixSub(Double, Double)"
+  vm "effekt::infixMinus(Double, Double)"
 
-extern def infixDiv(x: Double, y: Double) at {}: Double =
+extern def infixSlash(x: Double, y: Double) at {}: Double =
   js "(${x} / ${y})"
   chez "(fl/ ${x} ${y})"
   llvm "%z = fdiv %Double ${x}, ${y} ret %Double %z"
-  vm "effekt::infixDiv(Double, Double)"
+  vm "effekt::infixSlash(Double, Double)"
 
 extern def cos(x: Double) at {}: Double =
   js "Math.cos(${x})"
@@ -661,10 +662,10 @@ extern def not(b: Bool) at {}: Bool =
   """
   vm "effekt::not(Bool)"
 
-def infixOr { first: => Bool } { second: => Bool }: Bool =
+def infixBarBar { first: => Bool } { second: => Bool }: Bool =
   if (first()) true else second()
 
-def infixAnd { first: => Bool } { second: => Bool }: Bool =
+def infixAmpAmp { first: => Bool } { second: => Bool }: Bool =
   if (first()) second() else false
 
 

package/libraries/common/io/channel.effekt

@@ -3,29 +3,34 @@ module io/channel
 import io
 import io/signal
 
-record Node[A, B](this: Signal[A, B], rest: Ref[Option[Node[A, B]]])
+type Node[A, B] {
+  Nope()
+  Node(this: Signal[A, B], rest: Ref[Node[A, B]])
+}
 
-type Sender[A, B] = Ref[Node[A, B]]
-type Receiver[A, B] = Ref[Node[A, B]]
+type Sender[A, B] = Ref[Ref[Node[A, B]]]
+type Receiver[A, B] = Ref[Ref[Node[A, B]]]
 
 /// Creates a new rendezvous channel and returns the receiving and the sending end.
 /// Every send must be matched by exactly one receive upon which two values are exchanged.
 def channel[A, B](): (Sender[A, B], Receiver[A, B]) = {
-  val node = Node(signal(), ref(None()))
+  val node = ref(Nope())
   (ref(node), ref(node))
 }
 
 /// Sends a value to a channel and blocks until a receiver arrives.
 def send[A, B](sender: Sender[A, B], value: A): B = {
-  val Node(this, rest) = sender.get()
-  rest.get() match {
-    case None() =>
-      val node = Node(signal(), ref(None()))
-      rest.set(Some(node))
-      sender.set(node)
-    case Some(node) =>
-      sender.set(node)
+  val current = sender.get()
+  val (this, rest) = current.get() match {
+    case Nope() =>
+      val this = signal()
+      val rest = ref(Nope())
+      current.set(Node(this, rest))
+      (this, rest)
+    case Node(this, rest) =>
+      (this, rest)
   }
+  sender.set(rest)
   // TODO avoid yield
   yield()
   this.unsafeFire(value)
@@ -33,15 +38,17 @@ def send[A, B](sender: Sender[A, B], value: A): B = {
 
 /// Receives a value from a channel and blocks until a sender arrives.
 def receive[A, B](receiver: Receiver[A, B], value: B): A = {
-  val Node(this, rest) = receiver.get()
-  rest.get() match {
-    case None() =>
-      val node = Node(signal(), ref(None()))
-      rest.set(Some(node))
-      receiver.set(node)
-    case Some(node) =>
-      receiver.set(node)
+  val current = receiver.get()
+  val (this, rest) = current.get() match {
+    case Nope() =>
+      val this = signal()
+      val rest = ref(Nope())
+      current.set(Node(this, rest))
+      (this, rest)
+    case Node(this, rest) =>
+      (this, rest)
   }
+  receiver.set(rest)
   // TODO avoid yield
   yield()
   this.unsafeWait(value)

package/libraries/common/list.effekt

@@ -419,6 +419,18 @@ def reverseOnto[A](l: List[A], other: List[A]): List[A] =
 def append[A](l: List[A], other: List[A]): List[A] =
   l.reverse.reverseOnto(other)
 
+/// `l ++ other` is an alias for `l.append(other)`.
+///
+/// Example:
+/// ```
+/// > [1, 2, 3] ++ [4, 5, 6]
+/// [1, 2, 3, 4, 5, 6]
+/// ```
+///
+/// O(N)
+def infixPlusPlus[A](l: List[A], other: List[A]): List[A] =
+    append(l, other)
+
 /// Flatten a list of lists into a single list.
 ///
 /// Examples:

package/libraries/common/ref.effekt

@@ -43,7 +43,7 @@ extern def unsafeAllocate[T]() at global: Ref[T] =
     store i64 0, ptr %ref, align 8
     store ptr @c_ref_erase_field, ptr %refEraser, align 8
     store i64 0, ptr %fieldTag, align 8
-    store ptr null, ptr %fieldData_pointer, align 8 
+    store ptr null, ptr %fieldData_pointer, align 8
 
     %refWrap = insertvalue %Pos { i64 0, ptr poison }, ptr %ref, 1
     ret %Pos %refWrap
@@ -99,7 +99,7 @@ extern def set[T](ref: Ref[T], value: T) at global: Unit =
 
     tail call void @erasePositive(%Pos %field)
     store %Pos ${value}, ptr %field_pointer
-    tail call void @erasePositive(%Pos ${ref}) 
+    tail call void @erasePositive(%Pos ${ref})
 
     ret %Pos zeroinitializer
   """
@@ -107,4 +107,8 @@ extern def set[T](ref: Ref[T], value: T) at global: Unit =
 
 /// Modifies the inner contents of the `ref` with a function `f`
 def map[T](ref: Ref[T]) { f: T => T }: Unit =
-  ref.set(f(ref.get))
+  ref.set(f(ref.get))
+
+/// `r := v` serves as an alias for `r.set(v)`
+def infixColonEq[T](ref: Ref[T], v: T): Unit =
+  ref.set(v)

package/libraries/common/string.effekt

@@ -251,12 +251,20 @@ def each(string: String): Unit / emit[Char] =
     }
   }
 
+def collect(capacity: Int) { stream: () => Unit / emit[Char] }: String =
+  returning::collect[Unit](capacity){stream}.second
+
 def collect { stream: () => Unit / emit[Char] }: String =
-  returning::collect[Unit]{stream}.second
+  collect(4){stream}
 
 namespace returning {
-  def collect[R] { stream: () => R / emit[Char] }: (R, String) = {
-    val (result, bytes) = bytearray::returning::collect[R] { encodeUTF8 { stream } }
+
+  def collect[R](capacity: Int) { stream: () => R / emit[Char] }: (R, String) = {
+    val (result, bytes) = bytearray::returning::collect[R](capacity) { encodeUTF8 { stream } }
     (result, bytes.toString)
   }
+
+  def collect[R] { stream: () => R / emit[Char] }: (R, String) =
+    returning::collect(4){stream}
+
 }

package/libraries/common/test.effekt

@@ -46,10 +46,10 @@ def assert(obtained: String, expected: String): Unit / { Assertion, Formatted }
   assertEqual(obtained, expected) { (x, y) => x == y } { x => show(x) }
 
 def assertEqual[A](obtained: A, expected: A, msg: String): Unit / Assertion =
-  assertEqual(obtained, expected, msg) { (x, y) => x.equals(y) }
+  assertEqual(obtained, expected, msg) { (x, y) => x.genericEquals(y) }
 
 def assertEqual[A](obtained: A, expected: A): Unit / { Assertion, Formatted } =
-  assertEqual(obtained, expected) { (x, y) => x.equals(y) } { x => x.show }
+  assertEqual(obtained, expected) { (x, y) => x.genericEquals(y) } { x => x.genericShow }
 
 def assertEqual[A](obtained: A, expected: A, msg: String) { equals: (A, A) => Bool }: Unit / Assertion =
   do assert(equals(obtained, expected), msg)

package/libraries/js/effekt_runtime.js

@@ -1,43 +1,60 @@
-// Complexity of state:
-//
-//  get: O(1)
-//  set: O(1)
-//  capture: O(1)
-//  restore: O(|write operations since capture|)
+
+// Sentinel: a node whose .value is Mem is the current root.
 const Mem = null
 
-function Arena() {
-  const s = {
-    root: { value: Mem },
-    generation: 0,
-    fresh: (v) => {
-      const r = {
-        value: v,
-        generation: s.generation,
-        store: s,
-        set: (v) => {
-          const s = r.store
-          const r_gen = r.generation
-          const s_gen = s.generation
-
-          if (r_gen == s_gen) {
-            r.value = v;
-          } else {
-            const root = { value: Mem }
-            // update store
-            s.root.value = { ref: r, value: r.value, generation: r_gen, root: root }
-            s.root = root
-            r.value = v
-            r.generation = s_gen
-          }
-        }
-      };
-      return r
-    },
-    // not implemented
-    newRegion: () => s
-  };
-  return s
+// reusable buffer for rerooting
+const _rerootPath = []
+
+/**
+ * A mutable reference inside an `Arena`.
+ */
+class Ref {
+  constructor(v, s) {
+    this.value = v;
+    this.generation = s.generation;
+    this.store = s;
+  }
+
+  set(v) {
+    const s     = this.store;
+    const r_gen = this.generation;
+    const s_gen = s.generation;
+    if (r_gen === s_gen) {
+      this.value = v;
+    } else {
+      const root   = { value: Mem };
+      s.root.value = { ref: this, value: this.value, generation: r_gen, root };
+
+      s.root          = root;
+      this.value      = v;
+      this.generation = s_gen;
+    }
+  }
+}
+
+/**
+ * A snapshottable arena: a bag of `Ref`s whose collective state can be
+ * captured in O(1) and restored in O(#writes since capture).
+ */
+class Arena {
+  constructor() {
+    this.root       = { value: Mem };
+    this.generation = 0;
+  }
+
+  /**
+   * Allocate a new reference with initial value v.
+   */
+  fresh(v) {
+    return new Ref(v, this);
+  }
+
+  /**
+   * Region support (not implemented!).
+   */
+  newRegion() {
+    return this;
+  }
 }
 
 function snapshot(s) {
@@ -46,34 +63,43 @@ function snapshot(s) {
   return snap
 }
 
-function reroot(n) {
-  if (n.value === Mem) return;
-
-  const diff = n.value
-  const r = diff.ref
-  const v = diff.value
-  const g = diff.generation
-  const n2 = diff.root
-  reroot(n2)
-  n.value = Mem
-  n2.value = { ref: r, value: r.value, generation: r.generation, root: n}
-  r.value = v
-  r.generation = g
+function reroot(target) {
+  // 1. Walk from target toward the Mem node, collecting the path into `_rerootPath`
+  _rerootPath.length = 0
+  let cur = target
+  while (cur.value !== Mem) {
+    _rerootPath.push(cur)
+    cur = cur.value.root
+  }
+  // cur is now Mem (the current root)
+
+  // 2. Walk back from current root toward target,
+  //    reverse each edge, restore each ref.
+  for (let i = _rerootPath.length - 1; i >= 0; i--) {
+    const node   = _rerootPath[i]
+    const diff   = node.value // forward diff
+    const r      = diff.ref
+    cur.value    = { ref: r, value: r.value, generation: r.generation, root: node }
+    r.value      = diff.value      // restore ref's old value
+    r.generation = diff.generation //  ... and old generation
+    node.value   = Mem
+    cur          = node
+  }
 }
 
 function restore(store, snap) {
-  // linear in the number of modifications...
-  reroot(snap.root)
-  store.root = snap.root
+  if (snap.root.value !== Mem) {
+    // fast path: continuation is resumed immediately with no writes in between
+    reroot(snap.root)
+    store.root = snap.root
+  }
   store.generation = snap.generation + 1
 }
 
 // Common Runtime
 // --------------
-let _prompt = 1;
-
 const TOPLEVEL_K = (x, ks) => { throw { computationIsDone: true, result: x } }
-const TOPLEVEL_KS = { prompt: 0, arena: Arena(), rest: null }
+const TOPLEVEL_KS = { stack: null, prompt: Symbol("toplevel"), arena: new Arena(), rest: null }
 
 function THUNK(f) {
   f.thunk = true
@@ -92,9 +118,9 @@ const RETURN = (x, ks) => ks.rest.stack(x, ks.rest)
 
 // HANDLE(ks, ks, (p, ks, k) => { STMT })
 function RESET(prog, ks, k) {
-  const prompt = _prompt++;
+  const prompt = Symbol(); // gensym
   const rest = { stack: k, prompt: ks.prompt, arena: ks.arena, rest: ks.rest }
-  return prog(prompt, { prompt, arena: Arena([]), rest }, RETURN)
+  return prog(prompt, { stack: null, prompt, arena: new Arena(), rest }, RETURN)
 }
 
 function SHIFT(p, body, ks, k) {