@effekt-lang/effekt 0.2.2 → 0.4.0

package/libraries/chez/common/io/args.effekt

@@ -1,20 +0,0 @@
-module io/args
-
-import effekt
-import immutable/option
-import immutable/cslist
-import immutable/list
-
-
-// ================================================
-//
-// Conceptual Public Functions:
-//   - commandLineArgs(): List[String]
-//
-// ================================================
-
-// Arguments passed to the script, first one is the file name itself, which we ignore.
-extern io def nativeArgs(): CSList[String] =
-  "(cdr (command-line))"
-
-def commandLineArgs(): List[String] = nativeArgs().fromChez

package/libraries/chez/common/mutable/array.effekt

@@ -1,27 +0,0 @@
-module mutable/array
-
-import immutable/option
-import immutable/cslist
-
-// a mutable array backed by a scheme vector
-extern type Array[T]
-
-extern pure def emptyArray[T](size: Int): Array[T] =
-  "(make-vector ${size})"
-
-def get[T](arr: Array[T], index: Int): Option[T] =
-  if (index >= arr.size) None() else Some(arr.unsafeGet(index))
-
-extern pure def size[T](arr: Array[T]): Int =
-  "(vector-length ${arr})"
-
-// raises a scheme exception if out of bounds
-extern pure def unsafeGet[T](arr: Array[T], index: Int): T =
-  "(vector-ref ${arr} ${index})"
-
-// TODO raises a scheme exception if out of bounds
-extern io def put[T](arr: Array[T], index: Int, value: T): Unit =
-  "(begin (vector-set! ${arr} ${index} ${value}) #f)"
-
-extern pure def toArray[A](l: CSList[A]): Array[A] =
-  "(list->vector ${l})"

package/libraries/chez/common/mutable/heap.effekt

@@ -1,12 +0,0 @@
-module mutable/heap
-
-extern type Ref[T]
-
-extern io def fresh[T](init: T): Ref[T] =
-    "(box ${init})"
-
-extern io def put[T](ref: Ref[T], value: T): Unit =
-    "(set-box! ${ref} ${value})"
-
-extern io def get[T](ref: Ref[T]): T =
-    "(unbox ${ref})"

package/libraries/chez/common/test.effekt

@@ -1,59 +0,0 @@
-import text/string
-
-interface Assertion {
-  def assert(condition: Boolean, msg: String): Unit
-}
-
-def assertTrue(condition: Boolean, msg: String) =
-  do assert(condition, msg)
-
-def assertTrue(condition: Boolean) =
-  do assert(condition, "Assertion failed")
-
-def assertFalse(condition: Boolean, msg: String) =
-  do assert(not(condition), msg)
-
-def assertFalse(condition: Boolean) =
-  do assert(not(condition), "Assertion failed")
-
-def assertEqual[A](obtained: A, expected: A, msg: String) =
-  do assert(obtained == expected, msg)
-
-def assertEqual[A](obtained: A, expected: A) =
-  do assert(obtained == expected, "Obtained: " ++ obtained.show ++ "\n but expected:" ++ expected.show)
-
-interface Test {
-  def success(name: String): Unit
-  def failure(name: String, msg: String): 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)
-  }
-
-def suite(name: String) { body: => Unit / Test }: Boolean = {
-  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(())
-    }
-  }
-  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
-  }
-}

package/libraries/chez/common/text/string.effekt

@@ -1,46 +0,0 @@
-module text/string
-
-import immutable/option
-
-// def charAt(str: String, index: Int): Option[String] =
-//     str.unsafeCharAt(index).undefinedToOption
-
-extern pure def length(str: String): Int =
-  "(string-length ${str})"
-
-extern pure def repeat(str: String, n: Int): String =
-  "(letrec ([repeat (lambda (${n} acc) (if (<= ${n} 0) acc (repeat (- ${n} 1) (string-append acc ${str}))))]) (repeat ${n} (list->string '())))"
-
-extern pure def unsafeSubstring(str: String, from: Int, to: Int): String =
-  "(substring ${str} ${from} ${to})"
-
-def substring(str: String, from: Int, to: Int): String = {
-  def clamp(lower: Int, x: Int, upper: Int) = max(lower, min(x, upper))
-
-  val len = str.length
-  val clampedTo = clamp(0, to, len)
-  val clampedFrom = clamp(0, from, to)
-
-  str.unsafeSubstring(clampedFrom, clampedTo)
-}
-
-def substring(str: String, from: Int): String =
-  str.substring(from, str.length)
-
-// extern pure def trim(str: String): String =
-//   "str.trim()"
-
-def toInt(str: String): Option[Int] =
-  str.unsafeToInt.undefinedToOption
-
-// extern pure def unsafeCharAt(str: String, n: Int): String =
-//   "str[n]"
-
-// returns #f if not a number
-extern pure def unsafeToInt(str: String): Int =
-  "(string->number ${str})"
-
-// ANSI escape codes
-val ANSI_GREEN = "\033[32m"
-val ANSI_RED = "\033[31m"
-val ANSI_RESET = "\033[0m"

package/libraries/chez/lift/effekt.effekt

