@effekt-lang/effekt 0.2.1 → 0.2.2

package/libraries/llvm/text/string.effekt

@@ -0,0 +1,179 @@
+module text/string
+
+import immutable/option
+import immutable/list
+
+extern pure def length(s: String): Int = """
+   %x = call %Int @c_buffer_length(%Pos %s)
+   call void @c_buffer_refcount_decrement(%Pos %s)
+   ret %Int %x
+"""
+extern pure def substring(s: String, start: Int, end: Int): String = """
+   %x = call %Pos @c_buffer_substring(%Pos %s, i64 %start, i64 %end)
+   call void @c_buffer_refcount_decrement(%Pos %s)
+   ret %Pos %x
+"""
+def unsafeCharAt(s: String, i: Int): String = substring(s, i, i+1)
+
+def charAt(str: String, i: Int): Option[String] = {
+    if ( i < 0 || i >= length(str)) {
+        None()
+    } else {
+        Some(unsafeCharAt(str, i))
+    }
+}
+
+def startsWith(str: String, prefix: String): Boolean = {
+    if (length(str) < length(prefix)) {
+        false
+    } else {
+        substring(str, 0, length(prefix)) == prefix
+    }
+}
+def map(str: String){ f: String => String }: String = {
+    def rec(i: Int, acc: String): String = {
+        if (i < length(str)) {
+            rec(i+1, acc ++ f(unsafeCharAt(str, i)))
+        } else acc
+    }
+    rec(0, "")
+}
+def map[A](str: String){ f: String => A }: List[A] = {
+    def rec(i: Int): List[A] = {
+        if (i < length(str)) {
+            Cons(f(unsafeCharAt(str, i)), rec(i+1))
+        } else Nil()
+    }
+    rec(0)
+}
+def indexOf(str: String, start: Int, substr: String): Option[Int] = {
+    if(length(str) - start < length(substr)) {
+        None()
+    } else if(substring(str, start, start + length(substr)) == substr) {
+        Some(start)
+    } else {
+        indexOf(str, start + 1, substr)
+    }
+}
+// """ // fix some parsing bug for vscode syntax highlighting
+
+def showQuoted(s: String): String =
+ "\x22" ++ map(s){ c =>
+   if(c == "\x22") {
+    "\\\x22"
+   } else if (c == "\\") {
+    "\\\\"
+   } else c
+ } ++ "\x22"
+def showQuoted(l: List[String]): String = showList(l){e => showQuoted(e)}
+def showQuoted(o: Option[String]): String = showOption(o){ e => showQuoted(e) }
+
+def toInt(s: String): Option[Int] = {
+  def go(i: Int, acc: Int): Int / Exception[RuntimeError] = {
+    if(i >= length(s)) {
+      acc
+    } else if(unsafeCharAt(s, i) == "0") {
+      go(i + 1, 10 * acc + 0)
+    } else if(unsafeCharAt(s, i) == "1") {
+      go(i + 1, 10 * acc + 1)
+    } else if(unsafeCharAt(s, i) == "2") {
+      go(i + 1, 10 * acc + 2)
+    } else if(unsafeCharAt(s, i) == "3") {
+      go(i + 1, 10 * acc + 3)
+    } else if(unsafeCharAt(s, i) == "4") {
+      go(i + 1, 10 * acc + 4)
+    } else if(unsafeCharAt(s, i) == "5") {
+      go(i + 1, 10 * acc + 5)
+    } else if(unsafeCharAt(s, i) == "6") {
+      go(i + 1, 10 * acc + 6)
+    } else if(unsafeCharAt(s, i) == "7") {
+      go(i + 1, 10 * acc + 7)
+    } else if(unsafeCharAt(s, i) == "8") {
+      go(i + 1, 10 * acc + 8)
+    } else if(unsafeCharAt(s, i) == "9") {
+      go(i + 1, 10 * acc + 9)
+    } else {
+      raise("Not an integer")
+    }
+  }
+  try {
+    if(s.length == 0) {
+        None()
+    } else if(s.startsWith("-")) {
+        Some(0 - go(1, 0))
+    } else {
+        Some(go(0, 0))
+    }
+  } with Exception[RuntimeError] {
+    def raise(e: RuntimeError, msg: String) = {
+      None()
+    }
+  }
+}
+def toBoolean(s: String): Option[Boolean] = {
+  if(s == "true") {
+    Some(true)
+  } else if (s == "false") {
+    Some(false)
+  } else {
+    None()
+  }
+}
+
+
+// Byte arrays (for compatibility with other backends, we have the Bytes type)
+type Bytes = String
+def bytes(s: String): Bytes = s
+// length(Bytes) = length(String)
+extern pure def unsafeIndex(s: Bytes, i: Int): Int = """
+   %x = call %Int @c_buffer_index(%Pos %s, i64 %i)
+   call void @c_buffer_refcount_decrement(%Pos %s)
+   ret %Int %x
+"""
+// """ // fix some parsing bug for vscode syntax highlighting
+def index(b: Bytes, i: Int): Option[Int] = if(i < b.length) { Some(b.unsafeIndex(i)) } else { None() }
+
+def eachInRange(b: Bytes, start: Int, end: Int){ fn: Int => Unit }: Unit = {
+  if(end < 0 || end > b.length) {
+    b.eachInRange(start,b.length){fn}
+  }
+  def rec(start: Int): Unit = {
+    if(start < end) {
+      fn(b.unsafeIndex(start))
+      rec(start+1)
+    } else { () }
+  }
+  rec(start)
+}
+def each(b: Bytes){ fn: Int => Unit } = {
+  b.eachInRange(0,b.length){fn}
+}
+
+effect Abort(): Unit // TODO: Maybe use Control effect
+def occursAt(subb: Bytes, b: Bytes, i: Int): Boolean = {
+  if(i + subb.length <= b.length) {
+    try{
+      var x = 0;
+      b.eachInRange(i, i + subb.length){ b =>
+        if(b != subb.unsafeIndex(x)){ do Abort() }
+        x = x + 1
+      }
+      true
+    } with Abort {
+      () => false
+    }
+  } else false
+}
+def split(b: String, sep: String): List[String] = {
+  def rec(next: Int, done: Int, acc: List[String]): List[Bytes] = {
+    if(sep.occursAt(b, next)) {
+      rec(next - 1, next,
+        Cons(b.substring(next + sep.length, done), acc))
+    } else if(next == 0) {
+      Cons(b.substring(0, done), acc)
+    } else {
+      rec(next - 1, done, acc)
+    }
+  }
+  rec(b.length - sep.length, b.length, Nil())
+}

