@effekt-lang/effekt 0.3.0 → 0.4.0

package/libraries/common/io.effekt

@@ -3,52 +3,71 @@ module io
 import ref
 import queue
 
-extern include llvm "../llvm/io.ll"
-extern include js "../js/io.js"
-
-// Asynchronous I/O
-// ----------------
-
-interface AsyncIO {
-  /**
-   * Runs the provided computation and conceptually waits until it completes by
-   * calling the writer-continuation.
-   *
-   * The provided writer-continuation should only ever be called ONCE.
-   * The computation is passed as a thunk in order to prevent accidental usage of
-   * other control effects that would violate the contract of calling the writer
-   * once.
-   */
-  def performIO[T](computation: (T => Unit at {io, global}) => Unit at {io, global}): T
-}
+// Event Loop
+// ----------
 
-/**
-  * Run an IO computation (that uses callbacks) here.
-  */
-def blocking(program: () => Unit / AsyncIO at {io, global}): Unit =
-  try { program() }
-  with AsyncIO {
-    def performIO[T](computation) = computation(resume)
-  }
+type Task[T] = () => T at {io, async, global}
 
+extern llvm """
+  declare void @c_yield(%Stack)
+"""
+
+extern async def spawn(task: Task[Unit]): Unit =
+  js "$effekt.callcc(callback => { setTimeout(() => callback($effekt.unit), 0); ${task}().run()})"
+  llvm """
+    call void @c_yield(%Stack %stack)
+    call void @run(%Neg ${task})
+    ret void
+  """
+
+extern async def yield(): Unit =
+  js "$effekt.callcc(callback => setTimeout(() => callback($effekt.unit), 0))"
+  llvm """
+    call void @c_yield(%Stack %stack)
+    ret void
+  """
+
+extern async def abort(): Nothing =
+  js "$effekt.callcc(callback => { return })"
+  llvm """
+    call void @eraseStack(%Stack %stack)
+    ret void
+  """
 
-interface Concurrent {
-  def yield(): Unit
-  def abort(): Nothing
-}
 
 // Promises
 // --------
 
 extern type Promise[T]
-  // = js "{promise: Promise, resolve: ƒ}"
-  // = llvm "Promise"
+  // = js "{resolve: ƒ, promise: Promise}"
+  // = llvm "{tag: 0, obj: Promise*}"
 