@@ -1,217 +0,0 @@
-module effekt
-
-extern include "../common/effekt_primitives.ss"
-extern include "effekt.ss"
-extern include "../common/effekt_matching.ss"
-
-
-def locally[R] { f: => R }: R = f()
-
-// String ops
-// ==========
-extern pure def infixConcat(s1: String, s2: String): String =
-  "(string-append ${s1} ${s2})"
-
-// TODO implement
-extern pure def show[R](value: R): String =
-  "(show_impl ${value})"
-
-extern io def println[R](r: R): Unit =
-  "(println_impl ${r})"
-
-extern io def error[R](msg: String): R =
-  "(raise ${msg})"
-
-extern io def random(): Double =
-  "(random 1.0)"
-
-// 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 =
-  "(floor (/ ${x} ${y}))"
-
-extern pure def infixSub(x: Int, y: Int): Int =
-  "(- ${x} ${y})"
-
-extern pure def mod(x: Int, y: Int): Int =
-  "(modulo ${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 infixDiv(x: Double, y: Double): Double =
-  "(/ ${x} ${y})"
-
-extern pure def infixSub(x: Double, y: Double): Double =
-  "(- ${x} ${y})"
-
-extern pure def cos(x: Double): Double =
-  "(cos ${x})"
-
-extern pure def sin(x: Double): Double =
-  "(sin ${x})"
-
-extern pure def atan(x: Double): Double =
-  "(atan ${x})"
-
-extern pure def tan(x: Double): Double =
-  "(tan ${x})"
-
-extern pure def sqrt(x: Double): Double =
-  "(sqrt ${x})"
-
-extern pure def square(x: Double): Double =
-  "(* x ${x})"
-
-extern pure def log(x: Double): Double =
-  "(log ${x})"
-
-extern pure def log1p(x: Double): Double =
-  "(log (+ ${x} 1))"
-
-extern pure def exp(x: Double): Double =
-  "(exp ${x})"
-
-// since we do not have "extern val", yet
-extern pure def _pi(): Double =
-  "(* 4 (atan 1))"
-
-val PI: Double = _pi()
-
-extern pure def toInt(d: Double): Int =
-  "(round ${d})"
-
-extern pure def toDouble(d: Int): Double =
-  "${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 =
-  "(equal_impl ${x} ${y})"
-
-extern pure def infixNeq[R](x: R, y: R): Boolean =
-  "(not (equal_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})"
-
-// Boolean ops
-// ===========
-// for now those are considered eager
-extern pure def not(b: Boolean): Boolean =
-  "(not ${b})"
-
-extern pure def infixOr(x: Boolean, y: Boolean): Boolean =
-  "(or ${x} ${y})"
-
-extern pure def infixAnd(x: Boolean, y: Boolean): Boolean =
-  "(and ${x} ${y})"
-
-// Should only be used internally since values in Effekt should not be undefined
-extern pure def isUndefined[A](value: A): Boolean =
-  "(eq? ${value} #f)"
-
-// 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 ${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
-// ============
-// should only be used with pure blocks
-extern control def measure(warmup: Int, iterations: Int) { block: => Unit }: Unit =
-  "(delayed (display (measure (lambda () (run ((${box block} here)))) ${warmup} ${iterations})))"

package/libraries/chez/lift/effekt.ss

@@ -1,118 +0,0 @@
-(define-syntax delayed
-  (syntax-rules ()
-    [(_ e ...)
-      (lambda (k) (k
-        (begin e ...)))]))
-
-
-;; EVIDENCE
-
-(define (here x) x)
-
-; (define-syntax lift
-;   (syntax-rules ()
-;     [(_ m)
-;      (lambda (k1)
-;        (lambda (k2)
-;          (m (lambda (a) ((k1 a) k2)))))]))
-
-(define (lift m)
-  (lambda (k1)
-    (lambda (k2)
-      (m (lambda (a) ((k1 a) k2))))))
-
-(define-syntax nested-helper
-  (syntax-rules ()
-    [(_ (ev) acc) (ev acc)]
-    [(_ (ev1 ev2 ...) acc)
-      (nested-helper (ev2 ...) (ev1 acc))]))
-
-(define-syntax nested
-  (syntax-rules ()
-    [(_ ev1 ...) (lambda (m) (nested-helper (ev1 ...) m))]))
-
-
-;; HANDLING
-
-; (define (reset m) (m (lambda (v) (lambda (k) (k v)))))
-
-(define-syntax reset
-  (syntax-rules ()
-    [(_ m)
-     (m (lambda (v) (lambda (k) (k v))))]))
-
-; ;; EXAMPLE
-; ; (handle ([Fail_22 (Fail_109 () resume_120 (Nil_74))])
-; ;       (let ((tmp86_121 ((Fail_109  Fail_22))))
-; ;         (Cons_73  tmp86_121  (Nil_74))))
-
-
-; capabilities first take evidence than require selection!
-(define-syntax handle
-  (syntax-rules ()
-    [(_ (cap1 ...) body)
-     (reset (body lift cap1 ...))]))
-
-
-(define-syntax shift
-  (syntax-rules ()
-    [(_ ev body)
-     (ev body)]))
-
-; capabilities first take evidence than require selection!
-(define-syntax handle-old
-  (syntax-rules ()
-    [(_ ((cap1 (op1 (arg1 ...) kid exp) ...) ...) body)
-     (reset (body lift
-       (cap1 (define-effect-op ev (arg1 ...) kid exp) ...) ...))]))
-
-(define-syntax define-effect-op
-  (syntax-rules ()
-    [(_ ev1 (arg1 ...) kid exp ...)
-     (lambda (ev1 arg1 ...)
-        ; we apply the outer evidence to the body of the operation
-        (ev1 (lambda (resume)
-          ; k itself also gets evidence!
-          (let ([kid (lambda (ev v) (ev (resume v)))])
-            exp ...))))]))
-
-(define (with-region-non-mono body)
-  (define arena (make-arena))
-
-  (define (lift m) (lambda (k)
-    ; on suspend
-    (define fields (backup arena))
-    (m (lambda (a)
-      ; on resume
-      (restore fields)
-      (k a)))))
-
-  (body lift arena))
-
-(define (with-region body)
-  (define arena (make-arena))
-
-  (body arena))
-
-
-; 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))
-
-; 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))