@ironm00n/pyret-lang 0.0.1 → 0.0.3

package/examples/heap.arr

@@ -1,275 +0,0 @@
-#lang pyret
-
-# An implementation of binomial heaps.
-
-provide {
-  heap: list-to-heap,
-  hempty: bh-empty,
-  merge: merge,
-  insert: insert,
-  peek: peek,
-  remove-min: remove-min,
-  heap-to-list: heap-to-list
-} end
-
-provide-types {
-  BinomialHeap :: BinomialHeap
-}
-
-import valueskeleton as VS
-
-data BinomialTree<a>:
-  | bt-node(val :: a, children :: List<BinomialTree<a>>)
-end
-
-data TaggedTree<a>:
-  | tt(carry-order :: Number, tree :: BinomialTree<a>)
-end
-
-data BinomialHeap<a>:
-  | bh-empty
-  | bh-link(carry-order :: Number, tree :: BinomialTree<a>, next :: BinomialHeap<a>)
-sharing:
-  method merge(self, other): merge(self, other) end,
-  method insert(self, val): insert(self, val) end,
-  method peek(self): peek(self) end,
-  method remove-min(self): remove-min(self) end,
-
-  method to-list(self): heap-to-list(self) end,
-  method _output(self): VS.vs-constr("heap", self.to-list()) end,
-  method _equals(self, other, eq): eq(heap-to-list(self), heap-to-list(other)) end,
-  method _plus(self, other): merge(self, other) end
-end
-
-fun merge<a>(lbh :: BinomialHeap<a>, rbh :: BinomialHeap<a>) -> BinomialHeap<a>:
-  doc: "Merge two binomial heaps"
-  fun merge-same-size(l, r):
-    if l.val < r.val:
-      bt-node(l.val, link(r, l.children))
-    else:
-      bt-node(r.val, link(l, r.children))
-    end
-  end
-  fun merge-without-carry(l, r):
-    cases(BinomialHeap) l:
-      | bh-empty => r
-      | bh-link(lorder, ltree, lnext) =>
-        cases(BinomialHeap) r:
-          | bh-empty => l
-          | bh-link(rorder, rtree, rnext) =>
-            if lorder < rorder:
-              bh-link(lorder, ltree, merge-without-carry(lnext, r))
-            else if lorder > rorder:
-              bh-link(rorder, rtree, merge-without-carry(l, rnext))
-            else:
-              merge-with-carry(lnext, rnext, tt(lorder + 1, merge-same-size(ltree, rtree)))
-            end
-        end
-    end
-  end
-  fun merge-with-carry(l, r, c):
-    cases(BinomialHeap) l:
-      | bh-empty => merge-without-carry(bh-link(c.carry-order, c.tree, bh-empty), r)
-      | bh-link(lorder, ltree, lnext) =>
-        cases(BinomialHeap) r:
-          | bh-empty => merge-without-carry(l, bh-link(c.carry-order, c.tree, bh-empty))
-          | bh-link(rorder, rtree, rnext) =>
-            block:
-              when (c.carry-order > lorder) or (c.carry-order > rorder):
-                raise("Carry order too high in merge!")
-              end
-              if lorder < rorder:
-                if c.carry-order < lorder:
-                  bh-link(c.carry-order, c.tree, bh-link(lorder, ltree, merge-without-carry(lnext, r)))
-                else:
-                  merge-with-carry(lnext, r, tt(lorder + 1, merge-same-size(c.tree, ltree)))
-                end
-              else if lorder > rorder:
-                if c.carry-order < rorder:
-                  bh-link(c.carry-order, c.tree, bh-link(rorder, rtree, merge-without-carry(l, rnext)))
-                else:
-                  merge-with-carry(l, rnext, tt(rorder + 1, merge-same-size(c.tree, rtree)))
-                end
-              else:
-                bh-link(c.carry-order, c.tree,
-                        merge-with-carry(lnext, rnext, tt(lorder + 1, merge-same-size(ltree, rtree))))
-              end
-            end
-        end
-    end
-  end
-  merge-without-carry(lbh, rbh)
-where:
-  merge(bh-empty, bh-empty) is bh-empty
-  merge(bh-empty, bh-link(0, bt-node(10, [list: ]), bh-empty))
-    is bh-link(0, bt-node(10, [list: ]), bh-empty)
-  merge(bh-link(0, bt-node(10, [list: ]), bh-empty), bh-empty)
-    is bh-link(0, bt-node(10, [list: ]), bh-empty)
-  merge(bh-link(0, bt-node(10, [list: ]), bh-empty),
-        bh-link(0, bt-node(20, [list: ]), bh-empty))
-    is bh-link(1, bt-node(10, [list: bt-node(20, [list: ])]), bh-empty)
-  merge(bh-link(0, bt-node(20, [list: ]), bh-empty),
-        bh-link(0, bt-node(10, [list: ]), bh-empty))
-    is bh-link(1, bt-node(10, [list: bt-node(20, [list: ])]), bh-empty)
-  merge(bh-link(0, bt-node(10, [list: ]), bh-empty),
-        bh-link(1, bt-node(20, [list: bt-node(30, [list: ])]), bh-empty))
-    is bh-link(0, bt-node(10, [list: ]),
-               bh-link(1, bt-node(20, [list: bt-node(30, [list: ])]), bh-empty))
-  merge(bh-link(1, bt-node(10, [list: bt-node(40, [list: ])]), bh-empty),
-        bh-link(1, bt-node(20, [list: bt-node(30, [list: ])]), bh-empty))
-    is bh-link(2, bt-node(10, [list: bt-node(20, [list: bt-node(30, [list: ])]),
-                               bt-node(40, [list: ])]), bh-empty)
-end
-
-fun insert<a>(bh :: BinomialHeap<a>, val :: a) -> BinomialHeap<a>:
-  merge(bh, bh-link(0, bt-node(val, [list: ]), bh-empty))
-where:
-  bh-empty ^ insert(_, 10) is bh-link(0, bt-node(10, [list: ]), bh-empty)
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-    is bh-link(0, bt-node(15, [list: ]),
-               bh-link(1, bt-node(10, [list: bt-node(20, [list: ])]), bh-empty))
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-    is bh-link(1, bt-node(25, [list: bt-node(30, [list: ])]),
-               bh-link(2, bt-node(10, [list: bt-node(15, [list: bt-node(40, [list: ])]),
-                                       bt-node(20, [list: ])]),
-                       bh-empty))
-end
-
-fun peek<a>(bh :: BinomialHeap<a>):
-  fun peek-tree(h, min):
-    cases(BinomialHeap) h:
-      | bh-empty => min
-      | bh-link(_, tree, next) =>
-        peek-tree(next, if tree.val < min: tree.val else: min end)
-    end
-  end
-  cases(BinomialHeap) bh:
-    | bh-empty => raise("peek on empty heap")
-    | bh-link(_, tree, next) => peek-tree(next, tree.val)
-  end
-where:
-  bh-empty ^ peek(_) raises "peek"
-  bh-empty ^ insert(_, 10) ^ peek(_) is 10
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15) ^ peek(_) is 10
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25) ^ peek(_)
-    is 10
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ insert(_, -5) ^ insert(_, 45) ^ insert(_, 0) ^ peek(_)
-    is -5
-end
-
-fun remove-min<a>(bh :: BinomialHeap<a>) -> BinomialHeap<a>:
-  fun find-tree(h, min-h):
-    cases(BinomialHeap) h:
-      | bh-empty => min-h
-      | bh-link(_, tree, next) =>
-        find-tree(next, if tree.val < min-h.tree.val: h else: min-h end)
-    end
-  end
-  fun remove-tree(h, target-ord):
-    cases(BinomialHeap) h:
-      | bh-empty => bh-empty
-      | bh-link(carry-order, tree, next) =>
-        if target-ord == carry-order:
-          next
-        else:
-          bh-link(carry-order, tree, remove-tree(next, target-ord))
-        end
-    end
-  end
-  cases(BinomialHeap) bh:
-    | bh-empty => raise("remove-min on empty heap")
-    | bh-link(_, _, _) =>
-      least-link = find-tree(bh, bh)
-      if least-link.carry-order == 0:
-        least-link.next
-      else:
-        without-least = remove-tree(bh, least-link.carry-order)
-        new-heap = for fold2(h from bh-empty,
-                             t from least-link.tree.children,
-                             o from range-by(least-link.carry-order - 1, -1, -1)):
-          bh-link(o, t, h)
-        end
-        merge(new-heap, without-least)
-      end
-  end
-where:
-  bh-empty ^ remove-min(_) raises "remove-min"
-  bh-empty ^ insert(_, 10) ^ remove-min(_) ^ peek(_) raises "peek"
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15) ^ remove-min(_) ^ peek(_) is 15
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ remove-min(_) ^ peek(_)
-    is 15
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ insert(_, -5) ^ insert(_, 45) ^ insert(_, 0)
-           ^ remove-min(_) ^ peek(_)
-    is 0
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ remove-min(_) ^ remove-min(_)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ remove-min(_) ^ peek(_)
-    is 25
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ remove-min(_)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ remove-min(_) ^ remove-min(_)
-           ^ insert(_, -5) ^ insert(_, 45) ^ insert(_, 0)
-           ^ remove-min(_) ^ remove-min(_) ^ peek(_)
-    is 25
-end
-
-fun heap-to-list<a>(bh :: BinomialHeap<a>) -> List<a>:
-  cases(BinomialHeap) bh:
-    | bh-empty => empty
-    | bh-link(_, _, _) => link(peek(bh), heap-to-list(remove-min(bh)))
-  end
-where:
-  bh-empty ^ heap-to-list(_) is [list: ]
-  bh-empty ^ insert(_, 10) ^ heap-to-list(_) is [list: 10]
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15) ^ heap-to-list(_)
-    is [list: 10, 15, 20]
-  bh-empty ^ insert(_, 10) ^ remove-min(_) ^ heap-to-list(_) is [list: ]
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15) ^ remove-min(_) ^ heap-to-list(_)
-    is [list: 15, 20]
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ remove-min(_) ^ heap-to-list(_)
-    is [list: 15, 20, 25, 30, 40]
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ insert(_, -5) ^ insert(_, 45) ^ insert(_, 0)
-           ^ remove-min(_) ^ heap-to-list(_)
-    is [list: 0, 10, 15, 20, 25, 30, 40, 45]
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ remove-min(_) ^ remove-min(_)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ remove-min(_) ^ heap-to-list(_)
-    is [list: 25, 30, 40]
-  bh-empty ^ insert(_, 10) ^ insert(_, 20) ^ insert(_, 15)
-           ^ remove-min(_)
-           ^ insert(_, 40) ^ insert(_, 30) ^ insert(_, 25)
-           ^ remove-min(_) ^ remove-min(_)
-           ^ insert(_, -5) ^ insert(_, 45) ^ insert(_, 0)
-           ^ remove-min(_) ^ remove-min(_) ^ heap-to-list(_)
-    is [list: 25, 30, 40, 45]
-end
-
-fun list-to-heap<a>(lst :: List<a>) -> BinomialHeap<a>:
-  fold(insert, bh-empty, lst)
-where:
-  fun check-compose(l):
-    l.sort() == (l ^ list-to-heap(_) ^ heap-to-list(_))
-  end
-
-  [list: ] satisfies check-compose
-  [list: 1] satisfies check-compose
-  [list: 1,2] satisfies check-compose
-  [list: 2,1] satisfies check-compose
-  [list: 4,2,3,1] satisfies check-compose
-  [list: 1,5,1,3,4] satisfies check-compose
-end

