Added some functional data structures

examples/func_ds/BankersDeque.trp

@@ -0,0 +1,74 @@
+import lazy
+import lists
+import streams
+
+datatype Atoms = NIL
+
+let
+    fun assertEq (got, exp, msg) = 
+        if got = exp then print (msg ^ ": ok")
+        else print (msg ^ ": failed")
+
+    val c = 2
+    val empty = {F = fn () => NIL, LenF = 0, R = fn () => NIL, LenR = 0}
+    fun isEmpty {LenF = lenF, LenR = lenR, F = _, R = _} = (lenF + lenR = 0)
+
+    fun queue {F = f, LenF = lenF, R = r, LenR = lenR} =
+        if lenF > c * lenR + 1 then
+            let val i = (lenF + lenR) div 2
+                val j = lenF + lenR - i
+                val f' = take i f
+                val r' = streamAppend r (streamReverse (drop i f))
+            in {F = f', LenF = i, R = r', LenR = lenR} end
+        else if lenR > c * lenF + 1 then
+            let val i = (lenF + lenR) div 2
+                val j = lenF + lenR - i
+                val f' = streamAppend f (streamReverse (drop j r))
+                val r' = take j r
+            in {F = f', LenF = i, R = r', LenR = lenR} end
+        else {F = f, LenF = lenF, R = r, LenR = lenR}
+
+    fun cons {F = f, LenF = lenF, R = r, LenR = lenR} x =
+        queue {F = fn () => (x, f), LenF = lenF + 1, R = r, LenR = lenR}
+    fun head {F = f, R = r, LenF = _, LenR = _} =
+        case (force f) of
+            (x, _) => x
+          | _ => case (force r) of
+                    NIL => print "EMPTY!"
+                  | (x, _) => x 
+    fun tail {F = f, R = r, LenF = lenF, LenR = lenR} =
+        case (force f) of
+            (x, f') => queue {F = f', LenF = lenF - 1, R = r, LenR = lenR}
+          | _ => case (force r) of
+                    NIL => print "EMPTY!"
+                  | (x, _) => empty 
+
+    fun snoc {F = f, LenF = lenF, R = r, LenR = lenR} x =
+        queue {F = f, LenF = lenF, R = fn () => (x, r), LenR = lenR + 1}
+    fun last {F = f, R = r, LenF = _, LenR = _} =
+        case (force r) of
+            (x, _) => x
+          | _ => case (force f) of
+                    NIL => print "EMPTY!"
+                  | (x, _) => x 
+    fun init {F = f, R = r, LenF = lenF, LenR = lenR} =
+        case (force r) of
+            (x, r') => queue {F = f, LenF = lenF, R = r', LenR = lenR - 1}
+          | _ => case (force f) of
+                    NIL => print "EMPTY!"
+                  | (x, _) => empty 
+
+    fun dequeToList {F = f, R = r, LenF = _, LenR = lenR} =
+        append (streamToList f) (streamToList r) 
+
+    val q0 = empty
+    val q1 = snoc q0 1
+    val q2 = snoc q1 2
+    val q3 = cons q2 0
+    val _ = assertEq (head q3 = 0, true, "check head")
+    val _ = assertEq (last q3 = 2, true, "check last")
+    val _ = assertEq (dequeToList (tail q3) = [1, 2], true, "check tail")
+    val _ = assertEq (dequeToList (init q3) = [0, 1], true, "check init")
+in
+    print "success!"
+end

examples/func_ds/BinaryRAList.trp