package/libraries/llvm/types.c

@@ -0,0 +1,20 @@
+#ifndef EFFEKT_TYPES_C
+#define EFFEKT_TYPES_C
+
+
+typedef int64_t Int;
+typedef double Double;
+
+struct Pos {
+    uint64_t tag; // type-local tag
+    void *obj; // pointer into the heap
+};
+
+static const struct Pos Unit = (struct Pos) { .tag = 0, .obj = NULL, };
+static const struct Pos BooleanFalse = (struct Pos) { .tag = 0, .obj = NULL, };
+static const struct Pos BooleanTrue = (struct Pos) { .tag = 1, .obj = NULL, };
+
+typedef struct Pos String;
+
+
+#endif

package/libraries/ml/effekt.effekt

@@ -0,0 +1,267 @@
+// Based on libraries\js\monadic\effekt.effekt
+
+module effekt
+
+extern include "effekt.sml"
+
+def locally[R] { f: => R }: R = f()
+
+// Side effecting ops
+// ==================
+def println(value: Int): Unit = println(value.show)
+def println(value: Unit): Unit = println(value.show)
+def println(value: Double): Unit = println(value.show)
+def println(value: Boolean): Unit = println(value.show)
+
+def println(value: String): Unit = print(value ++ "\n")
+extern io def print(value: String): Unit = "print ${value}"
+
+extern io def random(): Double =
+  "mlRandomReal ()"
+
+// TODO: js is absolute, but that is too big for 32-bit ints
+extern io def timestamp(): Int =
+  "IntInf.toInt ((Time.toMilliseconds (Time.now ())) - mlStartTime)"
+
+// String ops
+// ==========
+extern pure def show(value: Int): String =
+  "show'int ${value}"
+extern pure def show(value: Unit): String =
+  "show'unit ${value}"
+extern pure def show(value: Double): String =
+  "show'real ${value}"
+extern pure def show(value: String): String =
+  "show'string ${value}"
+extern pure def show(value: Boolean): String =
+  "show'bool ${value}"
+
+extern pure def infixConcat(s1: String, s2: String): String =
+  "${s1} ^ ${s2}"
+
+// Math ops
+// ========
+extern pure def infixAdd(x: Int, y: Int): Int =
+  "(${x}: int) + ${y}"
+
+extern pure def infixMul(x: Int, y: Int): Int =
+  "(${x}: int) * ${y}"
+
+extern pure def infixDiv(x: Int, y: Int): Int =
+  "(${x}: int) div ${y}"
+
+extern pure def infixSub(x: Int, y: Int): Int =
+  "(${x}: int) - ${y}"
+
+extern pure def mod(x: Int, y: Int): Int =
+  "(${x}: int) mod ${y}"
+
+extern pure def infixAdd(x: Double, y: Double): Double =
+  "(${x}: real) + ${y}"
+
+extern pure def infixMul(x: Double, y: Double): Double =
+  "(${x}: real) * ${y}"
+
+extern pure def infixSub(x: Double, y: Double): Double =
+  "(${x}: real) - ${y}"
+
+extern pure def infixDiv(x: Double, y: Double): Double =
+  "(${x}: real) / ${y}"
+
+def min(n: Int, m: Int): Int =
+    if (n < m) n else m
+
+def max(n: Int, m: Int): Int =
+    if (n > m) n else m
+
+// trig
+// ====
+
+extern pure def cos(x: Double): Double =
+  "Math.cos ${x}"
+
+extern pure def sin(x: Double): Double =
+  "Math.sin ${x}"
+
+extern pure def atan(x: Double): Double =
+  "Math.atan ${x}"
+
+extern pure def tan(x: Double): Double =
+  "Math.tan ${x}"
+
+extern pure def sqrt(x: Double): Double =
+  "Math.sqrt ${x}"
+
+extern pure def square(x: Double): Double =
+  "(${x}: real) * ${x}"
+
+extern pure def log(x: Double): Double =
+  "Math.ln ${x}"
+
+extern pure def log1p(x: Double): Double =
+  "Math.ln (${x} + 1.0)"
+
+extern pure def exp(x: Double): Double =
+  "Math.exp ${x}"
+
+// since we do not have "extern val", yet
+extern pure def _pi(): Double =
+  "Math.pi"
+
+val PI: Double = _pi()
+
+extern pure def toInt(d: Double): Int =
+  "Real.round ${d}"
+
+extern pure def toDouble(d: Int): Double =
+  "Real.fromInt ${d}"
+
+extern pure def floor(d: Double): Int =
+  "Real.floor ${d}"
+
+extern pure def ceil(d: Double): Int =
+  "Real.ceil ${d}"
+
+
+// Comparison ops
+// ==============
+extern pure def infixEq[R](x: R, y: R): Boolean =
+  "${x} = ${y}"
+
+extern pure def infixNeq[R](x: R, y: R): Boolean =
+  "not (${x} = ${y})"
+
+extern pure def infixLt(x: Int, y: Int): Boolean =
+  "(${x}: int) < ${y}"
+
+extern pure def infixLte(x: Int, y: Int): Boolean =
+  "(${x}: int) <= ${y}"
+
+extern pure def infixGt(x: Int, y: Int): Boolean =
+  "(${x}: int) > ${y}"
+
+extern pure def infixGte(x: Int, y: Int): Boolean =
+  "(${x}: int) >= ${y}"
+
+extern pure def infixLt(x: Double, y: Double): Boolean =
+  "(${x}: real) < ${y}"
+
+extern pure def infixLte(x: Double, y: Double): Boolean =
+  "(${x}: real) <= ${y}"
+
+extern pure def infixGt(x: Double, y: Double): Boolean =
+  "(${x}: real) > ${y}"
+
+extern pure def infixGte(x: Double, y: Double): Boolean =
+  "(${x}: real) >= ${y}"
+
+extern pure def infixLt(x: String, y: String): Boolean =
+  "(${x}: string) < ${y}"
+
+extern pure def infixLte(x: String, y: String): Boolean =
+  "(${x}: string) <= ${y}"
+
+extern pure def infixGt(x: String, y: String): Boolean =
+  "(${x}: string) > ${y}"
+
+extern pure def infixGte(x: String, y: String): Boolean =
+  "(${x}: string) >= ${y}"
+
+// Boolean ops
+// ===========
+extern pure def not(b: Boolean): Boolean =
+  "not ${b}"
+
+extern pure def infixOr(x: Boolean, y: Boolean): Boolean =
+  "${x} orelse ${y}"
+
+extern pure def infixAnd(x: Boolean, y: Boolean): Boolean =
+  "${x} andalso ${y}"
+
+// Pairs
+// =====
+record Tuple2[A, B](first: A, second: B)
+record Tuple3[A, B, C](first: A, second: B, third: C)
+record Tuple4[A, B, C, D](first: A, second: B, third: C, fourth: D)
+record Tuple5[A, B, C, D, E](first: A, second: B, third: C, fourth: D, fifth: E)
+record Tuple6[A, B, C, D, E, F](first: A, second: B, third: C, fourth: D, fifth: E, sixth: F)
+
+// Exceptions
+// ==========
+// a fatal runtime error that cannot be caught
+extern io def panic[R](msg: String): R =
+  "raise Fail ${msg}"
+
+interface Exception[E] {
+  def raise(exception: E, msg: String): Nothing
+}
+record RuntimeError()
+
+def raise[A](msg: String): A / Exception[RuntimeError] = do raise(RuntimeError(), msg) match {}
+def raise[A, E](exception: E, msg: String): A / Exception[E] = do raise(exception, msg) match {}
+
+// converts exceptions of (static) type E to an uncatchable panic that aborts the program
+def panicOn[E] { prog: => Unit / Exception[E] }: Unit =
+  try { prog() } with Exception[E] { def raise(exception: E, msg: String) = panic(msg) }
+
+// reports exceptions of (static) type E to the console
+def report[E] { prog: => Unit / Exception[E] }: Unit =
+  try { prog() } with Exception[E] { def raise(exception: E, msg: String) = println(msg) }
+
+// ignores exceptions of (static) type E
+// TODO this should be called "ignore" but that name currently clashes with internal pattern matching names on $effekt
+def ignoring[E] { prog: => Unit / Exception[E] }: Unit =
+  try { prog() } with Exception[E] { def raise(exception: E, msg: String) = () }
+
+// Control Flow
+// ============
+interface Control {
+  def break(): Unit
+  def continue(): Unit
+}
+
+def loop { f: () => Unit / Control }: Unit = try {
+  def go(): Unit = { f(); go() }
+  go()
+} with Control {
+  def break() = ()
+  def continue() = loop { f }
+}
+
+/**
+ * Calls provided action repeatedly. `start` is inclusive, `end` is not.
+ */
+def each(start: Int, end: Int) { action: (Int) => Unit / Control } = {
+  var i = start;
+  loop {
+    if (i < end) { val el = i; i = i + 1; action(el) }
+    else { do break() }
+  }
+}
+
+def repeat(n: Int) { action: () => Unit / Control } = each(0, n) { n => action() }
+
+
+
+// Benchmarking
+// ============
+
+// runs the block and returns the time in nanoseconds
+def timed { block: => Unit }: Int = {
+  val before = timestamp()
+  block()
+  val after = timestamp()
+  1000 * (after - before)
+}
+
+def measure(warmup: Int, iterations: Int) { block: => Unit }: Unit = {
+  def run(n: Int, report: Boolean): Unit = {
+    if (n <= 0) { () } else {
+      val time = timed { block() };
+      if (report) { println(time) } else { () };
+      run(n - 1, report)
+    }
+  }
+  run(warmup, false)
+  run(iterations, true)
+}