package/examples/htdp/arithmetic.arr

@@ -1,6 +0,0 @@
-#lang pyret
-
-2 + 2
-3 * 3
-4 - 2
-6 / 2

package/examples/htdp/boolean.arr

@@ -1,11 +0,0 @@
-#lang pyret
-
-true and true
-true and false
-true or false
-false or false
-not(false)
-
-((string-length("hello world") == string-to-number("11").or-else("failed"))
-  or ("hello world" == "good morning"))
- and ((string-length("hello world") + 60) >= 80)

package/examples/htdp/conversions.arr

@@ -1,7 +0,0 @@
-#lang pyret
-
-check:
-  to-string(5) is "5"
-  string-to-number("5") is some(5)
-  string-to-number("asdf") is none
-end

package/examples/htdp/def.arr

@@ -1,9 +0,0 @@
-#lang pyret
-
-fun y(x): x * x end
-
-y(1)
-y(2)
-y(3)
-y(4)
-y(5)

package/examples/htdp/more-arithmetic.arr

@@ -1,14 +0,0 @@
-#lang pyret
-
-pi = 3.14159
-
-num-sqr(3)
-num-expt(2,3)
-num-sin(0)
-num-cos(pi)
-
-2 < 1
-2 < 3
-5 <= 5
-4 > 20
-7 >= 8