@@ -0,0 +1,59 @@
+import lists
+
+datatype Atoms = NONE
+
+let
+    fun assertEq (got, exp, msg) = 
+        if got = exp then print (msg ^ ": ok")
+        else print (msg ^ ": failed")
+
+    val empty = []
+    fun isEmpty ts = null ts
+
+    fun size {Size = sz, Left = _, Right = _, Tag = _, Val = _} = sz
+    fun link (t1, t2) = {Size = size t1 + size t2, Left = t1, Right = t2, Tag = "Node", Val = NONE}
+    fun insTree (t, []) = [{Tag = "One", Tree = t}]
+      | insTree (t, {Tag = "Zero", Tree = _}::ts) = {Tag = "One", Tree = t}::ts
+      | insTree (t1, {Tag = "One", Tree = t2}::ts) = {Tag = "Zero", Tree = NONE}::insTree(link(t1, t2), ts)
+    fun borrowTree [] = print "Empty!"
+      | borrowTree ({Tag = "One", Tree = t}::[]) = (t, [])
+      | borrowTree ({Tag = "One", Tree = t}::ts) = (t, {Tag = "Zero", Tree = NONE}::ts) 
+      | borrowTree ({Tag = "Zero", Tree = 0}::ts) = let val ({Tag = "Node", Size = _, Left = t1, Right = t2, Val = _}, ts') = borrowTree ts
+                                                    in (t1, {Tag = "One", Tree = t2}::ts') end
+
+    fun cons(x, ts) = insTree ({Tag = "Leaf", Size = 1, Left = NONE, Right = NONE, Val = x}, ts)
+    fun head ts = let val ({Tag = "Leaf", Val = x, Size = _, Left = _, Right = _}, _) = borrowTree ts in x end
+    fun tail ts = let val (_, ts') = borrowTree ts in ts' end
+
+    fun lookupTree ({Tag = "Leaf", Val = x, Left = _, Right = _, Size = _}, 0) = x
+      | lookupTree ({Tag = "Leaf", Val = x, Left = _, Right = _, Size = _}, i) = print "Invalid Index!"
+      | lookupTree ({Tag = "Node", Val = _, Left = t1, Right = t2, Size = w}, i) = 
+            if i < w div 2 then lookupTree(t1, i) else lookupTree(t2, i - w div 2)
+    fun updateTree ({Tag = "Leaf", Val = x, Left = _, Right = _, Size = _}, 0, y) = {Tag = "Leaf", Val = y, Left = NONE, Right = NONE, Size = 1}
+      | updateTree ({Tag = "Leaf", Val = x, Left = _, Right = _, Size = _}, i, y) = print "Invalid Index!"
+      | updateTree ({Tag = "Node", Left = t1, Right = t2, Val = NONE, Size = w}, i, y) = 
+            if i < w div 2 then {Tag = "Node", Size = w, Left = updateTree(t1, i, y), Right = t2, Val = NONE}
+            else {Tag = "Node", Size = w, Left = t1, Right = updateTree(t2, i - w div 2, y), Val = NONE}
+    fun lookup ([], i) = print "Invalid Index!" 
+      | lookup ({Tag = "Zero", Tree = _}::ts, i) = lookup (ts, i)
+      | lookup ({Tag = "One", Tree = t}::ts, i) = 
+        if i < size t then lookupTree(t, i) else lookup (ts, i - size t)
+    fun update ([], i, y) = print "Invalid Index!" 
+      | update ({Tag = "Zero", Tree = _}::ts, i, y) = update (ts, i, y)
+      | update ({Tag = "One", Tree = t}::ts, i, y) = 
+            if i < size t then {Tag = "One", Tree = updateTree(t, i, y)}::ts else {Tag = "One", Tree = t}::update(ts, i - size t, y)
+
+    fun ofList xs = foldl (fn (x, acc) => cons(x, acc)) empty (reverse xs)
+
+    val s0 = empty
+    val _ = assertEq (isEmpty s0, true, "check empty")
+    val s1 = cons(7, s0)
+    val _ = assertEq (head s1 = 7, true, "head singleton")
+    val _ = assertEq (tail s1 = [{Tag = "Zero", Tree = NONE}], true, "tail singleton")
+    val s = ofList [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
+    val s' = update(s, 4, 42)
+    val _ = assertEq (lookup (s', 4) = 42, true, "check update")
+    val _ = assertEq (lookup (s', 3) = 3, true, "check false update")
+in
+    print "success!"
+end

examples/func_ds/BottomUpMergeSort.trp

@@ -0,0 +1,28 @@
+import lists
+import lazy
+
+datatype Atoms = NIL
+
+let
+    fun less (a, b) = a < b
+    fun new {Less = less} = {Less = less, Size = 0, Segments = fn () => []} 
+
+    fun merge less (xs, ys) = 
+        let fun mrg ([], ys) = ys
+              | mrg (xs, []) = xs
+              | mrg (x::xs, y::ys) = if less(x,y) then x::mrg(xs, y::ys)
+                                     else y::mrg(x::xs, ys)
+        in mrg(xs, ys) end
+
+    fun add x {Less = less, Size = size, Segments = segs} = 
+        let fun addSeg (seg, segs, size) = 
+            if size mod 2 = 0 then seg::segs
+            else addSeg (merge less (seg, hd segs), tl segs, size div 2)
+        in {Less = less, Size = size + 1, Segments = fn () => addSeg([x], force segs, size)} end
+
+    fun addList xs heap = foldl (fn (x, q) => add x q) heap xs
+
+    fun sort {Less = less, Segments = segs, Size = _} = foldl (merge less) [] (force segs)
+in 
+    sort (addList [1, 7, 6, 1000, 999] (new {Less = less}))
+end

examples/func_ds/ScheduledBottomUpMergeSort.trp

@@ -0,0 +1,58 @@
+import lazy
+import lists
+import streams
+
+datatype Atoms = NIL
+
+let
+    fun assertEq (got, exp, msg) = 
+        if got = exp then print (msg ^ ": ok")
+        else print (msg ^ ": failed")
+
+    fun new less = {Less = less, Size = 0, Segments = []}
+
+    fun merge less (xs, ys) = 
+        let fun mrg (xs, ys) = case (force xs) of
+           NIL => ys
+         | (x, xs') => case (force ys) of
+                    NIL => xs
+                  | (y, ys') => if less (x, y) then fn () => (x, mrg (xs', ys))
+                                else fn () => (y, mrg (xs, ys'))
+            in mrg (xs, ys) end
+
+    fun exec1 [] = []
+      | exec1 (fst::sched) = case (force fst) of
+            NIL => exec1 sched
+          | (x, xs) => xs::sched
+
+    fun exec2PerSeg [] = []
+      | exec2PerSeg ((xs, sched)::segs) = (xs, exec1 (exec1 sched))::exec2PerSeg segs
+
+    fun add (x, {Less = less, Size = size, Segments = segs}) = 
+        let fun addSeg (xs, segs, size, rsched) = 
+            if size mod 2 = 0 then (xs, reverse (xs::rsched))::segs
+            else let val ((xs', [])::segs') = segs
+                 in addSeg (merge less (xs, xs'), segs', size div 2, xs::rsched) end 
+            val segs' = addSeg (fn () => (x, fn () => NIL), segs, size, [])
+        in {Less = less, Size = size + 1, Segments = exec2PerSeg segs'} end
+
+    fun sort {Less = less, Size = _, Segments = segs} = 
+        let fun mergeAll (xs, []) = xs
+              | mergeAll (xs, (xs', sched)::segs) = mergeAll(merge less (xs,xs'), segs)
+            fun streamToList stream = 
+                case (force stream) of
+                    NIL => []
+                  | (x, xs) => x :: streamToList xs
+            in streamToList (mergeAll (fn () => NIL, segs)) end
+
+    val sorter = new (fn (a, b) => a < b)
+    val sorter1 = add (3, sorter)
+    val sorter2 = add (1, sorter1)
+    val sorter3 = add (4, sorter2)
+    val sorter4 = add (1, sorter3)
+    val sorter5 = add (5, sorter4)
+
+    val _ = assertEq([1, 1, 3, 4, 5] = sort sorter5, true, "sorted list")
+in
+    print "success"
+end

examples/func_ds/banker_q.trp

@@ -0,0 +1,35 @@
+import lists
+import lazy
+import streams
+
+datatype Atoms = NIL
+
+let 
+    val empty_queue = {F = fn () => NIL, Len_F = 0, R = fn () => NIL, Len_R = 0}
+    val test_stream = fn () => (1, fn () => (2, fn () => (3, fn () => NIL)))
+
+    fun isEmpty q = (q.len_f = 0) 
+
+    fun queue {F = f, Len_F = lf, R = r, Len_R = lr} = 
+        if lr <= lf then {F = f, Len_F = lf, R = r, Len_R = lr}
+        else {F = streamAppend f (streamReverse r), Len_F = lf + lr, R = fn () => NIL, Len_R = 0}
+
+    fun snoc {F = f, Len_F = lf, R = r, Len_R = lr} x = 
+        queue {F = f, Len_F = lf, R = fn () => (x, r), Len_R = lr + 1}
+
+    fun head {F = f, Len_F = _, R = _, Len_R = _} = case force f of
+        NIL => print "Error: Empty Queue"
+      | (x, thunk) => x
+
+    fun tail {F = f, Len_F = lf, R = r, Len_R = lr} = case force f of
+        NIL => print "Error: Empty Queue" 
+      | (x, thunk) => queue {F = thunk, Len_F = lf - 1, R = r, Len_R = lr}
+
+    fun printQueue {F = f, Len_F = lf, R = r, Len_R = lr} = print (append (streamToList f) (streamToList r))
+
+    val append1 = snoc empty_queue 1
+    val {F = f, Len_F = _, R = _, Len_R = _} = append1 
+    val append2 = snoc append1 2
+in 
+    printQueue append2
+end

examples/func_ds/real_time_q.trp

@@ -0,0 +1,52 @@
+import lazy
+import lists
+import streams
+
+datatype Atoms = NIL
+
+let
+    fun assertEq (got, exp, msg) = 
+        if got = exp then print (msg ^ "ok")
+        else print (msg ^ "failed")
+
+    val new = {F = fn () => NIL, R = [], S = fn () => NIL}
+    fun isEmpty {F = f, R = r, S = s} = (force f = NIL)
+
+    fun rotate (f, r, a) = fn () => (
+            case (force f, r, a) of
+                (NIL, y::[], a) => (y, a)
+              | ((x, f'), y::r', a) => (x, rotate (f', r', fn () => (y, a)))
+        ) 
+
+    fun queue {F = f, R = r, S = s'} = (
+        case (force s') of
+            (x, s) => {F = f, R = r, S = s}
+          | NIL => let val f' = rotate (f, r, fn () => NIL)
+                   in {F = f', R = [], S = f'} end
+        )
+
+    fun snoc {F = f, R = r, S = s} x = queue {F = f, R = x::r, S = s}
+
+    fun head {F = f', R = _, S = _} = (
+        case (force f') of
+            NIL => NIL
+          | (x, f) => x
+    )
+
+    fun tail {F = f', R = r, S = s} = (
+        case (force f') of
+            NIL => NIL
+          | (x, f) => {F = f, R = r, S = s}
+    )
+
+    val q0 = new
+    val _ = assertEq ("isEmpty new queue", isEmpty q0, true)
+
+    val q1 = snoc q0 42
+    val _ = assertEq ("isEmpty after one snoc", isEmpty q1, false)
+    val _ = assertEq ("head after one snoc", head q1, 42)
+    val q1' = tail q1
+    val _ = assertEq ("tail returns empty after one snoc", isEmpty q1', true)
+in
+    print "success!"
+end

lib/lazy.trp

@@ -0,0 +1,11 @@
+let
+    fun force thunk = thunk ()
+    fun curry f x y = f (x, y)
+    fun uncurry f (x, y) = f x y
+in
+    [
+        ("force", force)
+    ,   ("curry", curry)
+    ,   ("uncurry", uncurry)
+    ]
+end

lib/lists.trp

@@ -10,8 +10,6 @@ let fun map f list =
     in mapj 0 list
     end
 
-
-
     fun foldl f y [] = y
       | foldl f y (x::xs) = foldl f (f (x,y)) xs
 
@@ -36,7 +34,7 @@ let fun map f list =
             [] => l2
           | x::l => x::(append l l2)
 
-    fun nth (x::l) 1 = x
+    fun nth (x::l) 0 = x
       | nth (x::l) n = nth l (n - 1)
 
     fun lookup list key default =
@@ -54,10 +52,17 @@ let fun map f list =
                         if f x then partition_aux (x::a, b) xs 
                                else partition_aux (a, x::b) xs
 
-
       in  partition_aux ([],[]) ls 
       end   
+
+    fun hd [] = 0
+      | hd (x::xs) = x
+
+    fun tl [] = []
+      | tl (x::xs) = xs
 
+    fun null [] = true
+      | null xs = false
 in
     [ ("map",     map)
     , ("mapi",    mapi)
@@ -69,5 +74,9 @@ in
     , ("length",  length)
     , ("append",  append)
     , ("partition", partition) 
+    , ("hd", hd)
+    , ("tl", tl)
+    , ("nth", nth)
+    , ("null", null)
     ]
 end