@effekt-lang/effekt 0.3.0 → 0.5.0

package/libraries/common/effekt.effekt

@@ -30,10 +30,6 @@ namespace chez {
   extern include chezMonadic "../chez/monadic/effekt.ss"
 }
 
-namespace ml {
-  extern include ml "../ml/effekt.sml"
-}
-
 namespace llvm {
   extern include llvm "../llvm/rts.ll"
   extern include llvm "../llvm/forward-declare-c.ll"
@@ -49,10 +45,6 @@ extern def println(value: String): Unit =
     call void @c_io_println_String(%Pos ${value})
     ret %Pos zeroinitializer ; Unit
   """
-  ml { print(value); print("\n") }
-
-extern io def print(value: String): Unit =
-  ml "print ${value}"
 
 def println(value: Int): Unit = println(value.show)
 def println(value: Unit): Unit = println(value.show)
@@ -63,7 +55,6 @@ def println(value: Byte): Unit = println(value.show)
 extern pure def show(value: Int): String =
   js "'' + ${value}"
   chez "(show-number ${value})"
-  ml "show'int ${value}"
   llvm """
     %z = call %Pos @c_buffer_show_Int(%Int ${value})
     ret %Pos %z
@@ -74,7 +65,6 @@ def show(value: Unit): String = "()"
 extern pure def show(value: Double): String =
   js "'' + ${value}"
   chez "(show-number ${value})"
-  ml "show'real ${value}"
   llvm """
     %z = call %Pos @c_buffer_show_Double(%Double ${value})
     ret %Pos %z
@@ -89,7 +79,6 @@ def show(value: Bool): String =
 extern pure def show(value: Char): String =
   js "String.fromCodePoint(${value})"
   chez "(string (integer->char ${value}))"
-  ml "str (chr ${value})"
   llvm """
     %z = call %Pos @c_buffer_show_Char(%Int ${value})
     ret %Pos %z
@@ -115,7 +104,6 @@ extern io def inspect[R](value: R): Unit =
 extern pure def infixConcat(s1: String, s2: String): String =
   js "((${s1}) + (${s2}))"
   chez "(string-append ${s1} ${s2})"
-  ml "${s1} ^ ${s2}"
   llvm """
     %spz = call %Pos @c_buffer_concatenate(%Pos ${s1}, %Pos ${s2})
     ret %Pos %spz
@@ -124,7 +112,6 @@ extern pure def infixConcat(s1: String, s2: String): String =
 extern pure def length(str: String): Int =
   js "${str}.length"
   chez "(string-length ${str})"
-  ml "String.size ${str}"
   llvm """
     %x = call %Int @c_buffer_length(%Pos ${str})
     call void @erasePositive(%Pos ${str})
@@ -134,7 +121,6 @@ extern pure def length(str: String): Int =
 extern pure def unsafeSubstring(str: String, from: Int, to: Int): String =
   js "${str}.substring(${from}, ${to})"
   chez "(substring ${str} ${from} ${to})" // potentially raises: "Exception in substring: ..."
-  ml "String.extract (${str}, ${from}, SOME (${to} - ${from}))"
   llvm """
     %x = call %Pos @c_buffer_substring(%Pos ${str}, i64 ${from}, i64 ${to})
     ret %Pos %x
@@ -147,7 +133,6 @@ extern pure def unsafeSubstring(str: String, from: Int, to: Int): String =
 extern io def random(): Double =
   js "Math.random()"
   chez "(random 1.0)"
-  ml "mlRandomReal ()"
 
 // References and state
 // ====================
@@ -159,13 +144,12 @@ extern io def random(): Double =
 
 // Equality
 // ========
-/**
- * Result of comparison between two objects according to some order:
- *
- * - `Less()` means that the first object is *before* the first in the order,
- * - `Equal()` means that the two objects are the same in the order,
- * - and `Greater()` means that the second object is *before* the first in the order.
- */
+
+/// Result of comparison between two objects according to some order:
+///
+/// - `Less()` means that the first object is *before* the first in the order,
+/// - `Equal()` means that the two objects are the same in the order,
+/// - and `Greater()` means that the second object is *before* the first in the order.
 type Ordering {
   Less();
   Equal();
@@ -175,7 +159,8 @@ type Ordering {
 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`.
+/// 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()
@@ -197,13 +182,10 @@ def println(o: Ordering): Unit = println(o.show)
 // Comparison ops
 // ==============
 
-/**
- * Structural equality: Not available in the LLVM backend
- */
+/// Structural equality: Not available in the LLVM backend
 extern pure def equals[R](x: R, y: R): Bool =
   js "$effekt.equals(${x}, ${y})"
   chez "(equal? ${x} ${y})"
-  ml "${x} = ${y}"
 
 def differsFrom[R](x: R, y: R): Bool =
   not(equals(x, y))
@@ -212,12 +194,10 @@ def differsFrom[R](x: R, y: R): Bool =
 extern pure def infixEq(x: Unit, y: Unit): Bool =
   js "true"
   chez "#t"
-  ml "true"
 
 extern pure def infixEq(x: Int, y: Int): Bool =
   js "${x} === ${y}"
   chez "(equal? ${x} ${y})"
-  ml "${x} = ${y}"
   llvm """
     %z = icmp eq %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -228,7 +208,6 @@ extern pure def infixEq(x: Int, y: Int): Bool =
 extern pure def infixNeq(x: Int, y: Int): Bool =
   js "${x} !== ${y}"
   chez "(not (equal? ${x} ${y}))"
-  ml "${x} <> ${y}"
   llvm """
     %z = icmp ne %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -239,7 +218,6 @@ extern pure def infixNeq(x: Int, y: Int): Bool =
 extern pure def infixEq(x: Char, y: Char): Bool =
   js "${x} === ${y}"
   chez "(equal? ${x} ${y})"
-  ml "${x} = ${y}"
   llvm """
     %z = icmp eq %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -250,7 +228,6 @@ extern pure def infixEq(x: Char, y: Char): Bool =
 extern pure def infixNeq(x: Char, y: Char): Bool =
   js "${x} !== ${y}"
   chez "(not (equal? ${x} ${y}))"
-  ml "${x} <> ${y}"
   llvm """
     %z = icmp ne %Int ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -261,7 +238,6 @@ extern pure def infixNeq(x: Char, y: Char): Bool =
 extern pure def infixEq(x: String, y: String): Bool =
   js "${x} === ${y}"
   chez "(equal? ${x} ${y})"
-  ml "${x} = ${y}"
   llvm """
     %res = call %Pos @c_buffer_eq(%Pos ${x}, %Pos ${y})
     ret %Pos %res
@@ -272,7 +248,6 @@ def infixNeq(x: String, y: String): Bool = not(x == y)
 extern pure def infixEq(x: Bool, y: Bool): Bool =
   js "${x} === ${y}"
   chez "(equal? ${x} ${y})"
-  ml "${x} = ${y}"
   llvm """
     %slim_x = extractvalue %Pos ${x}, 0
     %slim_y = extractvalue %Pos ${y}, 0
@@ -285,7 +260,6 @@ extern pure def infixEq(x: Bool, y: Bool): Bool =
 extern pure def infixNeq(x: Bool, y: Bool): Bool =
   js "${x} !== ${y}"
   chez "(not (equal? ${x} ${y}))"
-  ml "${x} <> ${y}"
   llvm """
     %slim_x = extractvalue %Pos ${x}, 0
     %slim_y = extractvalue %Pos ${y}, 0
@@ -301,87 +275,69 @@ extern pure def infixNeq(x: Bool, y: Bool): Bool =
 extern pure def infixAdd(x: Int, y: Int): Int =
   js "(${x} + ${y})"
   chez "(+ ${x} ${y})"
-  ml "(${x}: int) + ${y}"
   llvm "%z = add  %Int ${x}, ${y} ret %Int %z"
 
 extern pure def infixMul(x: Int, y: Int): Int =
   js "(${x} * ${y})"
   chez "(* ${x} ${y})"
-  ml "(${x}: int) * ${y}"
   llvm "%z = mul  %Int ${x}, ${y} ret %Int %z"
 
 extern pure def infixDiv(x: Int, y: Int): Int =
   js "Math.floor(${x} / ${y})"
   chez "(floor (/ ${x} ${y}))"
-  ml "(${x}: int) div ${y}"
   llvm "%z = sdiv %Int ${x}, ${y} ret %Int %z"
 
 extern pure def infixSub(x: Int, y: Int): Int =
   js "(${x} - ${y})"
   chez "(- ${x} ${y})"
-  ml "(${x}: int) - ${y}"
   llvm "%z = sub  %Int ${x}, ${y} ret %Int %z"
 
 extern pure def mod(x: Int, y: Int): Int =
   js "(${x} % ${y})"
   chez "(modulo ${x} ${y})"
-  ml "(${x}: int) mod ${y}"
   llvm "%z = srem %Int ${x}, ${y} ret %Int %z"
 
 extern pure def infixAdd(x: Double, y: Double): Double =
   js "(${x} + ${y})"
   chez "(+ ${x} ${y})"
-  ml "(${x}: real) + ${y}"
   llvm "%z = fadd %Double ${x}, ${y} ret %Double %z"
 
 extern pure def infixMul(x: Double, y: Double): Double =
   js "(${x} * ${y})"
   chez "(* ${x} ${y})"
-  ml "(${x}: real) * ${y}"
   llvm "%z = fmul %Double ${x}, ${y} ret %Double %z"
 
 extern pure def infixSub(x: Double, y: Double): Double =
   js "(${x} - ${y})"
   chez "(- ${x} ${y})"
-  ml "(${x}: real) - ${y}"
   llvm "%z = fsub %Double ${x}, ${y} ret %Double %z"
 
 extern pure def infixDiv(x: Double, y: Double): Double =
   js "(${x} / ${y})"
   chez "(/ ${x} ${y})"
-  ml "(${x}: real) / ${y}"
   llvm "%z = fdiv %Double ${x}, ${y} ret %Double %z"
 
 extern pure def cos(x: Double): Double =
   js "Math.cos(${x})"
   chez "(cos ${x})"
-  ml "Math.cos ${x}"
 
 extern pure def sin(x: Double): Double =
   js "Math.sin(${x})"
   chez "(sin ${x})"
-  ml "Math.sin ${x}"
 
 extern pure def atan(x: Double): Double =
   js "Math.atan(${x})"
   chez "(atan ${x})"
-  ml "Math.atan ${x}"
 
 extern pure def tan(x: Double): Double =
   js "Math.tan(${x})"
   chez "(tan ${x})"
-  ml "Math.tan ${x}"
 
 extern pure def sqrt(x: Double): Double =
   js "Math.sqrt(${x})"
   chez "(sqrt ${x})"
-  ml "Math.sqrt ${x}"
   llvm "%z = call %Double @llvm.sqrt.f64(double ${x}) ret %Double %z"
 
-extern llvm """
-declare double @llvm.sqrt.f64(double %x)
-"""
-
 def square(x: Double): Double = x * x
 
 def neg(n: Double): Double =
@@ -396,52 +352,73 @@ def abs(n: Double): Double =
 extern pure def log(x: Double): Double =
   js "Math.log(${x})"
   chez "(log ${x})"
-  ml "Math.ln ${x}"
 
 extern pure def log1p(x: Double): Double =
   js "Math.log1p(${x})"
   chez "(log (+ ${x} 1))"
-  ml "Math.ln (${x} + 1.0)"
 
 extern pure def exp(x: Double): Double =
   js "Math.exp(${x})"
   chez "(exp ${x})"
-  ml "Math.exp ${x}"
+
+def pow(base: Double, exponent: Int): Double = {
+  def loop(base: Double, exponent: Int, acc: Double): Double = {
+    if (exponent == 0) acc
+    else if (exponent.mod(2) == 0) loop(base * base, exponent / 2, acc)  // even exponent
+    else loop(base, exponent - 1, acc * base)  // odd exponent
+  }
+  loop(base, exponent, 1.0)
+}
+
+extern pure def pow(base: Double, exponent: Double): Double =
+  js "Math.pow(${base}, ${exponent})"
+  chez "(expt ${base} ${exponent})"
 
 // since we do not have "extern val", yet
 extern pure def _pi(): Double =
   js "Math.PI"
   chez "(* 4 (atan 1))"
-  ml "Math.pi"
 
 val PI: Double = _pi()
 
 extern pure def toInt(d: Double): Int =
   js "Math.trunc(${d})"
   chez "(flonum->fixnum ${d})"
-  ml "Real.trunc ${d}"
   llvm "%z = fptosi double ${d} to %Int ret %Int %z"
 
 extern pure def toDouble(d: Int): Double =
   js "${d}"
   chez "${d}"
-  ml "Real.fromInt ${d}"
   llvm "%z = sitofp i64 ${d} to double ret double %z"
 
 extern pure def round(d: Double): Int =
   js "Math.round(${d})"
   chez "(round ${d})"
-  ml "Real.round ${d}"
+  llvm """
+    %i = call %Double @llvm.round.f64(double ${d})
+    %z = fptosi double %i to %Int ret %Int %z
+  """
+
+def round(d: Double, digits: Int): Double = {
+  val factor = pow(10.0, digits)
+  round(d * factor).toDouble / factor
+}
 
 extern pure def floor(d: Double): Int =
   js "Math.floor(${d})"
   chez "(flonum->fixnum (floor ${d}))"
-  ml "Real.floor ${d}"
+  llvm """
+    %i = call %Double @llvm.floor.f64(double ${d})
+    %z = fptosi double %i to %Int ret %Int %z
+  """
 
 extern pure def ceil(d: Double): Int =
   js "Math.ceil(${d})"
   chez "(flonum->fixnum (ceiling ${d}))"
-  ml "Real.ceil ${d}"
+  llvm """
+    %i = call %Double @llvm.ceil.f64(double ${d})
+    %z = fptosi double %i to %Int ret %Int %z
+  """
 
 def min(n: Int, m: Int): Int =
   if (n < m) n else m
@@ -459,7 +436,6 @@ def abs(n: Int): Int =
 extern pure def infixLt(x: Int, y: Int): 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
@@ -470,7 +446,6 @@ extern pure def infixLt(x: Int, y: Int): Bool =
 extern pure def infixLte(x: Int, y: Int): 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
@@ -481,7 +456,6 @@ extern pure def infixLte(x: Int, y: Int): Bool =
 extern pure def infixGt(x: Int, y: Int): 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
@@ -492,7 +466,6 @@ extern pure def infixGt(x: Int, y: Int): Bool =
 extern pure def infixGte(x: Int, y: Int): 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
@@ -503,17 +476,14 @@ extern pure def infixGte(x: Int, y: Int): Bool =
 extern pure def infixEq(x: Double, y: Double): Bool =
   js "${x} === ${y}"
   chez "(= ${x} ${y})"
-  ml "(${x}: real) = ${y}"
 
 extern pure def infixNeq(x: Double, y: Double): Bool =
   js "${x} !== ${y}"
   chez "(not (= ${x} ${y}))"
-  ml "(${x}: real) <> ${y}"
 
 extern pure def infixLt(x: Double, y: Double): Bool =
   js "(${x} < ${y})"
   chez "(< ${x} ${y})"
-  ml "(${x}: real) < ${y}"
   llvm """
     %z = fcmp olt %Double ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -524,12 +494,10 @@ extern pure def infixLt(x: Double, y: Double): Bool =
 extern pure def infixLte(x: Double, y: Double): Bool =
   js "(${x} <= ${y})"
   chez "(<= ${x} ${y})"
-  ml "(${x}: real) <= ${y}"
 
 extern pure def infixGt(x: Double, y: Double): Bool =
   js "(${x} > ${y})"
   chez "(> ${x} ${y})"
-  ml "(${x}: real) > ${y}"
   llvm """
     %z = fcmp ogt %Double ${x}, ${y}
     %fat_z = zext i1 %z to i64
@@ -540,28 +508,23 @@ extern pure def infixGt(x: Double, y: Double): Bool =
 extern pure def infixGte(x: Double, y: Double): Bool =
   js "(${x} >= ${y})"
   chez "(>= ${x} ${y})"
-  ml "(${x}: real) >= ${y}"
 
 // 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})"
-  ml "(${x}: string) < ${y}"
 
 extern pure def infixLte(x: String, y: String): Bool =
   js "(${x} <= ${y})"
   chez "(<= ${x} ${y})"
-  ml "(${x}: string) <= ${y}"
 
 extern pure def infixGt(x: String, y: String): Bool =
   js "(${x} > ${y})"
   chez "(> ${x} ${y})"
-  ml "(${x}: string) > ${y}"
 
 extern pure def infixGte(x: String, y: String): Bool =
   js "(${x} >= ${y})"
   chez "(>= ${x} ${y})"
-  ml "(${x}: string) >= ${y}"
 
 
 // Boolean operations
@@ -569,7 +532,6 @@ extern pure def infixGte(x: String, y: String): Bool =
 extern pure def not(b: Bool): Bool =
   js "!${b}"
   chez "(not ${b})"
-  ml "not ${b}"
   llvm """
     %p = extractvalue %Pos ${b}, 0
     %q = xor i64 1, %p
@@ -586,11 +548,19 @@ def infixAnd { first: => Bool } { second: => Bool }: Bool =
 
 // Bitwise operations
 // ==================
+
+/// Arithmetic left shift
 extern pure def bitwiseShl(x: Int, y: Int): Int =
   js "(${x} << ${y})"
   chez "(ash ${x} ${y})"
   llvm "%z = shl %Int ${x}, ${y} ret %Int %z"
 
+/// Arithmetic right shift
+extern pure def bitwiseShr(x: Int, y: Int): Int =
+  js "(${x} >> ${y})"
+  chez "(ash ${x} (- ${y}))"
+  llvm "%z = ashr %Int ${x}, ${y} ret %Int %z"
+
 extern pure def bitwiseAnd(x: Int, y: Int): Int =
   js "(${x} & ${y})"
   chez "(logand ${x} ${y})"
@@ -620,24 +590,17 @@ extern pure def toInt(n: Byte): Int =
 //
 //   js:   undefined || null
 //   chez: #f
-//   ml:  NONE (of option 'a)
 //   llvm: null?
 
-/**
- * The value used by the FFI to represent undefined values
- */
+/// The value used by the FFI to represent undefined values
 extern pure def undefined[A](): A =
   js "undefined"
   chez "#f"
-  ml "NONE"
 
-/**
- * Is an FFI value undefined?
- */
+/// Is an FFI value undefined?
 extern pure def isUndefined[A](value: A): Bool =
   js "(${value} === undefined || ${value} === null)"
   chez "(eq? ${value} #f)"
-  ml "Option.isSome ${value}"
 
 
 // Tuples
@@ -669,9 +632,7 @@ def loop { f: {Control} => Unit }: Unit = try {
   def continue() = loop { f }
 }
 
-/**
- * Calls provided action repeatedly. `start` is inclusive, `end` is not.
- */
+/// Calls provided action repeatedly. `start` is inclusive, `end` is not.
 def each(start: Int, end: Int) { action: (Int) => Unit } = {
   def loop(i: Int): Unit =
     if (i < end) { action(i); loop(i + 1) }
@@ -679,9 +640,7 @@ def each(start: Int, end: Int) { action: (Int) => Unit } = {
   loop(start)
 }
 
-/**
- * Calls provided action repeatedly with support for breaking. `start` is inclusive, `end` is not.
- */
+/// Calls provided action repeatedly with support for breaking. `start` is inclusive, `end` is not.
 def each(start: Int, end: Int) { action: (Int) {Control} => Unit } = {
   var i = start;
   loop { {l} =>

package/libraries/common/exception.effekt

@@ -53,7 +53,6 @@ def wrongFormat(msg: String): Nothing / Exception[WrongFormat] =
 extern io def panic[R](msg: String): R =
   js "(function() { throw ${msg} })()"
   chez "(raise ${msg})"
-  ml "raise Fail ${msg}"
   llvm """
     call void @c_io_println_String(%Pos ${msg})
     call void @exit(i32 1)

package/libraries/common/io/console.effekt

@@ -1,53 +1,47 @@
 module io/console
 
 import io
-import io/time // just for testing
-
-extern js """
-  const readline = require('node:readline');
-"""
 
 interface Console {
   def readLine(): String
   def writeLine(content: String): Unit
 }
 
+/// Handler for the console effect, using the Console available in js
+def console[R] { program: () => R / Console }: R = {
+  val c = js::newConsole()
+  try {
+    val r = program()
+    js::close(c)
+    return r
+  } with Console {
+    def readLine() = resume(js::readLine(c))
+    def writeLine(message) = resume(js::writeLine(c, message))
+  }
+}
+
 namespace js {
+
+  extern jsNode """
+    const readline = require('node:readline');
+  """
+
   extern type JSConsole
-  extern {io} def newConsole(): JSConsole =
-    js """readline.createInterface({
+
+  extern io def newConsole(): JSConsole =
+    jsNode """readline.createInterface({
         input: process.stdin,
         output: process.stdout,
       })"""
-  extern {io} def close(console: JSConsole): Unit =
-    js "${console}.close()"
 
-  extern {io} def readline(console: JSConsole, k: String => Unit at {io, global}): Unit =
-    js "${console}.question('', input => (${k})(input).run())"
-}
+  extern io def close(console: JSConsole): Unit =
+    jsNode "${console}.close()"
 
-/**
- * Handler for the console effect, using the Console available in js
- */
-def console[R] { prog: => R / Console }: R / AsyncIO = {
-  val c = js::newConsole()
-  try { val res = prog(); js::close(c); res } with Console {
-    def readLine() = {
-      resume(do performIO[String](box { write =>
-        js::readline(c, write)
-      }))
-    }
-    def writeLine(content) = resume(println(content))
-  }
-}
+  extern async def readLine(console: JSConsole): String =
+    jsNode "$effekt.callcc(callback => ${console}.once('line', callback))"
 
-// TODO we could also use stdin and out to implement the Console effect:
-namespace alternative {
-  extern {io} def writeStdoutCallback(message: String, k: () => Unit at {io, global}): Unit =
-    js "process.stdout.write(${message}, 'utf-8', () => (${k})().run())"
-
-  def write(message: String): Unit / IO =
-    do performIO[Unit](box { write => writeStdoutCallback(message, box { write(()) })})
+  extern io def writeLine(console: JSConsole, message: String): Unit =
+    jsNode "${console}.output.write(${message} + '\\n')"
 }
 
 namespace examples {
@@ -58,9 +52,9 @@ namespace examples {
     do writeLine("Hi " ++ name ++ ", nice to meet you!")
   }
 
-  def main() = eventloop(box {
+  def main() = {
     with console;
     greeter()
-  })
+  }
 
-}
+}