package/libraries/ml/effekt.sml

@@ -0,0 +1,63 @@
+(* EVIDENCE *)
+fun lift m k1 k2 = m (fn a => k1 a k2);
+fun nested ev1 ev2 m = ev1 (ev2 m);
+fun here x = x;
+
+(* REGIONS *)
+(* type region = ((() -> () -> ()) list) ref *)
+fun newRegion () = ref nil
+fun backup cell = fn () => let val oldState = !cell in fn () => cell := oldState end
+fun fresh r init = let val cell = ref init in (r := (backup cell) :: (!r); cell) end
+fun withRegion body =
+    let val r = newRegion()
+        fun lift m k = let val fields = map (fn f => f()) (!r) in
+            m (fn a => (map (fn f => f()) fields; k a)) end
+    in body lift r end
+
+(* SHOW INSTANCES *)
+fun show'int x =
+    let val s = (Int.toString x) in
+    case String.sub (s, 0) of
+          #"~" => "-" ^ String.extract (s, 1, NONE)
+        | _ => s
+    end;
+
+(*
+To align with the js backend inf and nan is rewritten
+- `nan` -> `NaN`
+- `inf` -> `Infinity`
+- `~2.1` -> `-2.1`
+They do still disagree on the truncating of `2.0` to `2` (ml does not).
+*)
+fun show'real x =
+    let val s = (Real.toString x) in
+    case s of
+          "nan" => "NaN"
+        | "inf" => "Infinity"
+        | _ => case String.sub (s, 0) of
+              #"~" => "-" ^ String.extract (s, 1, NONE)
+            | _ => s
+    end;
+
+fun show'unit x = ""
+
+fun show'bool x = Bool.toString x
+
+fun show'string x = x
+
+(* TIMING *)
+val mlStartTime = Time.toMilliseconds (Time.now ());
+
+(* RANDOM *)
+fun mlRandomReal () =
+   let
+      val r = MLton.Random.rand ();
+      val rreal = MLton.Real.fromWord r;
+      val wsize = Real.fromInt Word.wordSize;
+      fun shiftRight r shift = r / (Math.pow(2.0, shift))
+   in
+      shiftRight rreal wsize
+   end;
+
+(* HOLES *)
+exception Hole

