@effekt-lang/effekt 0.2.1 → 0.2.2

package/libraries/chez/monadic/seq0.ss

@@ -0,0 +1,76 @@
+; [ [f1, f2, f3, f4| fields | prompt], [f1, f2, f3, f4| fields | prompt]... ]
+(define-record Stack (
+  [immutable frames]
+  [immutable arena]
+  [immutable prompt]))
+
+(define-record Substack (
+  [immutable frames]
+  [immutable arena]
+  [immutable field-backup]
+  [immutable prompt]))
+
+; MetaCont = (non-empty-list-of Stack)
+; SubCont = (non-empty-list-of Stack)
+
+
+; An Arena is a pointer to a list of cells
+(define (make-arena) (box '()))
+
+(define (fresh arena init)
+  (let* ([cell (box init)]
+         [cells (unbox arena)])
+    (set-box! arena (cons cell cells))
+    cell))
+
+; with-region { arena => ... }
+(define (with-region body)
+  (lambda (mk)
+    (let* ([stack (car mk)]
+           [arena (Stack-arena stack)])
+      ((body arena) mk))))
+
+; Backup = List<(Cell, Value)>
+
+; Arena -> Backup
+(define (backup arena)
+  (let ([fields (unbox arena)])
+    (map (lambda (cell) (cons cell (unbox cell))) fields)))
+
+; Backup -> ()
+(define (restore data)
+  (for-each (lambda (cell-data)
+    (set-box! (car cell-data) (cdr cell-data)))
+    data))
+
+; Prompt MetaCont -> SubCont, MetaCont
+(define (splitSeq p seq)
+  (define (split sub s)
+    (if (null? s)
+        (error 'splitSeq "prompt ~s not found on stack" p)
+        (let* ([stack (car s)]
+           [frames (Stack-frames stack)]
+           [arena (Stack-arena stack)]
+           [prompt (Stack-prompt stack)]
+           [rest  (cdr s)])
+          (define sub* (cons (make-Substack frames arena (backup arena) prompt) sub))
+          (if (not (eq? prompt p))
+            (split sub* rest)
+            (values sub* rest)))))
+  (split (list) seq))
+
+
+(define (appendSeq subcont meta)
+  (if (null? subcont)
+    meta
+    (let* ([stack (car subcont)]
+           [frames  (Substack-frames stack)]
+           [arena  (Substack-arena stack)]
+           [fields (Substack-field-backup stack)]
+           [prompt (Substack-prompt stack)]
+           [_ (restore fields)]
+           [rest  (cdr subcont)])
+      (appendSeq rest (cons (make-Stack frames arena prompt) meta)))))
+
+; (define ex (list (make-Stack '(1 2 3) (list (box 1)) 4) (make-Stack '(1 2 3) (list (box 2)) 3) (make-Stack '(1 2 3) (list (box 3)) 2) (make-Stack '(4 5 6) (list (box 4)) 1)))
+; (let-values ([(cont meta) (splitSeq 2 ex)]) (appendSeq cont meta))

package/libraries/js/effekt.effekt

@@ -0,0 +1,284 @@
+module effekt
+
+// Runtime
+// TODO split runtime into monadic and direct
+extern include "effekt_runtime.js"
+
+// Builtins
+extern include "effekt_builtins.js"
+
+def locally[R] { f: => R }: R = f()
+
+// Side effecting ops
+// ==================
+extern io def println[R](value: R): Unit =
+  "println$impl(${value})"
+
+extern io def inspect[R](value: R): Unit =
+  "console.log(${value})"
+
+extern io def random(): Double =
+  "Math.random()"
+
+extern io def timestamp(): Int =
+  "Date.now()"
+
+// References and state
+// ====================
+// the following type is defined in builtins.scala
+// interface Ref[T] { def get(): T; def put(t: T): Unit }
+extern io def freshIn[T](t: T) {r: Region}: Ref[T] at {r} = "r.fresh(${t})"
+extern io def freshGlobal[T](t: T): Ref[T] at {global} = "$effekt.fresh(${t})"
+
+// String ops
+// ==========
+extern pure def show[R](value: R): String =
+  "show$impl(${value})"
+
+extern pure def infixConcat(s1: String, s2: String): String =
+  "${s1} + ${s2}"
+
+// Math ops
+// ========
+extern pure def infixAdd(x: Int, y: Int): Int =
+  "(${x} + ${y})"
+
+extern pure def infixMul(x: Int, y: Int): Int =
+  "(${x} * ${y})"
+
+extern pure def infixDiv(x: Int, y: Int): Int =
+  "Math.floor(${x} / ${y})"
+
+extern pure def infixSub(x: Int, y: Int): Int =
+  "(${x} - ${y})"
+
+extern pure def mod(x: Int, y: Int): Int =
+  "(${x} % ${y})"
+
+extern pure def infixAdd(x: Double, y: Double): Double =
+  "(${x} + ${y})"
+
+extern pure def infixMul(x: Double, y: Double): Double =
+  "(${x} * ${y})"
+
+extern pure def infixSub(x: Double, y: Double): Double =
+  "(${x} - ${y})"
+
+extern pure def infixDiv(x: Double, y: Double): Double =
+  "(${x} / ${y})"
+
+
+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} * ${x})"
+
+extern pure def log(x: Double): Double =
+  "Math.log(${x})"
+
+extern pure def log1p(x: Double): Double =
+  "Math.log1p(${x})"
+
+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 =
+  "Math.round(${d})"
+
+extern pure def toDouble(d: Int): Double =
+  "${d}"
+
+extern pure def floor(d: Double): Int =
+  "Math.floor(${d})"
+
+extern pure def ceil(d: Double): Int =
+  "Math.ceil(${d})"
+
+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
+
+// Comparison ops
+// ==============
+extern pure def infixEq[R](x: R, y: R): Boolean =
+  "equals$impl(${x}, ${y})"
+
+extern pure def infixNeq[R](x: R, y: R): Boolean =
+  "!equals$impl(${x}, ${y})"
+
+extern pure def infixLt(x: Int, y: Int): Boolean =
+  "(${x} < ${y})"
+
+extern pure def infixLte(x: Int, y: Int): Boolean =
+  "(${x} <= ${y})"
+
+extern pure def infixGt(x: Int, y: Int): Boolean =
+  "(${x} > ${y})"
+
+extern pure def infixGte(x: Int, y: Int): Boolean =
+  "(${x} >= ${y})"
+
+extern pure def infixLt(x: Double, y: Double): Boolean =
+  "(${x} < ${y})"
+
+extern pure def infixLte(x: Double, y: Double): Boolean =
+  "(${x} <= ${y})"
+
+extern pure def infixGt(x: Double, y: Double): Boolean =
+  "(${x} > ${y})"
+
+extern pure def infixGte(x: Double, y: Double): Boolean =
+  "(${x} >= ${y})"
+
+extern pure def infixLt(x: String, y: String): Boolean =
+  "(${x} < ${y})"
+
+extern pure def infixLte(x: String, y: String): Boolean =
+  "(${x} <= ${y})"
+
+extern pure def infixGt(x: String, y: String): Boolean =
+  "(${x} > ${y})"
+
+extern pure def infixGte(x: String, y: String): Boolean =
+  "(${x} >= ${y})"
+
+// Boolean ops
+// ===========
+// for now those are considered eager
+extern pure def not(b: Boolean): Boolean =
+  "!${b}"
+
+extern pure def infixOr(x: Boolean, y: Boolean): Boolean =
+  "(${x} || ${y})"
+
+extern pure def infixAnd(x: Boolean, y: Boolean): Boolean =
+  "(${x} && ${y})"
+
+// Undefined and Null
+// ==================
+// Should only be used for interop with JS, since values in Effekt should not be undefined
+
+// Is something an undefined JavaScript value?
+extern pure def isUndefined[A](value: A): Boolean =
+  "(${value} === undefined)"
+
+// Is something a JavaScript null value?
+extern pure def isNull[A](value: A): Boolean =
+  "(${value} === null)"
+
+// 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 =
+  "(function() { throw ${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
+// ============
+
+// Current time in nanoseconds
+// TODO use a better timer
+extern control def currentTimeNanos(): Int =
+  "$effekt.delayed(() => new Date().getTime() * 1000000)"
+
+extern io def setTimeout(callback: () => Unit at {}, timeout: Int): Unit =
+  "(function() { window.setTimeout(() => ${callback}().run(), ${timeout}); return $effekt.unit; })()"
+
+// runs the block and returns the time in nanoseconds
+def timed { block: => Unit }: Int = {
+  val before = currentTimeNanos()
+  block()
+  val after = currentTimeNanos()
+  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/js/effekt_builtins.js

@@ -0,0 +1,26 @@
+function show$impl(obj) {
+  if (!!obj && !!obj.__reflect) {
+    const meta = obj.__reflect()
+    return meta.__name + "(" + meta.__data.map(show$impl).join(", ") + ")"
+  }
+  else if (!!obj && obj.__unit) {
+    return "()";
+  } else {
+    return "" + obj;
+  }
+}
+
+function equals$impl(obj1, obj2) {
+  if (!!obj1.__equals) {
+    return obj1.__equals(obj2)
+  } else {
+    return (obj1.__unit && obj2.__unit) || (obj1 === obj2);
+  }
+}
+
+function println$impl(obj) {
+  //return $effekt.delayed(() => { console.log(show(obj)); return $effekt.unit; });
+  console.log(show$impl(obj)); return $effekt.unit;
+}
+
+$effekt.unit = { __unit: true }

package/libraries/js/effekt_matching.js

@@ -0,0 +1,79 @@
+// matchers: Any -> List[Any] | null
+const $matching = (function() {
+
+    const any = x => [x]
+
+    const ignore = x => []
+
+    const bind = matcher => x => {
+        const matched = matcher(x)
+        if (matched == null) return null;
+        return [x].concat(matched)
+    }
+
+    const literal = c => x => {
+        if (equals$impl(c, x))
+            return []
+        else
+            return null
+    }
+
+    function tagged(tag) {
+        const matchers = arguments
+        return x => {
+            if (!x || !x.__tag || x.__tag !== tag) return null;
+            var extracted = [];
+            // we start at 1 since matchers are shifted by 1
+            for (var i = 1; i < matchers.length; i++) {
+                const matched = matchers[i](x.__data[i - 1]);
+                if (matched === null) return null;
+                Array.prototype.push.apply(extracted, matched)
+            }
+            return extracted;
+        }
+    }
+
+    function match(x, alternatives) {
+        for (var i in alternatives) {
+            const alt = alternatives[i]
+            const matched = alt.pattern(x)
+            if (matched !== null) {
+                return alt.exec.apply(null, matched)
+            }
+        }
+    }
+
+    return {
+        any: any,
+        ignore: ignore,
+        tagged: tagged,
+        bind: bind,
+        literal: literal,
+        match: match
+    }
+})();
+
+Object.assign($effekt, $matching);
+
+
+// p0 = bind(tagged("Nil"))
+// p1 = bind(tagged("Cons", any, any))
+// p2 = tagged("Cons", any, bind(tagged("Cons", any, ignore)))
+
+// l0 = { tag: "Nil", data: [] }
+// l1 = { tag: "Cons", data: [1, l0] }
+// l2 = { tag: "Cons", data: [1, { tag: "Cons", data: [2, { tag: "Nil", data: [] }] }] }
+
+// console.log(p1(l0))
+// console.log(p1(l1))
+// console.log(p1(l2))
+
+// console.log(p2(l0))
+// console.log(p2(l1))
+// console.log(p2(l2))
+
+// match(l2, [
+//     { pattern: p0, exec: () => console.log("It is Nil!") },
+//     { pattern: p2, exec: (x, y) => console.log("It has at least two elements", x, y) },
+//     { pattern: p1, exec: (x, rest) => console.log("It only has one element", x) }
+// ])