@effekt-lang/effekt 0.17.0 → 0.19.0

package/libraries/common/buffer.effekt

@@ -34,7 +34,7 @@ def emptyBuffer[T](capacity: Int): Buffer[T] at {global} = {
 }
 def arrayBuffer[T](initialCapacity: Int): Buffer[T] at {global} = {
   // TODO allocate buffer (and array) into a region r.
-  val contents = emptyArray[T](initialCapacity)
+  val contents = array::allocate[T](initialCapacity)
   var head in global = 0
   var tail in global = 0
 
@@ -51,7 +51,7 @@ def arrayBuffer[T](initialCapacity: Int): Buffer[T] at {global} = {
     def read() = {
       if (buffer.empty?) None()
       else {
-        val result: T = contents.remove(head).getOrElse { <> };
+        val result: T = contents.unsafeGet(head);
         head = mod(head + 1, initialCapacity)
         Some(result)
       }
@@ -59,7 +59,7 @@ def arrayBuffer[T](initialCapacity: Int): Buffer[T] at {global} = {
     def write(el: T) = {
       if (buffer.full?) <> // raise(BufferOverflow())
 
-      contents.put(tail, el)
+      contents.unsafeSet(tail, el)
       tail = mod(tail + 1, initialCapacity)
     }
   }

package/libraries/common/bytearray.effekt

@@ -6,7 +6,7 @@ module bytearray
 extern type ByteArray
   // = llvm "%Pos"
   // = js "Uint8Array"
-
+  // = chez "bytevector"
 
 /// Allocates a new bytearray with the given `size`, its values are undefined.
 extern global def allocate(size: Int): ByteArray =
@@ -15,6 +15,7 @@ extern global def allocate(size: Int): ByteArray =
     %arr = call %Pos @c_bytearray_new(%Int ${size})
     ret %Pos %arr
   """
+  chez "(make-bytevector ${size})"
 
 extern pure def size(arr: ByteArray): Int =
   js "${arr}.length"
@@ -22,6 +23,7 @@ extern pure def size(arr: ByteArray): Int =
     %size = call %Int @c_bytearray_size(%Pos ${arr})
     ret %Int %size
   """
+  chez "(bytevector-length ${arr})"
 
 extern global def unsafeGet(arr: ByteArray, index: Int): Byte =
   js "(${arr})[${index}]"
@@ -29,6 +31,7 @@ extern global def unsafeGet(arr: ByteArray, index: Int): Byte =
     %byte = call %Byte @c_bytearray_get(%Pos ${arr}, %Int ${index})
     ret %Byte %byte
   """
+  chez "(bytevector-u8-ref ${arr} ${index})"
 
 extern global def unsafeSet(arr: ByteArray, index: Int, value: Byte): Unit =
   js "bytearray$set(${arr}, ${index}, ${value})"
@@ -36,6 +39,7 @@ extern global def unsafeSet(arr: ByteArray, index: Int, value: Byte): Unit =
     %z = call %Pos @c_bytearray_set(%Pos ${arr}, %Int ${index}, %Byte ${value})
     ret %Pos %z
   """
+  chez "(bytevector-u8-set! ${arr} ${index} ${value})"
 
 def resize(source: ByteArray, size: Int): ByteArray = {
   val target = allocate(size)
@@ -75,6 +79,7 @@ extern pure def fromString(str: String): ByteArray =
   llvm """
     ret %Pos ${str}
   """
+  chez "(string->utf8 ${str})"
 
 extern pure def toString(arr: ByteArray): String =
   js "(new TextDecoder('utf-8').decode(${arr}))"
@@ -82,10 +87,68 @@ extern pure def toString(arr: ByteArray): String =
   llvm """
     ret %Pos ${arr}
   """
+  chez "(utf8->string ${arr})"
 
 extern js """
   function bytearray$set(bytes, index, value) {
     bytes[index] = value;
     return $effekt.unit;
   }
+
+  function bytearray$compare(arr1, arr2) {
+    const len = Math.min(arr1.length, arr2.length);
+
+    for (let i = 0; i < len; i++) {
+      if (arr1[i] !== arr2[i]) {
+        return arr1[i] < arr2[i] ? -1 : 1;
+      }
+    }
+
+    if (arr1.length !== arr2.length) {
+      return arr1.length < arr2.length ? -1 : 1;
+    } else {
+      return 0;
+    }
+  }
+"""
+
+extern chez """
+  (define (bytearray$compare b1 b2)
+    (let ([len1 (bytevector-length b1)]
+          [len2 (bytevector-length b2)]
+          [minlen (min (bytevector-length b1) (bytevector-length b2))])
+      (let loop ([i 0])
+        (cond
+          [(= i minlen)
+          (cond [(< len1 len2) -1]
+                [(> len1 len2) 1]
+                [else 0])]
+          [(< (bytevector-u8-ref b1 i) (bytevector-u8-ref b2 i)) -1]
+          [(> (bytevector-u8-ref b1 i) (bytevector-u8-ref b2 i)) 1]
+          [else (loop (+ i 1))]))))
 """
+
+extern pure def compareByteArrayImpl(b1: ByteArray, b2: ByteArray): Int =
+  js "bytearray$compare(${b1}, ${b2})"
+  llvm """
+    %x = call %Int @c_bytearray_compare(%Pos ${b1}, %Pos ${b2})
+    ret %Int %x
+  """
+  chez "(bytearray$compare ${b1} ${b2})"
+
+def compareByteArray(b1: ByteArray, b2: ByteArray): Ordering = {
+  val ret = compareByteArrayImpl(b1, b2)
+  if (ret == 0) {
+    Equal()
+  } else if (ret < 0) {
+    Less()
+  } else { // ret > 0
+    Greater()
+  }
+}
+
+def compareStringBytes(left: String, right: String): Ordering = {
+  val l = left.fromString
+  val r = right.fromString
+  compareByteArray(l, r)
+}

package/libraries/common/effekt.effekt

@@ -90,6 +90,7 @@ extern pure def show(value: Char): String =
 
 extern pure def show(value: Byte): String =
   js "'' + ${value}"
+  chez "(string ${value})"
   llvm """
     %z = call %Pos @c_bytearray_show_Byte(i8 ${value})
     ret %Pos %z
@@ -166,17 +167,24 @@ type Ordering {
   Greater()
 }
 
+def compareInt(n: Int, m: Int) =
+  if (n == m) Equal()
+  else if (n < m) Less()
+  else Greater()
+
 extern pure def genericCompareImpl[R](x: R, y: R): Int =
   js "$effekt.compare(${x}, ${y})"
 
 /// Compares two values of the same type, returning an `Ordering`.
 /// Only available on the JavaScript backend.
 def genericCompare[R](x: R, y: R): Ordering = {
-  genericCompareImpl(x, y) match {
-    case -1 => Less()
-    case 0 => Equal()
-    case 1 => Greater()
-    case _ => <{ "Impossible: JS comparison returned invalid value!" }>
+  val ret = genericCompareImpl(x, y)
+  if (ret == 0) {
+    Equal()
+  } else if (ret < 0) {
+    Less()
+  } else { // ret > 0
+    Greater()
   }
 }
 
@@ -344,21 +352,25 @@ extern pure def cos(x: Double): Double =
   js "Math.cos(${x})"
   chez "(cos ${x})"
   vm "effekt::cos(Double)"
+  llvm "%z = call %Double @llvm.cos.f64(double ${x}) ret %Double %z"
 
 extern pure def sin(x: Double): Double =
   js "Math.sin(${x})"
   chez "(sin ${x})"
   vm "effekt::sin(Double)"
+  llvm "%z = call %Double @llvm.sin.f64(double ${x}) ret %Double %z"
 
 extern pure def atan(x: Double): Double =
   js "Math.atan(${x})"
   chez "(atan ${x})"
   vm "effekt::atan(Double)"
+  llvm "%z = call %Double @atan(double ${x}) ret %Double %z"
 
 extern pure def tan(x: Double): Double =
   js "Math.tan(${x})"
   chez "(tan ${x})"
   vm "effekt::tan(Double)"
+  llvm "%z = call %Double @tan(double ${x}) ret %Double %z"
 
 extern pure def sqrt(x: Double): Double =
   js "Math.sqrt(${x})"
@@ -381,15 +393,18 @@ extern pure def log(x: Double): Double =
   js "Math.log(${x})"
   chez "(log ${x})"
   vm "effekt::log(Double)"
+  llvm "%z = call %Double @llvm.log.f64(double ${x}) ret %Double %z"
 
 extern pure def log1p(x: Double): Double =
   js "Math.log1p(${x})"
   chez "(log (+ ${x} 1))"
+  llvm "%z = call %Double @log1p(double ${x}) ret %Double %z"
 
 extern pure def exp(x: Double): Double =
   js "Math.exp(${x})"
   chez "(exp ${x})"
   vm "effekt::exp(Double)"
+  llvm "%z = call %Double @llvm.exp.f64(double ${x}) ret %Double %z"
 
 def pow(base: Double, exponent: Int): Double = {
   def loop(base: Double, exponent: Int, acc: Double): Double = {
@@ -408,12 +423,14 @@ extern pure def pow(base: Double, exponent: Double): Double =
   js "Math.pow(${base}, ${exponent})"
   chez "(expt ${base} ${exponent})"
   vm "effekt::pow(Double, Double)"
+  llvm "%z = call %Double @llvm.pow.f64(double ${base}, double ${exponent}) ret %Double %z"
 
 // since we do not have "extern val", yet
 extern pure def _pi(): Double =
   js "Math.PI"
   chez "(* 4 (atan 1))"
   vm "effekt::pi()"
+  llvm "ret double 3.14159265358979323846264338327950288419716939937510582097494459"
 
 val PI: Double = _pi()
 
@@ -562,19 +579,19 @@ extern pure def infixGte(x: Double, y: Double): Bool =
 // TODO do we really need those? if yes, move to string.effekt
 extern pure def infixLt(x: String, y: String): Bool =
   js "(${x} < ${y})"
-  chez "(< ${x} ${y})"
+  chez "(string<? ${x} ${y})"
 
 extern pure def infixLte(x: String, y: String): Bool =
   js "(${x} <= ${y})"
-  chez "(<= ${x} ${y})"
+  chez "(string<=? ${x} ${y})"
 
 extern pure def infixGt(x: String, y: String): Bool =
   js "(${x} > ${y})"
-  chez "(> ${x} ${y})"
+  chez "(string>? ${x} ${y})"
 
 extern pure def infixGte(x: String, y: String): Bool =
   js "(${x} >= ${y})"
-  chez "(>= ${x} ${y})"
+  chez "(string>=? ${x} ${y})"
 
 
 // Boolean operations
@@ -638,10 +655,13 @@ extern pure def bitwiseXor(x: Int, y: Int): Int =
 extern pure def toByte(n: Int): Byte =
   js "${n}"
   llvm "%z = trunc %Int ${n} to %Byte ret %Byte %z"
+  chez "${n}"
 
 extern pure def toInt(n: Byte): Int =
   js "${n}"
   llvm "%z = zext %Byte ${n} to %Int ret %Int %z"
+  vm "effekt::toInt(Byte)"
+  chez "${n}"
 
 
 // Undefined and Null
@@ -657,11 +677,13 @@ extern pure def toInt(n: Byte): Int =
 extern pure def undefined[A](): A =
   js "undefined"
   chez "#f"
+  vm "effekt::undefined()"
 
 /// Is an FFI value undefined?
 extern pure def isUndefined[A](value: A): Bool =
   js "(${value} === undefined || ${value} === null)"
   chez "(eq? ${value} #f)"
+  vm "effekt::isUndefined[A](A)"
 
 
 // Tuples

package/libraries/common/io/network.effekt

@@ -57,14 +57,17 @@ def server(host: String, port: Int, handler: () => Unit / Socket at {io, async,
 
 namespace examples {
   def helloWorldApp(): Unit / Socket = {
-    val request = do receive();
+    val request = do receive().toString;
 
-    println("Received a request: " ++ request.toUTF8)
+    println("Received a request: " ++ request)
 
-    if (request.toUTF8.startsWith("GET /")) {
-      do send(fromUTF8("HTTP/1.1 200 OK\r\n\r\nHello from Effekt!"))
+    def respond(s: String): Unit / Socket =
+      do send(s.fromString)
+
+    if (request.startsWith("GET /")) {
+      respond("HTTP/1.1 200 OK\r\n\r\nHello from Effekt!")
     } else {
-      do send("HTTP/1.1 400 Bad Request\r\n\r\n".fromUTF8)
+      respond("HTTP/1.1 400 Bad Request\r\n\r\n")
     }
     do end()
   }

package/libraries/common/json.effekt

@@ -62,7 +62,7 @@ def encodeJsonObject[R]{ body: => R / JsonObjectBuilder }: R / emit[String] = {
   do emit("{")
   def c(k: String) = {
     if (not(first)) { do emit(",") }
-    do emit(escape(k)); do emit(":") 
+    do emit(escape(k)); do emit(":")
     first = false
   }
   val r = encodeJson {
@@ -76,7 +76,7 @@ def encodeJsonObject[R]{ body: => R / JsonObjectBuilder }: R / emit[String] = {
 /// Main entry point for encoding json.
 /// Emits individual tokens of the resulting json.
 def encodeJson[R]{ body: => R / JsonBuilder }: R / emit[String] = {
-  try body() with JsonBuilder { 
+  try body() with JsonBuilder {
       def null() = { resume(do emit("null")) }
       def bool(v) = { resume(do emit( if(v){ "true" } else { "false" } )) }
       def number(n) = { resume(do emit(show(n))) }
@@ -112,7 +112,7 @@ def readDouble(): Double / Scan[Char] = {
     if (optionally { readIf('.') }) {
       var b = 0.1
       var r = pre.toDouble
-      while (optionally[Int] { readDigit() } is Some(d)) {
+      while (returning::optionally[Int] { readDigit() } is Some(d)) {
         r = r + b * d.toDouble
         b = b * 0.1
       }
@@ -126,14 +126,14 @@ def readDouble(): Double / Scan[Char] = {
 
 def expectString(string: String): Unit / { Scan[Char], Exception[WrongFormat] } =
   for[Char] { string.each } { char =>
-    expect[Unit]("Expected " ++ string) { readIf(char) }
+    expect("Expected " ++ string) { readIf(char) }
   }
 
 /// Read and unescape a string in ""
 def readQuotedString(): Unit / { Scan[Char], emit[Char], Exception[WrongFormat] } = {
   try {
     skipWhitespace()
-    expect[Unit]("Expected \"") { readIf('"') }
+    expect("Expected \"") { readIf('"') }
     while(read[Char]() is c and c != '"') {
       c match {
         case '\\' => read[Char]() match {
@@ -191,7 +191,7 @@ def decodeJsonObject(): Unit / {Scan[Char], JsonObjectBuilder, Exception[WrongFo
   }
   do skip[Char]()
 }
-def decodeJsonList(): Unit / {Scan[Char], JsonBuilder, Exception[WrongFormat]} = { 
+def decodeJsonList(): Unit / {Scan[Char], JsonBuilder, Exception[WrongFormat]} = {
   var first = true
   expectString("[")
   with boundary
@@ -278,7 +278,7 @@ def build[R](){ body: => R / JsonBuilder }: (R, JsonValue) = {
   }
   (x, r)
 }
-def buildList[R](){ body: => R / JsonBuilder }: (R, List[JsonValue]) = collectList[JsonValue, R] {
+def buildList[R](){ body: => R / JsonBuilder }: (R, List[JsonValue]) = returning::collectList[JsonValue, R] {
   try body() with JsonBuilder {
     def number(n) = { do emit(Number(n)); resume(()) }
     def bool(b) = { do emit(Bool(b)); resume(()) }
@@ -296,7 +296,7 @@ def buildList[R](){ body: => R / JsonBuilder }: (R, List[JsonValue]) = collectLi
     }
   }
 }
-def buildDict[R](){ body: => R / JsonObjectBuilder }: (R, List[(String, JsonValue)]) = collectList[(String, JsonValue), R] {
+def buildDict[R](){ body: => R / JsonObjectBuilder }: (R, List[(String, JsonValue)]) = returning::collectList[(String, JsonValue), R] {
   try body() with JsonObjectBuilder {
     def field(k) = resume { {v} =>
       val x = build{v}
@@ -315,10 +315,12 @@ namespace test {
 
     // Read quoted string
     feed("\"\ta\n\ra\"") {
-      with scanner[Char, Unit]
+      with scanner[Char]
       println(collectString { readQuotedString() })
     }
 
+    println("")
+
     // Parse example
     feed("""{ "a": null, "b": [true,false,false,true], "f": 12.532   }"""){
       with scanner[Char]
@@ -336,8 +338,10 @@ namespace test {
       }
       handleJsonBuilder{d}{ decodeJson() }
     }
-    try{
-  
+
+    println("")
+
+    try {
       // Encode example
       encodeJson {
         do dict{
@@ -352,13 +356,15 @@ namespace test {
           }
         }
       }
-  
+
+      println("")
+
       // format with intermediate value
-      val j = feed("""{ 
-                  "a": null, 
-                  "b": [true, false, false, true], "f": 12.532   
+      val j = feed[JsonValue]("""{
+                  "a": null,
+                  "b": [true, false, false, true], "f": 12.532
                 } """){
-        with scanner[Char, JsonValue]
+        with returning::scanner[Char, JsonValue]
         build {
           decodeJson()
         }.second
@@ -366,18 +372,20 @@ namespace test {
       encodeJson{
         unbuild(j)
       }
-      
+
+      println("")
+
       // format (minify) example
       encodeJson{
-        feed("""{ 
-                  "a": null, 
-                  "b": [true, false, false, true], "f": 12.532   
+        feed("""{
+                  "a": null,
+                  "b": [true, false, false, true], "f": 12.532
                 } """){
-          with scanner[Char, Unit]
+          with scanner[Char]
           decodeJson()
         }
       }
-  
+
     } with emit[String] { e =>
       resume(println(e))
     }

package/libraries/common/list.effekt

@@ -670,35 +670,113 @@ def partition[A](l: List[A]) { pred: A => Bool }: (List[A], List[A]) = {
   (lefts.reverse, rights.reverse)
 }
 
-/// Sort a list using a given comparison function.
+/// Utilities for sorting, see 'sortBy' for more details.
+namespace sort {
+  /// Splits the given list into monotonic segments (so a list of lists).
+  ///
+  /// Internally used in the mergesort 'sortBy' to prepare the to-be-merged partitions.
+  def sequences[A](list: List[A]) { compare: (A, A) => Bool }: List[List[A]] = list match {
+    case Cons(a, Cons(b, rest)) =>
+      if (compare(a, b)) {
+        ascending(b, rest) { diffRest => Cons(a, diffRest) } {compare}
+      } else {
+        descending(b, [a], rest) {compare}
+      }
+    case _ => [list]
+  }
+
+  /// When in an ascending sequence, try to add `current` to `run` (if possible)
+  def ascending[A](current: A, rest: List[A]) { runDiff: List[A] => List[A] } { compare: (A, A) => Bool }: List[List[A]] = rest match {
+    case Cons(next, tail) and compare(current, next) =>
+      ascending(next, tail) { diffRest => runDiff(Cons(current, diffRest)) }  {compare}
+    case _ => Cons(runDiff([current]), sequences(rest) {compare})
+  }
+
+  /// When in an descending sequence, try to add `current` to `run` (if possible)
+  def descending[A](current: A, run: List[A], rest: List[A]) { compare: (A, A) => Bool }: List[List[A]] = rest match {
+    case Cons(next, tail) and not(compare(current, next)) =>
+      descending(next, Cons(current, run), tail) {compare}
+    case _ => Cons(Cons(current, run), sequences(rest) {compare})
+  }
+
+  def mergeAll[A](runs: List[List[A]]) { compare: (A, A) => Bool }: List[A] = runs match {
+    case Cons(single, Nil()) => single
+    case _ => {
+      // recursively merge in pairs until there's only a single list
+      val newRuns = mergePairs(runs) {compare}
+      mergeAll(newRuns) {compare}
+    }
+  }
+
+  def mergePairs[A](runs: List[List[A]]) { compare: (A, A) => Bool }: List[List[A]] = runs match {
+    case Cons(a, Cons(b, rest)) =>
+      Cons(merge(a, b) {compare}, mergePairs(rest) {compare})
+    case _ => runs
+  }
+
+  def merge[A](l1: List[A], l2: List[A]) { compare: (A, A) => Bool }: List[A] =
+    (l1, l2) match {
+      case (Nil(), _) => l2
+      case (_, Nil()) => l1
+      case (Cons(h1, t1), Cons(h2, t2)) =>
+        if (compare(h1, h2)) {
+          Cons(h1, merge(t1, l2) {compare})
+        } else {
+          Cons(h2, merge(l1, t2) {compare})
+        }
+    }
+}
+
+/// Sort a list given a comparison operator (like less-or-equal!)
+/// The sorting algorithm is stable and should act reasonably well on partially sorted data.
+///
+/// Examples:
+/// ```
+/// > [1, 3, -1, 5].sortBy { (a, b) => a <= b }
+/// [-1, 1, 3, 5]
+///
+/// > [1, 3, -1, 5].sortBy { (a, b) => a >= b }
+/// [5, 3, 1, -1]
+///
+/// > [(1, 0), (0, 1), (-1, 1), (0, 0)].sortBy { (a, b) => a.first + a.second <= b.first + b.second }
+/// [(1, -1), (0, 0), (1, 0), (0, 1)]
+///
+/// > Nil[Int]().sortBy { (a, b) => a <= b }
+/// []
+/// ```
 ///
 /// Note: this implementation is not stacksafe!
+/// (works for ~5M random elements just fine, but OOMs on ~10M random elements)
 ///
-/// O(N log N)
-def sortBy[A](l: List[A]) { compare: (A, A) => Bool }: List[A] =
-  l match {
-    case Nil() => Nil()
-    case Cons(pivot, rest) =>
-      val (lt, gt) = rest.partition { el => compare(el, pivot) };
-      val leftSorted = sortBy(lt) { (a, b) => compare(a, b) }
-      val rightSorted = sortBy(gt) { (a, b) => compare(a, b) }
-      leftSorted.append(Cons(pivot, rightSorted))
-  }
+/// O(N log N) worstcase
+def sortBy[A](list: List[A]) { lessOrEqual: (A, A) => Bool }: List[A] = {
+  val monotonicRuns = sort::sequences(list) {lessOrEqual}
+  sort::mergeAll(monotonicRuns) {lessOrEqual}
+}
+
+/// Sort a list of integers in an ascending order.
+/// See 'sortBy' for more details.
+///
+/// O(N log N) worstcase
+def sort(l: List[Int]): List[Int] = l.sortBy { (a, b) => a <= b }
+
+/// Sort a list of doubles in an ascending order.
+/// See 'sortBy' for more details.
+///
+/// O(N log N) worstcase
+def sort(l: List[Double]): List[Double] = l.sortBy { (a, b) => a <= b }
 
-def sort(l: List[Int]): List[Int] = l.sortBy { (a, b) => a < b }
-def sort(l: List[Double]): List[Double] = l.sortBy { (a, b) => a < b }
 
-/// Check if a list is sorted according to the given comparison function.
+/// Check if a list is sorted according to the given comparison function (less-or-equal).
 ///
 /// O(N)
-def isSortedBy[A](list: List[A]) { compare: (A, A) => Bool }: Bool = {
+def isSortedBy[A](list: List[A]) { lessOrEqual: (A, A) => Bool }: Bool = {
   def go(list: List[A]): Bool = {
     list match {
-      case Nil() => true
-      case Cons(x, Nil()) => true
       case Cons(x, Cons(y, rest)) =>
         val next = Cons(y, rest) // Future work: Replace this by an @-pattern!
-        compare(x, y) && go(next)
+        lessOrEqual(x, y) && go(next)
+      case _ => true
     }
   }
   go(list)