package/examples/htdp/string.arr

@@ -1,10 +0,0 @@
-#lang pyret
-
-string-append("hello", "world")
-string-append("hello ", "world")
-string-append("hell", "o world")
-
-string-length("hello world") + 20
-
-"hello world" == "hello"
-"hello world" == "hello world"

package/examples/htdp/struct.arr

@@ -1,23 +0,0 @@
-#lang pyret
-
-data NumList:
-  | mt()
-  | cons(first :: Number, rest :: NumList)
-end
-
-mt()
-cons(4,mt())
-
-fun length(l :: NumList) -> Number:
-  cases(NumList) l:
-    | cons(_, rest) => 1 + length(rest)
-    | mt() => 0
-  end
-where:
-  length(cons(4,mt())) is 1
-  length(cons(4,cons(3,mt()))) is 2
-  length(mt()) is 0
-end
-
-#print("should be: runtime typecheck failed")
-#length({first: {}, rest: {}})

package/examples/htdp/types.arr

@@ -1,15 +0,0 @@
-#lang pyret
-
-five :: Number = 5
-s :: String = "hello"
-b :: Boolean = true
-o :: {x :: Number} = {x:10}
-
-# this function can never run successfully
-fun bar(x :: Number) -> Number: "hello" end
-#bar(10)
-
-# this function will fail on non string input
-fun baz(x :: String): x end
-baz("hello")
-#baz(10)