-interface Promises {
-  def promise[T](p: Task[T]): Promise[T]
-  def await[T](p: Promise[T]): T
+def promise[T](task: Task[T]): Promise[T] = {
+  val p = promise::make[T]();
+  spawn(box { p.resolve(task()) });
+  return p
 }
 
+extern llvm """
+  declare %Pos @c_promise_make()
+  declare void @c_promise_resolve(%Pos, %Pos)
+  declare void @c_promise_await(%Pos, %Neg)
+"""
+
+extern async def await[T](promise: Promise[T]): T =
+  js "$effekt.callcc(callback => ${promise}.promise.then(res => callback(res)))"
+  llvm """
+    call void @c_promise_await(%Pos ${promise}, %Stack %stack)
+    ret void
+  """
+
+extern async def resolve[T](promise: Promise[T], value: T): Unit =
+  js "$effekt.callcc(callback => { ${promise}.resolve(${value}); callback($effekt.unit)})"
+  llvm """
+    call void @c_promise_resolve(%Pos ${promise}, %Pos ${value}, %Stack %stack)
+    ret void
+  """
+
 namespace promise {
   extern js """
     function promise$make() {
@@ -63,96 +82,7 @@ namespace promise {
   extern io def make[T](): Promise[T] =
     js "promise$make()"
     llvm """
-      ; Get the default loop and run it.
       %promise = call %Pos @c_promise_make()
       ret %Pos %promise
     """
-
-  extern io def resolve[T](p: Promise[T], value: T): Unit =
-    js "${p}.resolve(${value})"
-    llvm """
-      ; Get the default loop and run it.
-      call void @c_promise_resolve(%Pos ${p}, %Pos ${value})
-      ret %Pos zeroinitializer
-    """
-
-  extern io def await[T](p: Promise[T], callback: T => Unit at {io, global}): Unit =
-    js "${p}.promise.then(res => (${callback})(res).run())"
-    llvm """
-      ; Get the default loop and run it.
-      call void @c_promise_await(%Pos ${p}, %Neg ${callback})
-      ret %Pos zeroinitializer
-    """
-}
-
-
-// TODO we cannot add effects Files, Console, etc. to Task since modules cannot be recursive, at the moment.
-effect IO = { AsyncIO, Concurrent, Promises }
-
-type Task[T] = () => T / IO at {io, global}
-
-
-// Event Loop
-// ----------
-
-def eventloop(prog: Task[Unit]) = {
-
-  def handle(p: Task[Unit]): Unit =
-    try { p() }
-    with Concurrent {
-      def yield() = eventloop::schedule(box { resume(()) })
-      def abort() = ()
-    } with AsyncIO {
-      // TODO there is a bug in our LLVM backend where eta-reducing the following will break
-      def performIO[T](computation) = computation(box { t =>
-        eventloop::schedule(box { resume(t) })
-      })
-    } with Promises {
-      def promise[T](task: Task[T]) = {
-        val p = promise::make[T]();
-        handle(box {
-          val t = task()
-          promise::resolve(p, t)
-        })
-        eventloop::schedule( box { resume(p) })
-      }
-      def await[T](p: Promise[T]) = promise::await(p, box { t => resume(t) })
-    }
-
-  handle(prog)
-
-  eventloop::start()
-  eventloop::stop()
-}
-
-namespace eventloop {
-  extern io def schedule(program: () => Unit at {io, global}): Unit =
-    js "setTimeout(() => (${program})().run(), 0)"
-    llvm """
-      call void @c_timer_wait(i64 0, %Neg ${program})
-      ret %Pos zeroinitializer
-    """
-
-  extern io def start(): Unit =
-    js "$effekt.unit"
-    llvm """
-      ; Get the default loop and run it.
-      %loop = call ptr @uv_default_loop()
-      %run_result = call i32 @uv_run(ptr %loop, i32 0)
-
-      ; return Unit
-      ret %Pos zeroinitializer
-    """
-
-  extern io def stop(): Unit =
-    js "$effekt.unit"
-    llvm """
-      ; Get the default loop, stop and close it.
-      %loop = call ptr @uv_default_loop()
-      call void @uv_stop(ptr %loop)
-      call void @uv_loop_close(ptr %loop)
-
-      ; return Unit
-      ret %Pos zeroinitializer
-    """
 }

package/libraries/common/list.effekt

@@ -222,6 +222,24 @@ def any[A](list: List[A]) { predicate: A => Bool }: Bool = {
   }
 }
 
+// Fold a list using `f`, starting from the left given a starting value.
+//
+// O(N)
+def foldLeft[A, B](l: List[A], init: B) { f: (B, A) => B }: B = {
+  var acc = init;
+  l.foreach { x => acc = f(acc, x) };
+  acc
+}
+
+// Fold a list using `f`, starting from the right given a starting value.
+//
+// O(N)
+def foldRight[A, B](l: List[A], init: B) { f: (A, B) => B }: B = {
+  var acc = init;
+  l.reverse.foreach { x => acc = f(x, acc) };
+  acc
+}
+
 // Sum the elements of the list.
 //
 // O(N)

package/libraries/common/process.effekt

@@ -7,4 +7,3 @@ extern io def exit(errorCode: Int): Nothing =
     ret %Pos zeroinitializer
   """
   chez "(exit ${errorCode})"
-  ml "(Posix.Process.exit (Word8.fromInt ${errorCode}))"

package/libraries/common/ref.effekt

@@ -3,10 +3,10 @@ module ref
 import effekt
 
 extern js """
-function set$impl(ref, value) {
-  ref.value = value;
-  return $effekt.unit;
-}
+  function set$impl(ref, value) {
+    ref.value = value;
+    return $effekt.unit;
+  }
 """
 
 /**
@@ -32,7 +32,6 @@ extern global def allocate[T](): Ref[T] =
 extern global def ref[T](init: T): Ref[T] =
   js "{ value: ${init} }"
   chez "(box ${init})"
-  ml "ref ${init}"
   llvm """
     %z = call %Pos @c_ref_fresh(%Pos ${init})
     ret %Pos %z
@@ -44,7 +43,6 @@ extern global def ref[T](init: T): Ref[T] =
 extern global def get[T](ref: Ref[T]): T =
   js "${ref}.value"
   chez "(unbox ${ref})"
-  ml "!${ref}"
   llvm """
     %z = call %Pos @c_ref_get(%Pos ${ref})
     ret %Pos %z
@@ -56,7 +54,6 @@ extern global def get[T](ref: Ref[T]): T =
 extern global def set[T](ref: Ref[T], value: T): Unit =
   js "set$impl(${ref}, ${value})"
   chez "(set-box! ${ref} ${value})"
-  ml "${ref} := ${value}"
   llvm """
     %z = call %Pos @c_ref_set(%Pos ${ref}, %Pos ${value})
     ret %Pos %z

package/libraries/common/string/tty.effekt

@@ -0,0 +1,66 @@
+module string/tty
+
+// ANSI escape codes
+namespace ANSI {
+  val CSI = "\u001b["
+
+  def escape(s: String) = CSI ++ s ++ "m"
+
+  val BLACK = escape("30")
+  val RED = escape("31")
+  val GREEN = escape("32")
+  val YELLOW = escape("33")
+  val BLUE = escape("34")
+  val MAGENTA = escape("35")
+  val CYAN = escape("36")
+  val WHITE = escape("37")
+
+  val BG_BLACK = escape("40")
+  val BG_RED = escape("41")
+  val BG_GREEN = escape("42")
+  val BG_YELLOW = escape("43")
+  val BG_BLUE = escape("44")
+  val BG_MAGENTA = escape("45")
+  val BG_CYAN = escape("46")
+  val BG_WHITE = escape("47")
+
+  val RESET = escape("0")
+
+  val BOLD = escape("1")
+  val FAINT = escape("2")
+  val ITALIC = escape("3")
+  val UNDERLINE = escape("4")
+  val BLINK = escape("5")
+  val REVERSE = escape("7")
+  val CROSSOUT = escape("9")
+  val OVERLINE = escape("53")
+}
+
+def red(text: String) = Formatted::colored(text, ANSI::RED)
+def green(text: String) = Formatted::colored(text, ANSI::GREEN)
+def dim(text: String) = Formatted::colored(text, ANSI::FAINT)
+def bold(text: String) = Formatted::colored(text, ANSI::BOLD)
+
+interface Formatted {
+  def supportsEscape(escape: String): Bool
+}
+
+namespace Formatted {
+  /// Run given block of code, allowing all formatting
+  def formatting[R] { prog : => R / Formatted }: R =
+    try { prog() } with Formatted {
+      def supportsEscape(escape: String) = resume(true)
+    }
+
+  /// Run given block of code, ignoring all formatting
+  def noFormatting[R] { prog : => R / Formatted }: R =
+    try { prog() } with Formatted {
+      def supportsEscape(escape: String) = resume(false)
+    }
+
+  def tryEmit(escape: String): String / Formatted =
+    if (do supportsEscape(escape)) escape else ""
+
+  def colored(text: String, colorEscape: String): String / Formatted =
+    tryEmit(colorEscape) ++ text ++ tryEmit(ANSI::RESET)
+}

package/libraries/common/string.effekt

@@ -181,11 +181,9 @@ def toInt(str: String, base: Int): Int / Exception[WrongFormat] = {
 }
 
 // Native versions of toInt (unused right now)
-//   ML: also accepts sml style `~2` for unary minus along with `+2` and `-2`
 extern pure def unsafeToInt(str: String): Int =
   js "(Number.isNaN(parseInt(${str})) ? undefined : parseInt(${str}))"
   chez "(string->number ${str})"
-  ml "Int.fromString ${str}"
 
 
 /**
@@ -243,36 +241,11 @@ def string[T] { prog: => T / Stream }: (T, String) = <>
 def printing[T] { prog: => T / Stream }: T = <>
 
 
-// ANSI escape codes
-namespace ANSI {
-  val BLACK = "\u001b[30m"
-  val RED = "\u001b[31m"
-  val GREEN = "\u001b[32m"
-  val YELLOW = "\u001b[33m"
-  val BLUE = "\u001b[34m"
-  val MAGENTA = "\u001b[35m"
-  val CYAN = "\u001b[36m"
-  val WHITE = "\u001b[37m"
-
-  val BG_BLACK = "\u001b[40m"
-  val BG_RED = "\u001b[41m"
-  val BG_GREEN = "\u001b[42m"
-  val BG_YELLOW = "\u001b[43m"
-  val BG_BLUE = "\u001b[44m"
-  val BG_MAGENTA = "\u001b[45m"
-  val BG_CYAN = "\u001b[46m"
-  val BG_WHITE = "\u001b[47m"
-
-  val RESET = "\u001b[0m"
-}
-
-
 // Characters
 // ----------
 //
 //   JS: Int (Unicode codepoints)
 //   CS: ?
-//   ML: 8-bit https://smlfamily.github.io/Basis/char.html
 //   LLVM: i64 representing utf-8 (varying length 1-4 bytes)
 
 extern pure def toString(ch: Char): String =
@@ -287,20 +260,17 @@ extern pure def toString(ch: Char): String =
 extern pure def toInt(ch: Char): Int =
   js "${ch}"
   chez "${ch}"
-  ml "${ch}"
   llvm "ret %Int ${ch}"
 
 extern pure def toChar(codepoint: Int): Char =
   js "${codepoint}"
   chez "${codepoint}"
-  ml "${codepoint}"
   llvm "ret %Int ${codepoint}"
 
 
 extern pure def infixLt(x: Char, y: Char): Bool =
   js "(${x} < ${y})"
   chez "(< ${x} ${y})"
-  ml "(${x}: int) < ${y}"
   llvm """
     %z = icmp slt %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -311,7 +281,6 @@ extern pure def infixLt(x: Char, y: Char): Bool =
 extern pure def infixLte(x: Char, y: Char): Bool =
   js "(${x} <= ${y})"
   chez "(<= ${x} ${y})"
-  ml "(${x}: int) <= ${y}"
   llvm """
     %z = icmp sle %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -322,7 +291,6 @@ extern pure def infixLte(x: Char, y: Char): Bool =
 extern pure def infixGt(x: Char, y: Char): Bool =
   js "(${x} > ${y})"
   chez "(> ${x} ${y})"
-  ml "(${x}: int) > ${y}"
   llvm """
     %z = icmp sgt %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -333,7 +301,6 @@ extern pure def infixGt(x: Char, y: Char): Bool =
 extern pure def infixGte(x: Char, y: Char): Bool =
   js "(${x} >= ${y})"
   chez "(>= ${x} ${y})"
-  ml "(${x}: int) >= ${y}"
   llvm """
     %z = icmp sge %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -388,7 +355,6 @@ def charAt(str: String, index: Int): Char / Exception[OutOfBounds] =
 extern pure def unsafeCharAt(str: String, n: Int): Char =
   js "${str}.codePointAt(${n})"
   chez "(char->integer (string-ref ${str} ${n}))"
-  ml "(Char.ord (String.sub (${str}, ${n})))"
   llvm """
     %x = call %Int @c_buffer_character_at(%Pos ${str}, i64 ${n})
     ret %Int %x

package/libraries/common/test.effekt

@@ -1,5 +1,6 @@
-import string
+import string/tty
 import process
+import bench
 
 interface Assertion {
   def assert(condition: Bool, msg: String): Unit
@@ -29,70 +30,131 @@ def assert(obtained: Char, expected: Char, msg: String): Unit / Assertion =
 def assert(obtained: String, expected: String, msg: String): Unit / Assertion =
   assertEqual(obtained, expected, msg) { (x, y) => x == y }
 
-def assert(obtained: Int, expected: Int): Unit / Assertion =
+def assert(obtained: Int, expected: Int): Unit / { Assertion, Formatted } =
   assertEqual(obtained, expected) { (x, y) => x == y } { x => show(x) }
 
-def assert(obtained: Bool, expected: Bool): Unit / Assertion =
+def assert(obtained: Bool, expected: Bool): Unit / { Assertion, Formatted } =
   assertEqual(obtained, expected) { (x, y) => x == y } { x => show(x) }
 
-def assert(obtained: Char, expected: Char): Unit / Assertion =
+def assert(obtained: Char, expected: Char): Unit / { Assertion, Formatted } =
   assertEqual(obtained, expected) { (x, y) => x == y } { x => show(x) }
 
-def assert(obtained: String, expected: String): Unit / Assertion =
+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) }
 
-def assertEqual[A](obtained: A, expected: A): Unit / Assertion =
+def assertEqual[A](obtained: A, expected: A): Unit / { Assertion, Formatted } =
   assertEqual(obtained, expected) { (x, y) => x.equals(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)
 
-def assertEqual[A](obtained: A, expected: A) { equals: (A, A) => Bool } { show: A => String }: Unit / Assertion =
-  do assert(equals(obtained, expected), "Obtained: " ++ show(obtained) ++ "\n but expected:" ++ show(expected))
+def assertEqual[A](obtained: A, expected: A) { equals: (A, A) => Bool } { show: A => String }: Unit / { Assertion, Formatted } =
+  do assert(equals(obtained, expected), Formatted::tryEmit(ANSI::RESET) ++ "Expected: ".dim ++ show(expected).green ++ "\n  Obtained: ".dim ++ show(obtained).red)
+  // NOTE:                              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  //             Here's an accidental capture! Can we prevent this somehow nicely?
 
 
 interface Test {
-  def success(name: String): Unit
-  def failure(name: String, msg: String): Unit
+  def success(name: String, duration: Int): Unit
+  def failure(name: String, msg: String, duration: Int): Unit
 }
 
-def test(name: String) { body: => Unit / Assertion } =
-  try { body(); do success(name) } with Assertion {
-    def assert(condition, msg) = if (condition) resume(()) else do failure(name, msg)
+/// Runs the `body` as a test under the given `name`
+/// See `suite` for examples.
+def test(name: String) { body: => Unit / Assertion } = {
+  val startTime = bench::relativeTimestamp()
+  try {
+    body()
+    val duration = Duration::diff(startTime, bench::relativeTimestamp())
+    do success(name, duration)
+  } with Assertion {
+    def assert(condition, msg) =
+      if (condition) resume(())
+      else {
+        val duration = Duration::diff(startTime, bench::relativeTimestamp())
+        do failure(name, msg, duration)
+      }
   }
+}
+
+/// Run a test suite with a given `name`.
+/// - If `printTimes` is `true` (or missing), prints out time in milliseconds.
+/// - Formats automatically using ANSI escapes.
+/// - Returns `true` if all tests succeed, otherwise returns `false`. If you want to exit the program on failure, see `mainSuite`.
+///
+/// Example:
+/// ```effekt
+/// suite("My Tests") {
+///   test("1 + 1 == 2") {
+///     assertEqual(1 + 1, 2)
+///   }
+/// }
+/// ```
+def suite(name: String, printTimes: Bool) { body: => Unit / { Test, Formatted } }: Bool / {} = {
+  with Formatted::formatting;
+
+  def ms(duration: Int): String / Formatted =
+    if (printTimes) {
+      " " ++ ("[" ++ bench::formatMs(duration) ++ "]").dim
+    } else {
+      ""
+    }
+
+  def dimWhenZeroElse(s: String, n: Int) { colorIfNonZero: String => String / Formatted } =
+    if (n == 0) { dim(s) }
+    else { colorIfNonZero(s) }
 
-def suite(name: String) { body: => Unit / Test }: Bool = {
-  println("Running suite: " ++ name);
   var failed = 0
   var passed = 0
 
-  try { body() } with Test {
-    def success(name) = {
-      passed = passed + 1
-      println(ANSI::GREEN ++ "+ " ++ name ++ "" ++ ANSI::RESET);
-      resume(())
-    }
-    def failure(name, msg) = {
-      failed = failed + 1
-      println(ANSI::RED ++ "- (FAIL) " ++ name ++ "\n    " ++ msg ++ ANSI::RESET);
-      resume(())
+  // 1) Print the name of the test
+  println(name.bold)
+
+  // 2) Run the tests, timing them
+  val totalDuration = timed {
+    try { body() } with Test {
+      // 2a) Handle a passing test on success
+      def success(name, duration) = {
+        passed = passed + 1
+        println("✓".green ++ " " ++ name ++ duration.ms)
+        resume(())
+      }
+
+      // 2b) Handle a failing test on failure, additionally printing its message
+      def failure(name, msg, duration) = {
+        failed = failed + 1
+        println("✕".red ++ " " ++ name ++ duration.ms)
+        println("  " ++ msg.red)
+        resume(())
+      }
     }
   }
-  if (failed > 0) {
-    println(ANSI::RED ++ "Some tests failed (" ++ passed.show ++ " passed, " ++ failed.show ++ " failed)" ++ ANSI::RESET)
-    false
-  } else {
-    println(ANSI::GREEN ++ "All tests passed (" ++ passed.show ++ " passed)" ++ ANSI::RESET)
-    true
-  }
+
+  // 3) Format the test results
+  println("")
+  println(" " ++ (passed.show ++ " pass").dimWhenZeroElse(passed) { green })
+  println(" " ++ (failed.show ++ " fail").dimWhenZeroElse(failed) { red })
+  println(" " ++ (passed + failed).show ++ " tests total" ++ totalDuration.ms)
+
+  // 4) Return true if all tests succeeded, otherwise false
+  return failed == 0
 }
 
+/// See `suite` above.
+def suite(name: String) { body: => Unit / { Test, Formatted } }: Bool / {} =
+  suite(name, true) { body }
+
 /// Use as `def main() = mainSuite("...") { ... }`
-def mainSuite(name: String) { body: => Unit / Test }: Unit = {
-  val result = suite(name) { body() }
+/// Recommended for standalone test files ran by CI.
+///
+/// Exits after running all tests:
+/// - if all tests succeed, exits the program with success (exit code 0)
+/// - otherwise exits the program with failure (exit code 1)
+def mainSuite(name: String) { body: => Unit / { Test, Formatted } }: Unit = {
+  val result = suite(name, true) { body }
   val exitCode = if (result) 0 else 1
   exit(exitCode)
 }

package/libraries/js/unsafe/cont.effekt

@@ -8,4 +8,4 @@ extern io def cont[A, B] { r: A => B / {} }: Cont[A, B] = js "${box r}"
 
 // This is unsafe if the continuation left the scope of the
 // capabilities it closed over
-extern control def apply[A, B](k: Cont[A, B], a: A): B / {} = js "${k}(${a})"
+extern async def apply[A, B](k: Cont[A, B], a: A): B / {} = js "${k}(${a})"