package/libraries/ml/immutable/dequeue.effekt

@@ -0,0 +1,81 @@
+module immutable/dequeue
+
+// An implementation of a functional dequeue, using Okasaki's
+// bankers dequeue implementation.
+//
+// Translation from the Haskell implementation:
+//   https://hackage.haskell.org/package/dequeue-0.1.12/docs/src/Data-Dequeue.html#Dequeue
+record Dequeue[R](front: List[R], frontSize: Int, rear: List[R], rearSize: Int)
+
+def emptyQueue[R](): Dequeue[R] = Dequeue(Nil(), 0, Nil(), 0)
+
+def isEmpty[R](dq: Dequeue[R]): Boolean = dq match {
+  case Dequeue(f, fs, r, rs) => (fs == 0) && (rs == 0)
+}
+
+def size[R](dq: Dequeue[R]): Int = dq match {
+  case Dequeue(f, fs, r, rs) => fs + rs
+}
+
+def first[R](dq: Dequeue[R]): Option[R] = dq match {
+  case Dequeue(f, fs, r, rs) =>
+    if ((fs == 0) && (rs == 1)) { r.headOption }
+    else { f.headOption }
+}
+
+def last[R](dq: Dequeue[R]): Option[R] = dq match {
+  case Dequeue(f, fs, r, rs) =>
+    if ((fs == 1) && (rs == 0)) { f.headOption }
+    else { r.headOption }
+}
+
+def check[R](dq: Dequeue[R]): Dequeue[R] = dq match {
+  case Dequeue(f, fs, r, rs) =>
+      val c = 4;
+      val size1 = (fs + rs) / 2;
+      val size2 = (fs + rs) - size1;
+
+      if (fs > c * rs + 1) {
+          val front = f.take(size1);
+          val rear = r.append(f.drop(size1).reverse);
+          Dequeue(front, size1, rear, size2)
+      } else if (rs > c * fs + 1) {
+          val front = f.append(r.drop(size1).reverse);
+          val rear = r.take(size1);
+          Dequeue(front, size2, rear, size1)
+      } else {
+          dq
+      }
+}
+
+def pushFront[R](dq: Dequeue[R], el: R): Dequeue[R] = dq match {
+  case Dequeue(f, fs, r, rs) => Dequeue(Cons(el, f), fs + 1, r, rs).check
+}
+
+def popFront[R](dq: Dequeue[R]): Option[(R, Dequeue[R])] = dq match {
+  case Dequeue(Nil(), fs, Cons(x, Nil()), rs) =>
+      Some((x, emptyQueue()))
+  case Dequeue(Nil(), fs, r, rs) =>
+      None()
+  case Dequeue(Cons(x, rest), fs, r, rs) =>
+      Some((x, Dequeue(rest, fs - 1, r, rs).check))
+}
+
+def pushBack[R](dq: Dequeue[R], el: R): Dequeue[R] = dq match {
+  case Dequeue(f, fs, r, rs) => Dequeue(f, fs, Cons(el, r), rs + 1).check
+}
+
+def popBack[R](dq: Dequeue[R]): Option[(R, Dequeue[R])] = dq match {
+  case Dequeue(Cons(x, Nil()), fs, Nil(), rs) =>
+      Some((x, emptyQueue()))
+  case Dequeue(f, fs, Nil(), rs) =>
+      None()
+  case Dequeue(f, fs, Cons(x, rest), rs) =>
+      Some((x, Dequeue(f, fs, rest, rs - 1).check))
+}
+
+def show[A](d: Dequeue[A]) { showA: A => String }: String = {
+  val Dequeue(front, frontSize, rear, rearSize) = d;
+  "Dequeue(" ++ show(front){showA} ++ ", " ++ show(frontSize) ++ ", " ++
+      show(rear){showA} ++ ", " ++ show(rearSize) ++ ")"
+}