package/examples/loop.arr

@@ -1,112 +0,0 @@
-#lang pyret
-
-# It's very easy to write functions that can use for-syntax effectively.
-# This function, when used in a for expression, approximates a for loop
-# in languages like C and Java.
-#
-# Think of it as a generalized "each" function, but where the elements
-# are not retrieved from a list in sequence but are generated by
-# repeated applications of a function. The function each-loop in the tests
-# shows that it is simple to build "each" from this.
-fun loop(f, i :: { init :: Any, test :: (Any -> Boolean), next :: (Any -> Any) }) -> Nothing:
-  doc: "A C-like loop construct."
-  if i.test(i.init) block:
-    f(i.init)
-    loop(f, i.{ init: i.next(i.init) })
-  else:
-    nothing
-  end
-where:
-  var sum = 0
-  loop(lam(i): sum := sum + i end, { init: 0, test: _ < 10, next: _ + 1 })
-  sum is 45
-
-  sum := 0
-  for loop(i from { init: 0, test: _ < 10, next: _ + 1 }):
-    sum := sum + i
-  end
-  sum is 45
-
-  sum := 0
-  for loop(i from { init: 0, test: _ < -5, next: _ + 1 }):
-    sum := sum + i
-  end
-  sum is 0
-
-  sum := 0
-  for loop(i from { init: 0, test: _ < 10,
-                    next: lam(x): if num-modulo(x, 2) == 0: x + 1 else: 2 * x end end }):
-    sum := sum + i
-  end
-  sum is 19
-
-  fun each-loop(f, lst):
-    loop(f, { init: lst, test: is-link, next: _.rest })
-  end
-  for loop(i from { init: 10, test: _ < 20, next: _ + 1 }) block:
-    sum := 0
-    nums = range(0, i)
-    for each(elt from nums):
-      sum := sum + i
-    end
-    cur-total = sum
-    sum := 0
-    for each-loop(elt from nums):
-      sum := sum + i
-    end
-    sum is cur-total
-  end
-end
-
-# Implementation of Pollard's rho algorithm for factoring numbers
-fun gcd(a, b):
-  doc: "Calculates the greatest common divisor of a and b using Euclid's algorithm."
-  if b == 0: a else: gcd(b, num-modulo(a, b)) end
-end
-
-fun pollard-rho(n :: Number) -> Option block:
-  doc: "Attempts to factor the given number using Pollard's rho algorithm."
-  fun f-m(m):
-    lam(x): num-modulo(((x * x) + m), n) end
-  end
-  var factor = none
-  for loop(fs from { init: map(f-m, [list: -1,2,-3]),
-                     test: lam(fs): is-none(factor) and is-link(fs) end,
-                     next: _.rest }) block:
-    f = fs.first
-    var x = 2
-    var y = 2
-    var d = 1
-    for loop(i from { init: nothing,
-                      test: lam(_): d == 1 end,
-                      next: lam(_): nothing end }) block:
-      x := f(x)
-      y := f(f(y))
-      d := gcd(num-abs(x - y), n)
-    end
-    when d <> n:
-      factor := some(d)
-    end
-  end
-  factor
-where:
-  fun is-factor-of(n):
-    lam(x):
-      g = gcd(x.value, n)
-      (g <> 1) and (g <> n)
-    end
-  end
-
-  pollard-rho(3157) satisfies is-factor-of(3157)
-  pollard-rho(4589) satisfies is-factor-of(4589)
-  pollard-rho(5261) is none
-  pollard-rho(6659) is none
-  pollard-rho(7197) satisfies is-factor-of(7197)
-  pollard-rho(8051) satisfies is-factor-of(8051)
-
-  fun fermat(i): num-expt(2, num-expt(2, i)) + 1 end
-  pollard-rho(fermat(3)) is none
-  pollard-rho(fermat(4)) is none
-  pollard-rho(fermat(5)) satisfies is-factor-of(fermat(5))
-  pollard-rho(fermat(6)) satisfies is-factor-of(fermat(6))
-end

