From e5d206fca5b28f722f83b759699cb0c8b9836bcd Mon Sep 17 00:00:00 2001 From: Jakub Chomiczewski Date: Wed, 14 Aug 2024 09:23:11 +0200 Subject: [PATCH] Adding missing files --- lib/Comparable.fram | 5 + lib/Ordered.fram | 14 ++ lib/OrderedMapSignature.fram | 63 +++++++ lib/OrderedSet.fram | 232 +++++++++++++++++++++++++ lib/OrderedSetSignature.fram | 34 ++++ lib/RedBlackTree.fram | 278 ++++++++++++++++++++++++++++++ test/stdlib/stdlib0001_Map.fram | 92 ++++++++++ test/stdlib/stdlib0002_Set.fram | 75 ++++++++ test/stdlib/stdlib0003_Queue.fram | 20 +++ 9 files changed, 813 insertions(+) create mode 100644 lib/Comparable.fram create mode 100644 lib/Ordered.fram create mode 100644 lib/OrderedMapSignature.fram create mode 100644 lib/OrderedSet.fram create mode 100644 lib/OrderedSetSignature.fram create mode 100644 lib/RedBlackTree.fram create mode 100644 test/stdlib/stdlib0001_Map.fram create mode 100644 test/stdlib/stdlib0002_Set.fram create mode 100644 test/stdlib/stdlib0003_Queue.fram diff --git a/lib/Comparable.fram b/lib/Comparable.fram new file mode 100644 index 0000000..9bf4704 --- /dev/null +++ b/lib/Comparable.fram @@ -0,0 +1,5 @@ +(* This file is part of DBL, released under MIT license. + * See LICENSE for details. +*) + +pub data Comparable = Eq| Noteq diff --git a/lib/Ordered.fram b/lib/Ordered.fram new file mode 100644 index 0000000..e72f945 --- /dev/null +++ b/lib/Ordered.fram @@ -0,0 +1,14 @@ +(* This file is part of DBL, released under MIT license. + * See LICENSE for details. +*) + +import open Comparable + +pub data Ordered = +| Less +| Equal +| Greater + +pub let ordToComp elem = match elem with | Equal => Eq | _ => Noteq end + +pub method toComparable {self : Ordered} = ordToComp self diff --git a/lib/OrderedMapSignature.fram b/lib/OrderedMapSignature.fram new file mode 100644 index 0000000..a307fb0 --- /dev/null +++ b/lib/OrderedMapSignature.fram @@ -0,0 +1,63 @@ +(* This file is part of DBL, released under MIT license. + * See LICENSE for details. +*) +import open RedBlackTree + +pub data OrderedMap Key = Map of { + T + , empty : {type Val} -> Tree (T Val) + , singleton : {type Val} -> Key -> Val -> [] Tree (T Val) + , method isEmpty : {type Val} -> Tree (T Val) -> [] Bool + , method insert : {type Val} -> Tree (T Val) -> + Key -> Val -> [] Tree (T Val) + , method insert' : {type Val} -> Tree (T Val) -> + Key -> Val -> [] (Pair (Tree (T Val)) Bool) + , method remove : {type Val} -> Tree (T Val) -> + Key -> [] Tree (T Val) + , method remove' : {type Val} -> Tree (T Val) -> + Key -> [] (Pair (Tree (T Val)) Bool) + , method member : {type Val} -> Tree (T Val) -> Key -> [] Bool + , method find : {type Val} -> Tree (T Val) -> Key -> [] Option Val + , method operate : {type Val} -> Tree (T Val) -> Key -> + (Unit -> [] Option Val) -> (Val -> [] Option Val) -> + [] (Pair (Pair (Option Val) (Option Val)) (Tree (T Val))) + , method foldl : {type Val, type A} -> Tree (T Val) -> + (Key -> Val -> A -> [] A) -> A -> [] A + , method foldr : {type Val, type A} -> Tree (T Val) -> + (Key -> Val -> A -> [] A) -> A -> [] A + , method toList : {type Val} -> Tree (T Val) -> [] List (Pair Key Val) + , method toValueList : {type Val} -> Tree (T Val) -> [] List Val + , method domain : {type Val} -> Tree (T Val) -> [] List Key + , method map : {type Val, type A} -> Tree (T Val) -> + (Val -> [] A) -> [] Tree (T A) + , method map2 : {type Val, type A} -> Tree (T Val) -> + (Key -> [] A) -> [] Tree (T A) +(* , method map3 : {type Val, type A} -> (Val -> [] A) -> + Tree (T Val) -> [] Tree (T A) *) + , method app : {type Val} -> Tree (T Val) -> + (Key -> Val -> [] Unit) -> [] Unit + , method union : {type Val} -> Tree (T Val) -> Tree (T Val) -> + (Key -> Val -> Val -> [] Val) -> [] Tree (T Val) + , method partion : {type Val} -> Tree (T Val) -> Key -> + [] (Pair (Pair (Tree (T Val)) (Option Val)) (Tree (T Val))) + , method partionLt : {type Val} -> Tree (T Val) -> Key -> + [] Pair (Tree (T Val)) (Tree (T Val)) + , method partionGt : {type Val} -> Tree (T Val) -> Key -> + [] Pair (Tree (T Val)) (Tree (T Val)) + , method rangeii : {type Val} -> Tree (T Val) -> Key -> Key -> + [] Tree (T Val) + , method rangeie : {type Val} -> Tree (T Val) -> Key -> Key -> + [] Tree (T Val) + , method rangeei : {type Val} -> Tree (T Val) -> Key -> Key -> + [] Tree (T Val) + , method rangeee : {type Val} -> Tree (T Val) -> Key -> Key -> + [] Tree (T Val) + , method least : {type Val} -> Tree (T Val) -> [] Option (T Val) + , method greatest : {type Val} -> Tree (T Val) -> [] Option (T Val) + , method leastGt : {type Val} -> Tree (T Val) -> Key -> [] Option (T Val) + , method leastGeq : {type Val} -> Tree (T Val) -> Key -> [] Option (T Val) + , method greatestLt : {type Val} -> Tree (T Val) -> + Key -> [] Option (T Val) + , method greatestLeq : {type Val} -> Tree (T Val) -> + Key -> [] Option (T Val) +} diff --git a/lib/OrderedSet.fram b/lib/OrderedSet.fram new file mode 100644 index 0000000..1b85442 --- /dev/null +++ b/lib/OrderedSet.fram @@ -0,0 +1,232 @@ +(* This file is part of DBL, released under MIT license. + * See LICENSE for details. +*) + +import open RedBlackTree +import open OrderedSetSignature + +data rec Q Val = Nil | E of Val , Q Val | T of Tree Val , Q Val + +let rec eqMain eq qs1 qs2 = + match (qs1,qs2) with + | (Nil,Nil) => True + | (Nil, E _ _) => False + | (E _ _, Nil) => False + | (T Leaf rest, _) => eqMain eq rest qs2 + | (_, T Leaf rest) => eqMain eq qs1 rest + | (T (Node _ _ left elem right) rest, _) => + eqMain eq (T left (E elem (T right rest))) qs2 + | (_, T (Node _ _ left elem right) rest) => + eqMain eq qs1 (T left (E elem (T right rest))) + | (E elem1 rest1, E elem2 rest2) => + match eq elem1 elem2 with + | Noteq => False + | Eq => eqMain eq rest1 rest2 + end + end + +let rec subsetMain comp qs1 qs2 = + match (qs1,qs2) with + | (Nil,_) => True + | (E _ _ , Nil) => False + | (T Leaf rest, _) => subsetMain comp rest qs2 + | (_ , T Leaf rest) => subsetMain comp qs1 rest + | (T (Node _ _ left elem right) rest, _) => + subsetMain comp (T left (E elem (T right rest))) qs2 + | (_, T (Node _ _ left elem right) rest) => + subsetMain comp qs1 (T left (E elem (T right rest))) + | (E elem1 rest1, E elem2 rest2) => + match comp elem1 elem2 with + | Less => False + | Equal => subsetMain comp rest1 rest2 + | Greater => subsetMain comp qs1 rest2 + end + end + +let partionLt compare = fn tree key1 => let (_,left,right) = + split (fn key2 => match compare key1 key2 with + | Greater => Greater | _ => Less end) tree in (left,right) + +let partionGt compare = fn tree key1 => let (_, left,right) = + split (fn key2 => match compare key1 key2 with + | Less => Less | _ => Greater end) tree in (left,right) + +let rec least tree = + match tree with + | Leaf => None + | Node _ _ Leaf x _ => Some x + | Node _ _ left _ _ => least left + end + +let rec greatest tree = + match tree with + | Leaf => None + | Node _ _ _ x Leaf => Some x + | Node _ _ _ _ right => greatest right + end + +pub let makeOrderedSet {Val} (compare : Val -> Val -> [] Ordered) = Set { + T = Tree Val + , empty = Leaf + , method isEmpty = + (fn tree => match tree with + | Leaf => True + | _ => False + end) + , method singletonSet = fn elem => Node Black 1 Leaf elem Leaf + , singleton = fn elem => Node Black 1 Leaf elem Leaf + , method insert = fn tree elem => + match search (fn val => compare elem val) tree [] with + | (Leaf,zipper) => zipRed elem Leaf Leaf zipper + | (Node _ _ _ _ _,_) => tree + end + , method remove = fn tree elem => + match search (fn val => compare elem val) tree [] with + | (Leaf,_) => tree + | (Node color _ left _ right,zipper) => delete color left right zipper + end + , method member = fn tree elem => let rec search tree elem = + match tree with + | Leaf => False + | Node _ _ left val right => + match compare elem val with + | Less => search left elem + | Greater => search right elem + | Equal => True + end + end in search tree elem + , method foldl = fn tree func acc => let rec foldl tree func acc = + match tree with + | Leaf => acc + | Node _ _ left val right => + foldl right func (func val (foldl left func acc)) + end in foldl tree func acc + , method foldr = fn tree func acc => let rec foldr tree func acc = + match tree with + | Leaf => acc + | Node _ _ left val right => + foldr left func (func val (foldr right func acc)) + end in foldr tree func acc + , method toList = fn tree => let rec toList tree acc = + match tree with + | Leaf => acc + | Node _ _ left val right => + toList left (val :: toList right acc) + end in toList tree [] + , method union = fn tree1 tree2 => let rec union tree1 tree2 = + match tree1 with + | Leaf => tree2 + | Node _ _ left1 key1 right1 => + match tree2 with + | Leaf => tree1 + | Node _ _ _ _ _ => + let (_,left2,right2) = split (fn key2 => compare key1 key2) tree2 + in join_val key1 (union left1 left2) (union right1 right2) + end + end in union tree1 tree2 + , method intersection = fn tree1 tree2 => let rec intersection tree1 tree2 = + match tree1 with + | Leaf => Leaf + | Node _ _ left1 key1 right1 => + match tree2 with + | Leaf => Leaf + | _ => let (value_out, left2, right2) = + split (fn key2 => compare key1 key2) tree2 + in let left = intersection left1 left2 + in let right = intersection right1 right2 + in match value_out with + | Some _ => join_val key1 left right + | None => join left right + end + end + end in intersection tree1 tree2 + , method diffrence = fn tree1 tree2 => let rec diffrence tree1 tree2 = + match tree1 with + | Leaf => Leaf + | Node _ _ left1 key1 right1 => + match tree2 with + | Leaf => tree1 + | _ => let (value_out, left2, right2) = + split (fn key2 => compare key1 key2) tree2 + in let left = diffrence left1 left2 + in let right = diffrence right1 right2 + in match value_out with + | Some _ => join left right + | None => join_val key1 left right + end + end + end in diffrence tree1 tree2 + , method eq = fn set1 set2 => + eqMain (fn e1 e2 => (compare e1 e2).toComparable) (T set1 Nil) (T set2 Nil) + , method subset = fn set1 set2 => subsetMain compare (T set1 Nil) (T set2 Nil) + , method partionLt = partionLt compare + , method partionGt = partionGt compare + , method rangeii = fn tree left right => + let (_, tree') = partionLt compare tree left in + let (tree'',_) = partionGt compare tree' right in tree'' + , method rangeei = fn tree left right => + let (_, tree') = partionGt compare tree left in + let (tree'',_) = partionGt compare tree' right in tree'' + , method rangeie = fn tree left right => + let (_, tree') = partionLt compare tree left in + let (tree'',_) = partionLt compare tree' right in tree'' + , method rangeee = fn tree left right => + let (_, tree') = partionGt compare tree left in + let (tree'',_) = partionLt compare tree' right in tree'' + , method least = fn tree => least tree + , method greatest = fn tree => greatest tree + , method leastGt = fn tree val => let rec leastGt tree val = + match tree with + | Leaf => None + | Node _ _ left key right => + match compare val key with + | Less => let x = leastGt left val in + match x with + | None => Some key + | _ => x + end + | Equal => least right + | Greater => leastGt right val + end + end in leastGt tree val + , method leastGeq = fn tree val => let rec leastGeq tree val = + match tree with + | Leaf => None + | Node _ _ left key right => + match compare val key with + | Less => match leastGeq left val with + | None => Some key + | x => x + end + | Equal => Some val + | Greater => leastGeq right val + end + end in leastGeq tree val + , method greatestLt = fn tree val => let rec greatestLt tree val = + match tree with + | Leaf => None + | Node _ _ left key right => + match compare val key with + | Less => greatestLt left val + | Equal => greatest left + | Greater => match greatestLt right val with + | None => Some key + | x => x + end + end + end in greatestLt tree val + , method greatestLeq = fn tree val => + let rec greatestLeq tree val = + match tree with + | Leaf => None + | Node _ _ left key right => + match compare val key with + | Less => greatestLeq left val + | Equal => Some val + | Greater => match greatestLeq right val with + | None => Some key + | x => x + end + end + end in greatestLeq tree val +} diff --git a/lib/OrderedSetSignature.fram b/lib/OrderedSetSignature.fram new file mode 100644 index 0000000..45e9aeb --- /dev/null +++ b/lib/OrderedSetSignature.fram @@ -0,0 +1,34 @@ +(* This file is part of DBL, released under MIT license. + * See LICENSE for details. +*) + +pub data OrderedSet Val = Set of { + T + , empty : T + , method isEmpty : T -> [] Bool + , singleton : Val -> [] T + , method insert : T -> Val -> [] T + , method remove : T -> Val -> [] T + , method singletonSet : Val -> [] T + , method member : T -> Val -> [] Bool + , method foldl : {type A} -> T -> (Val -> A -> [] A) -> A -> [] A + , method foldr : {type A} -> T -> (Val -> A -> [] A) -> A -> [] A + , method toList : T -> [] List Val + , method union : T -> T -> [] T + , method intersection : T -> T -> [] T + , method diffrence : T -> T -> [] T + , method eq : T -> T -> [] Bool + , method subset : T -> T -> [] Bool + , method partionLt : T -> Val -> [] (Pair T T) + , method partionGt : T -> Val -> [] (Pair T T) + , method rangeii : T -> Val -> Val -> [] T + , method rangeei : T -> Val -> Val -> [] T + , method rangeie : T -> Val -> Val -> [] T + , method rangeee : T -> Val -> Val -> [] T + , method least : T -> [] Option Val + , method greatest : T -> [] Option Val + , method leastGt : T -> Val -> [] Option Val + , method leastGeq : T -> Val -> [] Option Val + , method greatestLt : T -> Val -> [] Option Val + , method greatestLeq : T -> Val -> [] Option Val +} diff --git a/lib/RedBlackTree.fram b/lib/RedBlackTree.fram new file mode 100644 index 0000000..a0fd992 --- /dev/null +++ b/lib/RedBlackTree.fram @@ -0,0 +1,278 @@ +(* This file is part of DBL, released under MIT license. + * See LICENSE for details. +*) + +import open Ordered +import List + +pub rec + data Color = + | Red + | Black + data Tree Value = + | Leaf + | Node of Color, Int, Tree Value, Value, Tree Value + data ZipElem Value = + | Left of Color, Value, Tree Value + | Right of Color, Value, Tree Value +end + +pub let empty = Leaf + +pub let size tree = + match tree with + | Leaf => 0 + | Node _ bulk _ _ _ => bulk + end + +pub let makeNode color left value right = + Node color (size left + size right + 1) left value right + +pub let rec zip tree zipper = + match zipper with + | [] => tree + + | Left color value right :: rest => zip (makeNode color tree value right) rest + + | Right color value left :: rest => zip (makeNode color left value tree) rest + + end + +pub let rec zipRed value left right zipper = + match zipper with + | [] => makeNode Black left value right + + | Left Black value1 right1 :: rest => + zip (makeNode Black (makeNode Red left value right) value1 right1) rest + + | Right Black value1 left1 :: rest => + zip (makeNode Black left1 value1 (makeNode Red left value right)) rest + + | Left Red value1 right1 :: + Left _ value2 (Node Red bulk3 left3 value3 right3) :: + rest => zipRed value2 + (makeNode Black (makeNode Red left value right) value1 right1) + (Node Black bulk3 left3 value3 right3) rest + + | Left Red value1 right1 :: + Right _ value2 (Node Red bulk3 left3 value3 right3) :: + rest => zipRed value2 + (Node Black bulk3 left3 value3 right3) + (makeNode Black (makeNode Red left value right) value1 right1) rest + + | Right Red value1 left1 :: + Left _ value2 (Node Red bulk3 left3 value3 right3) :: + rest => zipRed value2 + (makeNode Black left1 value1 (makeNode Red left value right)) + (Node Black bulk3 left3 value3 right3) rest + + | Right Red value1 left1 :: + Right _ value2 (Node Red bulk3 left3 value3 right3) :: + rest => zipRed value2 (Node Black bulk3 left3 value3 right3) + (makeNode Black left1 value1 (makeNode Red left value right)) rest + + | Left Red value1 right1 :: + Left _ value2 node3 :: + rest => zip (makeNode Black (makeNode Red left value right) value1 + (makeNode Red right1 value2 node3)) rest + + | Left Red value1 right1 :: + Right _ value2 node3 :: + rest => zip (makeNode Black (makeNode Red node3 value2 left) + value (makeNode Red right value1 right1)) rest + + | Right Red value1 left1 :: + Left _ value2 node3 :: + rest => zip (makeNode Black (makeNode Red left1 value1 left) + value (makeNode Red right value2 node3)) rest + + | Right Red value1 left1 :: + Right _ value2 node3 :: + rest => zip (makeNode Black (makeNode Red node3 value2 left1) + value1 (makeNode Red left value right)) rest + + | Left Red value1 right1 :: + [] => makeNode Black (makeNode Red left value right) value1 right1 + + | Right Red value1 left1 :: + [] => makeNode Black left1 value1 (makeNode Red left value right) + + end + +pub let rec zipBlack tree zipper = + match zipper with + | [] => tree + + | Left color1 value1 (Node _ _ left2 value2 + (Node Red bulk3 left3 value3 right3)) + :: rest => zip (makeNode color1 (makeNode Black tree value1 left2 ) value2 + (Node Black bulk3 left3 value3 right3)) rest + + | Right color1 value1 (Node _ _ (Node Red bulk3 left3 value3 right3) + value2 right2) :: rest => zip (makeNode color1 + (Node Black bulk3 left3 value3 right3) value2 + (makeNode Black right2 value1 tree)) rest + + | Left color1 value1 (Node _ _ (Node Red _ left3 value3 right3) + value2 right2) :: rest => zip (makeNode color1 + (makeNode Black tree value1 left3) value3 + (makeNode Black right3 value2 right2)) rest + + | Right color1 value1 (Node _ _ left2 value2 (Node Red _ left3 value3 + right3)) :: rest => zip (makeNode color1 (makeNode Black left2 value2 left3) + value3 (makeNode Black right3 value1 tree)) rest + + | Left Red value1 (Node _ bulk2 left2 value2 right2) + :: rest => zip (makeNode Black tree value1 + (Node Red bulk2 left2 value2 right2)) rest + + | Right Red value1 (Node _ bulk2 left2 value2 right2) + :: rest => zip (makeNode Black (Node Red bulk2 left2 value2 right2) + value1 tree) rest + + | Left Black value1 (Node Black bulk2 left2 value2 right2) + :: rest => zipBlack (makeNode Black tree value1 + (Node Red bulk2 left2 value2 right2)) rest + + | Right Black value1 (Node Black bulk2 left2 value2 right2) + :: rest => zipBlack (makeNode Black (Node Red bulk2 left2 value2 + right2) value1 tree) rest + + | Left Black value1 (Node Red _ left2 value2 right2) :: rest + => zipBlack tree (Left Red value1 left2 :: Left Black + value2 right2 :: rest) + + | Right Black value1 (Node Red _ left2 value2 right2) :: rest + => zipBlack tree (Right Red value1 right2 :: Right Black + value2 left2 :: rest) + + | Left _ _ Leaf :: _ => tree + + | Right _ _ Leaf :: _ => tree + + end + +pub let rec search func tree zipper = + match tree with + | Leaf => (Leaf, zipper) + | Node color _ left value right => + match func value with + | Less => search func left (Left color value right :: zipper) + | Greater => search func right (Right color value left :: zipper) + | Equal => (tree, zipper) + end + end + +pub let rec searchMin tree zipper = + match tree with + | Leaf => zipper + | Node color _ left value right => + searchMin left (Left color value right :: zipper) + end + +pub let rec searchMax tree zipper = + match tree with + | Leaf => zipper + | Node color _ left value right => + searchMax right (Right color value left :: zipper) + end + +pub let deleteNearLeaf color child zipper = + match color with + | Red => zip Leaf zipper + | Black => match child with + | Node _ _ _ value _ => zip (makeNode Black Leaf value Leaf) zipper + | Leaf => zipBlack Leaf zipper + end + end + +pub let delete color left right zipper = + match right with + | Leaf => match left with + | Leaf => match color with + | Red => zip Leaf zipper + | Black => zipBlack Leaf zipper + end + | _ => match searchMax left [] with + | Right colorLeftMin valueLeftMin leftLeftMin :: zipperr + => deleteNearLeaf colorLeftMin leftLeftMin + (List.append zipperr (Left color valueLeftMin right :: zipper)) + | _ => Leaf + end + end + | _ => match searchMin right [] with + | Left colorRightMin valueRightMin rightRightMin :: zipperr + => deleteNearLeaf colorRightMin rightRightMin + (List.append zipperr (Right color valueRightMin left :: zipper)) + | _ => Leaf + end + end + +pub let blacken tree = + match tree with + | Node Red bulk left value right => Node Black bulk left value right + | _ => tree + end + +pub let rec blackHeight tree acc = + match tree with + | Leaf => acc + | Node Red _ left _ _ => blackHeight left acc + | Node Black _ left _ _ => blackHeight left (1 + acc) + end + +pub let rec searchHeight leftward target tree zipper = + match tree with + | Leaf => (Leaf, zipper) + | Node Red _ left value right => + if leftward then + searchHeight leftward target left (Left Red value right :: zipper) + else + searchHeight leftward target right (Right Red value left :: zipper) + | Node Black _ left value right => + if 0 == target then + (tree,zipper) + else if leftward then + searchHeight leftward (target - 1) left (Left Black value right :: zipper) + else + searchHeight leftward (target - 1) right (Right Black value left :: zipper) + end + +pub let join_val value left right = + let left = blacken left in + let right = blacken right in + let lbh = blackHeight left 0 in + let rbh = blackHeight right 0 in + if lbh == rbh then + makeNode Black left value right + else if lbh > rbh then + (let (_left, zipper) = searchHeight False (lbh-rbh) left [] in + zipRed value _left right zipper) + else + (let (_right, zipper) = searchHeight True (rbh-lbh) right [] in + zipRed value left _right zipper) + +pub let join left right = + match left with + | Leaf => right + | _ => match right with + | Leaf => left + | _ => match searchMax left [] with + | Right color value leftSmall :: zipper + => join_val value (deleteNearLeaf color leftSmall zipper) right + |_ => left + end + end + end + +pub let rec split func tree = + match tree with + | Leaf => (None,Leaf,Leaf) + | Node _ _ left value right => match func value with + | Equal => (Some value, left, right) + | Less => let (_v, _l, _r) = split func left in + (_v, _l, join_val value _r right) + | Greater => let (_v, _l, _r) = split func right in + (_v, join_val value left _l, _r) + end + end diff --git a/test/stdlib/stdlib0001_Map.fram b/test/stdlib/stdlib0001_Map.fram new file mode 100644 index 0000000..af01ffa --- /dev/null +++ b/test/stdlib/stdlib0001_Map.fram @@ -0,0 +1,92 @@ +import OrderedMap +import open List +import open Ordered +import open Prelude + +let assert condition = +if condition then () else exit 1 + +let lt (v1 : Int) (v2 : Int) = + if v1 < v2 then Less + else if v2 < v1 then Greater + else Equal + +let OrderedMap.Map {module IntMap} = OrderedMap.makeOrderedMap lt + +let x = IntMap.empty + +(* insert check *) +let y = x.insert 1 1 +let z = x.insert 1 "a" + +(* isEmpty check *) +let _ = assert (y.isEmpty == False) +let _ = assert (z.isEmpty == False) +let _ = assert (y.remove 1 >. isEmpty) + +(* singleton check *) +let y = IntMap.singleton 1 1 +let _ = assert (y.toValueList == [1]) + +(* domain check *) +let z = y.insert 2 1 >. insert 3 2 >. insert 4 3 +let _ = assert (z.domain == [1,2,3,4] && z.toValueList == [1,1,2,3]) + +(* toList check *) +let _ = assert ((z.toList.foldLeft + (fn acc (key,val) => val :: acc) []) == [1,1,2,3].rev) + +(* foldl check *) +let _ = assert (z.foldl (fn key val acc => key :: acc) [] == [1,2,3,4].rev) + +(* member check *) +let _ = assert (z.member 1) + +(* find check *) +let _ = assert (match z.find 1 with | None => False | _ => True end) + +(* operate change check *) +let _ = assert (snd (z.operate 1 (fn () => Some 2) (fn a => Some 0)) + >. toValueList == [0,1,2,3]) + +(* operate add check *) +let _ = assert (snd (z.operate 0 (fn () => Some 2) (fn a => Some 0)) + >. toValueList == [2,1,1,2,3]) + +(* map check *) +let _ = assert (z.map (fn x => if x == x.shiftr 1 >. shiftl 1 then -x else x) + >. toValueList == [1,1,(0-2),3]) + +(* union check *) +let y = x.insert 1.neg 2 >. insert 2.neg 3 >. insert 0 1 >. insert 1 10 +let w = z.union y (fn key val1 val2 => val2) +let _ = assert (w.toValueList == [3,2,1,10,1,2,3]) + +(* partion check *) +let q = w.partion 0 +let _ = assert (fst (fst q) >. toValueList == [3,2]) +let _ = assert (snd q >. toValueList == [10,1,2,3]) + +(* partionLt check *) +let q = w.partionLt 0 +let _ = assert (fst q >. toValueList == [3,2,1]) +let _ = assert (snd q >. toValueList == [10,1,2,3]) + +(* partionGt check *) +let q = w.partionGt 0 +let _ = assert (fst q >. toValueList == [3,2]) +let _ = assert (snd q >. toValueList == [1,10,1,2,3]) + +(* rangeee check *) +let q = w.rangeee 0 2 +let _ = assert (q.toValueList == [10]) + +(* rangeii check *) +let q = w.rangeii 0 2 +let _ = assert (q.toValueList == [1,10,1]) + +(* rangeie check *) +let _ = assert (w.rangeie 0 2 >. toValueList == [1,10]) + +(* rangeei check *) +let _ = assert (w.rangeei 0 2 >. toValueList == [10,1]) diff --git a/test/stdlib/stdlib0002_Set.fram b/test/stdlib/stdlib0002_Set.fram new file mode 100644 index 0000000..0ad5cc5 --- /dev/null +++ b/test/stdlib/stdlib0002_Set.fram @@ -0,0 +1,75 @@ +import OrderedSet +import open List +import open Ordered +import open Prelude + +let assert condition = +if condition then () else exit 1 + +let lt (v1 : Int) (v2 : Int) = + if v1 < v2 then Less + else if v2 < v1 then Greater + else Equal + +let OrderedSet.Set {module IntSet} = OrderedSet.makeOrderedSet lt + +(* empty check *) +let x = IntSet.empty +let _ = assert (x.isEmpty) + +(* singletonSet check *) +let x = 0.singletonSet +let _ = assert (not x.isEmpty) + +(* toList check *) +let _ = assert (x.toList == [0]) + +(* insert check *) +let y = x.insert 1 +let _ = assert (y.toList == [0,1]) +let _ = assert (y.insert 2 >. toList == [0,1,2]) + +(* remove check *) +let y = y.insert 2 >. insert 3 +let _ = assert (y.remove 1 >. toList == [0,2,3]) + +(* member check *) +let _ = assert (y.member 1) +let _ = assert (not (y.member 10)) + +(* foldl/r check *) +let _ = assert (y.foldl (fn x acc => x + acc) 0 == 6) +let _ = assert (y.foldr (fn x acc => x + acc) 0 == 6) + +(* union check *) +let x = x.insert 4 >. insert 5 >. insert 6 +let _ = (y.union x >. toList == [0,1,2,3,4,5,6]) + +(* intersection check *) +let _ = assert (x.intersection y >. toList == [0]) + +(* diffrence check *) +let _ = assert (y.diffrence x >. toList == [1,2,3]) +let _ = assert (x.diffrence y >. toList == [4,5,6]) + +(* eq check *) +let _ = assert (x.eq x) +let _ = assert (not (x.eq y)) + +(* subset check *) +let _ = assert (IntSet.empty.subset x) +let _ = assert (IntSet.empty.insert 0 >. insert 1 >. subset y) +let _ = assert (not (x.subset y)) + +(* partionLt check *) +let _ = assert (fst (y.partionLt 2) >. toList == [0,1]) +let _ = assert (snd (y.partionLt 2) >. toList == [2,3]) + +(* rangeii check *) +let _ = assert (y.rangeii 1 2 >. toList == [1,2]) + +(* least check *) +let _ = assert (match y.least with | Some x => x == 0 | _ => False end) + +(* greatest check *) +let _ = assert (match y.greatest with | Some x => x == 3 | _ => False end) \ No newline at end of file diff --git a/test/stdlib/stdlib0003_Queue.fram b/test/stdlib/stdlib0003_Queue.fram new file mode 100644 index 0000000..fbab08d --- /dev/null +++ b/test/stdlib/stdlib0003_Queue.fram @@ -0,0 +1,20 @@ +import Queue + + +let assert condition = +if condition then () else exit 1 + +let compare (x : Int) (y : Int) = x == y +let get_val x = +match x with +| Some x => x +| _ => -1 +end + +let x = Queue.emptyQueue +let x = x.push 1 +let _ = assert (x.isEmpty == False && compare (get_val x.head) 1) +let x = x.pop +let _ = assert x.isEmpty +let x = x >. push 1 >. push 2 >. push 3 +let _ = assert (x.isEmpty == False && compare (get_val x.head) 1 && compare (get_val (x.pop >. head)) 2 && compare (get_val (x.pop >. pop >. head)) 3)