summaryrefslogtreecommitdiff
path: root/tests/examplefiles/garcia-wachs.kk
diff options
context:
space:
mode:
Diffstat (limited to 'tests/examplefiles/garcia-wachs.kk')
-rw-r--r--tests/examplefiles/garcia-wachs.kk70
1 files changed, 40 insertions, 30 deletions
diff --git a/tests/examplefiles/garcia-wachs.kk b/tests/examplefiles/garcia-wachs.kk
index f766e051..91a01fbe 100644
--- a/tests/examplefiles/garcia-wachs.kk
+++ b/tests/examplefiles/garcia-wachs.kk
@@ -1,9 +1,25 @@
-/* This is an example in the Koka Language of the Garcia-Wachs algorithm */
-module garcia-wachs
+// Koka language test module
-public fun main()
-{
- test().print
+// This module implements the GarsiaWachs algorithm.
+// It is an adaptation of the algorithm in ML as described by JeanChristophe Filli�tre:
+// in ''A functional implementation of the GarsiaWachs algorithm. (functional pearl). ML workshop 2008, pages 91--96''.
+// See: http://www.lri.fr/~filliatr/publis/gwWml08.pdf
+//
+// The algorithm is interesting since it uses mutable references shared between a list and tree but the
+// side effects are not observable from outside. Koka automatically infers that the final algorithm is pure.
+// Note: due to a current limitation in the divergence analysis, koka cannot yet infer that mutually recursive
+// definitions in "insert" and "extract" are terminating and the final algorithm still has a divergence effect.
+// However, koka does infer that no other effect (i.e. an exception due to a partial match) can occur.
+module garcsiaWachs
+
+import test = qualified std/flags
+
+# pre processor test
+
+public function main() {
+ wlist = Cons1(('a',3), [('b',2),('c',1),('d',4),('e',5)])
+ tree = wlist.garsiaWachs()
+ tree.show.println()
}
//----------------------------------------------------
@@ -14,10 +30,9 @@ public type tree<a> {
con Node(left :tree<a>, right :tree<a>)
}
-fun show( t : tree<char> ) : string
-{
+function show( t : tree<char> ) : string {
match(t) {
- Leaf(c) -> Core.show(c)
+ Leaf(c) -> core/show(c)
Node(l,r) -> "Node(" + show(l) + "," + show(r) + ")"
}
}
@@ -30,23 +45,21 @@ public type list1<a> {
Cons1( head : a, tail : list<a> )
}
-
-fun map( xs, f ) {
+function map( xs, f ) {
val Cons1(y,ys) = xs
- return Cons1(f(y), Core.map(ys,f))
+ return Cons1(f(y), core/map(ys,f))
}
-fun zip( xs :list1<a>, ys :list1<b> ) : list1<(a,b)> {
+function zip( xs :list1<a>, ys :list1<b> ) : list1<(a,b)> {
Cons1( (xs.head, ys.head), zip(xs.tail, ys.tail))
}
-
//----------------------------------------------------
// Phase 1
//----------------------------------------------------
-fun insert( after : list<(tree<a>,int)>, t : (tree<a>,int), before : list<(tree<a>,int)> ) : div tree<a>
+function insert( after : list<(tree<a>,int)>, t : (tree<a>,int), before : list<(tree<a>,int)> ) : div tree<a>
{
match(before) {
Nil -> extract( [], Cons1(t,after) )
@@ -60,7 +73,7 @@ fun insert( after : list<(tree<a>,int)>, t : (tree<a>,int), before : list<(tree<
}
}
-fun extract( before : list<(tree<a>,int)>, after : list1<(tree<a>,int)> ) : div tree<a>
+function extract( before : list<(tree<a>,int)>, after : list1<(tree<a>,int)> ) : div tree<a>
{
val Cons1((t1,w1) as x, xs ) = after
match(xs) {
@@ -75,25 +88,24 @@ fun extract( before : list<(tree<a>,int)>, after : list1<(tree<a>,int)> ) : div
}
}
-
-
-fun balance( xs : list1<(tree<a>,int)> ) : div tree<a>
-{
+function balance( xs : list1<(tree<a>,int)> ) : div tree<a> {
extract( [], xs )
}
-fun mark( depth :int, t :tree<(a,ref<h,int>)> ) : <write<h>> ()
-{
+//----------------------------------------------------
+// Phase 2
+//----------------------------------------------------
+
+function mark( depth :int, t :tree<(a,ref<h,int>)> ) : <write<h>> () {
match(t) {
Leaf((_,d)) -> d := depth
Node(l,r) -> { mark(depth+1,l); mark(depth+1,r) }
}
}
-
-fun build( depth :int, xs :list1<(a,ref<h,int>)> ) : <read<h>,div> (tree<a>,list<(a,ref<h,int>)>)
+function build( depth :int, xs :list1<(a,ref<h,int>)> ) : <read<h>,div> (tree<a>,list<(a,ref<h,int>)>)
{
- if (!xs.head.snd == depth) return (Leaf(xs.head.fst), xs.tail)
+ if (!(xs.head.snd) == depth) return (Leaf(xs.head.fst), xs.tail)
l = build(depth+1, xs)
match(l.snd) {
@@ -105,13 +117,11 @@ fun build( depth :int, xs :list1<(a,ref<h,int>)> ) : <read<h>,div> (tree<a>,list
}
}
-public fun test() {
- wlist = Cons1(('a',3), [('b',2),('c',1),('d',4),('e',5)])
- tree = wlist.garciawachs()
- tree.show()
-}
+//----------------------------------------------------
+// Main
+//----------------------------------------------------
-public fun garciawachs( xs : list1<(a,int)> ) : div tree<a>
+public function garsiaWachs( xs : list1<(a,int)> ) : div tree<a>
{
refs = xs.map(fst).map( fun(x) { (x, ref(0)) } )
wleafs = zip( refs.map(Leaf), xs.map(snd) )