package/examples/object-patterns/check.arr

@@ -1,42 +0,0 @@
-#lang pyret
-
-provide
-  {
-    equal: equal,
-    tru: tru,
-    fals: fals,
-    nothin: nothin,
-    assert: assert,
-  }
-end
-
-fun equal(actual, expected, message):
-  if assert(fun: actual == expected end, "check.equal: ".append(message)):
-    nothing
-  else:
-    print(actual)
-  end
-end
-
-fun tru(actual, message):
-  assert(fun: actual end, "check.tru: ".append(message))
-end
-
-fun fals(actual, message):
-  assert(fun: not actual end, "check.fals: ".append(message))
-end
-
-fun nothin(actual, message):
-  assert(fun: is-nothing(actual) end, "check.nothin: ".append(message))
-end
-
-fun assert(testfun, message):
-  result = testfun()
-  if result:
-    print("Passed: ".append(message))
-    true
-  else:
-    print("Failed: ".append(message))
-    false
-  end
-end

package/examples/object-patterns/mixin-class.arr

@@ -1,44 +0,0 @@
-#lang pyret
-
-todo1 = {
-  # Constructor should return an object to use as self
-  constructor(_, self, spec):
-    self.{
-      due: spec.due,
-      task: spec.task
-    }
-  end,
-  due: "25 January 2012",
-  task: "Write mixin examples",
-  done: false,
-  complete(self): self.{ done: true } end
-}
-
-fun droppable(obj):
-  obj.{
-    drop(self, names):
-      for list.fold(self-dropped from {}, name from builtins.keys(self)):
-        if names.member(name):
-          self-dropped
-        else:
-          self-dropped.{ [name]: self.[name] }
-        end
-      end
-    end
-  }
-end
-
-fun make-class(obj):
-  {
-    instantiate(self, spec):
-      instance = droppable(obj).drop(["constructor"])
-      obj.constructor(instance, spec)
-    end
-  }
-where:
-  todo-class = make-class(todo1)
-  todo2 = todo-class.instantiate({ due: "today", task: "implement classes" })
-  checkers.check-equals("due was instantiated", todo2.due, "today")
-  checkers.check-equals("done used default", todo2.done, false)
-  todo2.constructor() raises-satisfies error.is-field-not-found
-end

package/examples/object-patterns/mixin-extend.arr

@@ -1,25 +0,0 @@
-#lang pyret
-
-import "check.arr" as Check
-
-todo1 = {
-  due: "25 January 2012",
-  task: "Write mixin examples",
-  done: false,
-}
-
-fun extendable(obj):
-  obj.{
-    ext(self, obj2):
-      for list.fold(self-ext from self, name from builtins.keys(obj2)):
-        self-ext.{ [name]: obj2.[name] }
-      end
-    end
-  }
-where:
-  todo2 = extendable(todo1)
-  todo3 = todo2.ext({ complete(self): self.{ done: true } end })
-  checkers.check-equals("done is present after extend", todo3.done, false)
-  checkers.check-equals("complete is present after extend", todo3.complete().done, true)
-
-end