mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-05 22:38:44 +00:00
Stdlib:Data
This commit is contained in:
Dmitry Boulytchev
parent
f6d4a475b4
commit
026158923f
12 changed files with 314 additions and 200 deletions
|
|
@ -49,3 +49,4 @@ F,random;
|
|||
F,time;
|
||||
F,rawTag;
|
||||
F,compareTags;
|
||||
F,flatCompare;
|
||||
|
|
|
|||
|
|
@ -239,10 +239,7 @@ int Ls__Infix_3838 (void *p, void *q) {
|
|||
|
||||
// Functional synonym for built-in operator "==";
|
||||
int Ls__Infix_6161 (void *p, void *q) {
|
||||
ASSERT_UNBOXED("captured ==:1", p);
|
||||
ASSERT_UNBOXED("captured ==:2", q);
|
||||
|
||||
return BOX(UNBOX(p) == UNBOX(q));
|
||||
return BOX(p == q);
|
||||
}
|
||||
|
||||
// Functional synonym for built-in operator "!=";
|
||||
|
|
@ -295,10 +292,13 @@ int Ls__Infix_43 (void *p, void *q) {
|
|||
|
||||
// Functional synonym for built-in operator "-";
|
||||
int Ls__Infix_45 (void *p, void *q) {
|
||||
ASSERT_UNBOXED("captured -:1", p);
|
||||
ASSERT_UNBOXED("captured -:2", q);
|
||||
if (UNBOXED(p)) {
|
||||
ASSERT_UNBOXED("captured -:2", q);
|
||||
return BOX(UNBOX(p) - UNBOX(q));
|
||||
}
|
||||
|
||||
return BOX(UNBOX(p) - UNBOX(q));
|
||||
ASSERT_BOXED("captured -:1", q);
|
||||
return BOX(p - q);
|
||||
}
|
||||
|
||||
// Functional synonym for built-in operator "*";
|
||||
|
|
@ -752,7 +752,21 @@ extern void* LstringInt (char *b) {
|
|||
}
|
||||
|
||||
extern int Lhash (void *p) {
|
||||
return BOX(inner_hash (0, 0, p));
|
||||
return BOX(0x3fffff & inner_hash (0, 0, p));
|
||||
}
|
||||
|
||||
extern int LflatCompare (void *p, void *q) {
|
||||
if (UNBOXED(p)) {
|
||||
if (UNBOXED(q)) {
|
||||
return BOX (UNBOX(p) - UNBOX(q));
|
||||
}
|
||||
|
||||
return -1;
|
||||
}
|
||||
else if (~UNBOXED(q)) {
|
||||
return BOX(p - q);
|
||||
}
|
||||
else BOX(1);
|
||||
}
|
||||
|
||||
extern int Lcompare (void *p, void *q) {
|
||||
|
|
@ -1498,7 +1512,7 @@ extern void __gc_root_scan_stack ();
|
|||
/* ======================================== */
|
||||
|
||||
//static size_t SPACE_SIZE = 16;
|
||||
static size_t SPACE_SIZE = 32 * 1024 * 1024;
|
||||
static size_t SPACE_SIZE = 64 * 1024 * 1024;
|
||||
// static size_t SPACE_SIZE = 128;
|
||||
// static size_t SPACE_SIZE = 1024 * 1024;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,8 +6,9 @@
|
|||
|
||||
import List;
|
||||
import Ref;
|
||||
import Array;
|
||||
|
||||
fun printColl (m) {
|
||||
fun printColl ([m, _]) {
|
||||
fun inner (off, curr) {
|
||||
printf (off);
|
||||
case curr of
|
||||
|
|
@ -25,21 +26,21 @@ fun printColl (m) {
|
|||
inner ("", m)
|
||||
}
|
||||
|
||||
public fun validateColl (t) {
|
||||
public fun validateColl ([t, compare]) {
|
||||
fun inner (t, verify) {
|
||||
case t of
|
||||
{} -> 0
|
||||
| MNode (k, _, bf, l, r) ->
|
||||
if verify (k)
|
||||
then
|
||||
local lh = validateColl (l, fun (x) {x < k}),
|
||||
rh = validateColl (r, fun (x) {x > k});
|
||||
local lh = inner (l, fun (x) {compare (x, k) < 0}),
|
||||
rh = inner (r, fun (x) {compare (x, k) > 0});
|
||||
|
||||
if bf == lh - rh
|
||||
then 1 + if lh > rh then lh else rh fi
|
||||
else failure ("Collection::validateColl: balance violation on key %s\nTree: %s\n", k.string, t.string) -- 1 + if lh > rh then lh else rh fi
|
||||
else failure ("Collection.validateColl: balance violation on key %s\nTree: %s\n", k.string, t.string)
|
||||
fi
|
||||
else failure ("Collection::validateColl: order violation on key %s\nTree: %s\n", k.string, t.string)
|
||||
else failure ("Collection.validateColl: order violation on key %s\nTree: %s\n", k.string, t.string)
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
|
@ -47,35 +48,11 @@ public fun validateColl (t) {
|
|||
inner (t, fun (x) {true})
|
||||
}
|
||||
|
||||
fun makeCompare (sort) {
|
||||
fun c (x, y) {
|
||||
if x == y then 0
|
||||
elif x < y then -1
|
||||
else 1
|
||||
fi
|
||||
}
|
||||
|
||||
case sort of
|
||||
Hash -> c
|
||||
| Ptr -> c
|
||||
| _ -> compare
|
||||
esac
|
||||
}
|
||||
|
||||
fun insertColl (m, pk, v, sort) {
|
||||
local compareKeys = makeCompare (sort),
|
||||
k = case sort of Hash -> hash (pk) | _ -> pk esac;
|
||||
|
||||
fun insertColl ([m, compare], pk, v, sort) {
|
||||
fun append (v, vs) {
|
||||
case sort of
|
||||
Map -> v : vs
|
||||
| Ptr -> v : vs
|
||||
| Set -> v
|
||||
| Hash ->
|
||||
case find (fun (x) {compare (x, [pk, v]) == 0}, vs) of
|
||||
Some (_) -> vs
|
||||
| None -> [pk, v] : vs
|
||||
esac
|
||||
esac
|
||||
}
|
||||
|
||||
|
|
@ -116,9 +93,9 @@ fun insertColl (m, pk, v, sort) {
|
|||
|
||||
fun inner (m) {
|
||||
case m of
|
||||
{} -> [true, MNode (k, append (v, {}), 0, {}, {})]
|
||||
{} -> [true, MNode (pk, append (v, {}), 0, {}, {})]
|
||||
| MNode (kk, vv, bf, l, r) ->
|
||||
local c = compareKeys (k, kk);
|
||||
local c = compare (pk, kk);
|
||||
if c == 0
|
||||
then [false, MNode (kk, append (v, vv), bf, l, r)]
|
||||
else if c < 0
|
||||
|
|
@ -153,22 +130,14 @@ fun insertColl (m, pk, v, sort) {
|
|||
esac
|
||||
}
|
||||
|
||||
inner (m).snd
|
||||
[inner (m).snd, compare]
|
||||
}
|
||||
|
||||
fun findColl (m, pk, sort) {
|
||||
local compareKeys = makeCompare (sort),
|
||||
k = case sort of Hash -> hash (pk) | _ -> pk esac;
|
||||
|
||||
fun findColl ([m, compare], pk, sort) {
|
||||
fun extract (vv) {
|
||||
case sort of
|
||||
Map -> case vv of v : _ -> Some (v) | _ -> None esac
|
||||
| Ptr -> case vv of v : _ -> Some (v) | _ -> None esac
|
||||
| Set -> Some (vv)
|
||||
| Hash -> case find (fun (x) {compare (x.fst, pk) == 0}, vv) of
|
||||
Some (p) -> Some (p.snd)
|
||||
| None -> None
|
||||
esac
|
||||
esac
|
||||
}
|
||||
|
||||
|
|
@ -176,7 +145,7 @@ fun findColl (m, pk, sort) {
|
|||
case m of
|
||||
{} -> None
|
||||
| MNode (kk, vv, _, l, r) ->
|
||||
local c = compareKeys (k, kk);
|
||||
local c = compare (pk, kk);
|
||||
if c == 0
|
||||
then extract (vv)
|
||||
else inner (if c < 0 then l else r fi)
|
||||
|
|
@ -187,16 +156,11 @@ fun findColl (m, pk, sort) {
|
|||
inner (m)
|
||||
}
|
||||
|
||||
fun removeColl (m, pk, sort) {
|
||||
local compareKeys = makeCompare (sort),
|
||||
k = case sort of Hash -> hash (pk) | _ -> pk esac;
|
||||
|
||||
fun removeColl ([m, compare], pk, sort) {
|
||||
fun delete (vs) {
|
||||
case sort of
|
||||
Map -> case vs of {} -> {} | _ : vv -> vv esac
|
||||
| Ptr -> case vs of {} -> {} | _ : vv -> vv esac
|
||||
| Set -> false
|
||||
| Hash -> remove (fun (x) {x.fst == pk}, vs)
|
||||
esac
|
||||
}
|
||||
|
||||
|
|
@ -204,7 +168,7 @@ fun removeColl (m, pk, sort) {
|
|||
case m of
|
||||
{} -> m
|
||||
| MNode (kk, vv, bf, l, r) ->
|
||||
local c = compareKeys (k, kk);
|
||||
local c = compare (pk, kk);
|
||||
if c == 0
|
||||
then MNode (kk, delete (vv), bf, l, r)
|
||||
else if c < 0
|
||||
|
|
@ -215,21 +179,20 @@ fun removeColl (m, pk, sort) {
|
|||
esac
|
||||
}
|
||||
|
||||
inner (m)
|
||||
[inner (m), compare]
|
||||
}
|
||||
|
||||
fun contents (m, sort) {
|
||||
fun contents ([m, _], sort) {
|
||||
fun append (k, vs, acc) {
|
||||
case sort of
|
||||
Map -> case vs of {} -> acc | v : _ -> [k, v] : acc esac
|
||||
| Ptr -> case vs of {} -> acc | v : _ -> [k, v] : acc esac
|
||||
| Set -> if vs then k : acc else acc fi
|
||||
esac
|
||||
}
|
||||
|
||||
fun inner (m, acc) {
|
||||
case m of
|
||||
{} -> acc
|
||||
{} -> acc
|
||||
| MNode (k, vv, _, l, r) -> inner (l, append (k, vv, inner (r, acc)))
|
||||
esac
|
||||
}
|
||||
|
|
@ -237,22 +200,18 @@ fun contents (m, sort) {
|
|||
inner (m, {})
|
||||
}
|
||||
|
||||
-- Map on raw pointers (experimental)
|
||||
public fun emptyPtrMap () {
|
||||
{}
|
||||
-- Accessors
|
||||
public fun internalOf (m) {
|
||||
m [0]
|
||||
}
|
||||
|
||||
public fun addPtrMap (m, k, v) {
|
||||
insertColl (m, k, v, Ptr)
|
||||
}
|
||||
|
||||
public fun findPtrMap (m, k) {
|
||||
findColl (m, k, Ptr)
|
||||
public fun compareOf (m) {
|
||||
m [1]
|
||||
}
|
||||
|
||||
-- Map structure
|
||||
public fun emptyMap () {
|
||||
{}
|
||||
public fun emptyMap (compare) {
|
||||
[{}, compare]
|
||||
}
|
||||
|
||||
public fun addMap (m, k, v) {
|
||||
|
|
@ -271,8 +230,8 @@ public fun bindings (m) {
|
|||
contents (m, Map)
|
||||
}
|
||||
|
||||
public fun listMap (l) {
|
||||
foldl (fun (m, p) {addMap (m, p.fst, p.snd)}, emptyMap (), l)
|
||||
public fun listMap (l, compare) {
|
||||
foldl (fun (m, p) {addMap (m, p.fst, p.snd)}, emptyMap (compare), l)
|
||||
}
|
||||
|
||||
public fun iterMap (f, m) {
|
||||
|
|
@ -280,7 +239,7 @@ public fun iterMap (f, m) {
|
|||
}
|
||||
|
||||
public fun mapMap (f, m) {
|
||||
listMap (map (fun (p) {[p.fst, f (p.snd)]}, bindings (m)))
|
||||
listMap (map (fun (p) {[p.fst, f (p.snd)]}, bindings (m)), m[1])
|
||||
}
|
||||
|
||||
public fun foldMap (f, acc, m) {
|
||||
|
|
@ -288,8 +247,8 @@ public fun foldMap (f, acc, m) {
|
|||
}
|
||||
|
||||
-- Set structure
|
||||
public fun emptySet () {
|
||||
{}
|
||||
public fun emptySet (compare) {
|
||||
[{}, compare]
|
||||
}
|
||||
|
||||
public fun addSet (s, v) {
|
||||
|
|
@ -319,8 +278,8 @@ public fun diff (a, b) {
|
|||
foldl (removeSet, a, elements (b))
|
||||
}
|
||||
|
||||
public fun listSet (l) {
|
||||
foldl (addSet, emptySet (), l)
|
||||
public fun listSet (l, compare) {
|
||||
foldl (addSet, emptySet (compare), l)
|
||||
}
|
||||
|
||||
public fun iterSet (f, s) {
|
||||
|
|
@ -328,7 +287,7 @@ public fun iterSet (f, s) {
|
|||
}
|
||||
|
||||
public fun mapSet (f, s) {
|
||||
listSet (map (f, elements (s)))
|
||||
listSet (map (f, elements (s)),s[1])
|
||||
}
|
||||
|
||||
public fun foldSet (f, acc, s) {
|
||||
|
|
@ -337,7 +296,7 @@ public fun foldSet (f, acc, s) {
|
|||
|
||||
-- Hash consing
|
||||
public fun emptyMemo () {
|
||||
ref ({})
|
||||
ref (emptyMap (compare))
|
||||
}
|
||||
|
||||
public fun lookupMemo (m, v) {
|
||||
|
|
@ -363,18 +322,29 @@ public fun lookupMemo (m, v) {
|
|||
}
|
||||
|
||||
-- Maps of hashed pointers
|
||||
public fun emptyHashTab () {
|
||||
{}
|
||||
public fun emptyHashTab (n, hash, compare) {
|
||||
[initArray (n, fun (_) {{}}), fun (x) {hash (x) % n}, compare]
|
||||
}
|
||||
|
||||
public fun addHashTab (t, k, v) {
|
||||
insertColl (t, k, v, Hash)
|
||||
public fun addHashTab (ht@[a, hash, compare], k, v) {
|
||||
local h = hash (k);
|
||||
|
||||
a [h] := [k, v] : a [h];
|
||||
|
||||
ht
|
||||
}
|
||||
|
||||
public fun findHashTab (t, k) {
|
||||
findColl (t, k, Hash)
|
||||
public fun findHashTab ([a, hash, compare], k) {
|
||||
case find (fun ([k0, _]) {compare (k, k0) == 0}, a[hash(k)]) of
|
||||
Some ([_, v]) -> Some (v)
|
||||
| _ -> None
|
||||
esac
|
||||
}
|
||||
|
||||
public fun removeHashTab (t, k) {
|
||||
removeColl (t, k, Hash)
|
||||
}
|
||||
public fun removeHashTab (ht@[a, hash, compare], k) {
|
||||
local h = hash (k);
|
||||
|
||||
a [h] := remove (fun ([k0, _]) {compare (k, k0) == 0}, a [h]);
|
||||
|
||||
ht
|
||||
}
|
||||
92
stdlib/Data.lama
Normal file
92
stdlib/Data.lama
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
-- Data.
|
||||
-- (C) Dmitry Boulytchev, JetBrains Research, St. Petersburg State University, 2020
|
||||
--
|
||||
-- This unit provides a set of generic operations on data structures.
|
||||
|
||||
import Collection;
|
||||
import Ref;
|
||||
|
||||
-- Generic comparison for shared/cyclic data structures
|
||||
public infix =?= at < (x, y) {
|
||||
local m = ref (emptyMap (flatCompare));
|
||||
|
||||
fun alreadyEq (x, y) {
|
||||
fun find (x) {
|
||||
fun walk (r) {
|
||||
case r of
|
||||
[#unboxed] -> r
|
||||
| [x] -> walk (x)
|
||||
esac
|
||||
}
|
||||
|
||||
case findMap (deref (m), x) of
|
||||
Some (r) -> Some (walk (r))
|
||||
| x -> x
|
||||
esac
|
||||
}
|
||||
|
||||
case [find (x), find (y)] of
|
||||
[None, None] ->
|
||||
local v = [1];
|
||||
m ::= addMap (addMap (deref (m), x, v), y, v);
|
||||
false
|
||||
|
||||
| [None, Some (ry)] ->
|
||||
m ::= addMap (deref (m), x, ry);
|
||||
false
|
||||
|
||||
| [Some (rx), None] ->
|
||||
m ::= addMap (deref (m), y, rx);
|
||||
false
|
||||
|
||||
| [Some (rx), Some (ry)] ->
|
||||
if rx == ry
|
||||
then true
|
||||
else
|
||||
rx [0] := ry;
|
||||
false
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
fun cmpargs (x, y, from) {
|
||||
local diff = x.length - y.length;
|
||||
|
||||
for local i = from;, i < x.length && diff == 0, i := i + 1 do
|
||||
diff := cmprec (x[i], y[i])
|
||||
od;
|
||||
|
||||
diff
|
||||
}
|
||||
|
||||
fun cmprec (x, y) {
|
||||
if alreadyEq (x, y)
|
||||
then 0
|
||||
else
|
||||
local diff = x.rawTag - y.rawTag;
|
||||
|
||||
if diff != 0 then diff
|
||||
else
|
||||
case x of
|
||||
#array -> cmpargs (x, y, 0)
|
||||
| #fun -> if (diff := x[0] - y[0]) == 0
|
||||
then cmpargs (x, y, 1)
|
||||
else diff
|
||||
fi
|
||||
| #sexp -> if (diff := compareTags (x, y)) == 0
|
||||
then cmpargs (x, y, 0)
|
||||
else diff
|
||||
fi
|
||||
| _ -> compare (x, y)
|
||||
esac
|
||||
fi
|
||||
fi
|
||||
}
|
||||
|
||||
cmprec (x, y)
|
||||
}
|
||||
|
||||
-- Generic equaliry for shared/cyclic data structures
|
||||
public infix === at == (x, y) {
|
||||
(x =?= y) == 0
|
||||
}
|
||||
|
|
@ -8,6 +8,8 @@ all: $(ALL)
|
|||
|
||||
Fun.o: Ref.o
|
||||
|
||||
Data.o: Ref.o Collection.o
|
||||
|
||||
Collection.o: List.o Ref.o
|
||||
|
||||
Array.o: List.o
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ public fun logOn () {
|
|||
}
|
||||
|
||||
public fun initOstap () {
|
||||
tab := ref (emptyHashTab ());
|
||||
tab := ref (emptyHashTab (1024, hash, compare));
|
||||
restab := emptyMemo ();
|
||||
hct := emptyMemo ()
|
||||
}
|
||||
|
|
@ -29,7 +29,7 @@ public fun memo (f) {
|
|||
|
||||
case findHashTab (deref (tab), f) of
|
||||
None -> if log then printf ("new table...\n") fi;
|
||||
tab ::= addHashTab (deref (tab), f, ref (emptyMap ()))
|
||||
tab ::= addHashTab (deref (tab), f, ref (emptyMap (compare)))
|
||||
|
||||
| Some (tt) -> skip
|
||||
esac;
|
||||
|
|
@ -43,7 +43,7 @@ public fun memo (f) {
|
|||
if log then printf ("Applying memoized parser to %s\n", s.string) fi;
|
||||
case findMap (deref (t), s) of
|
||||
None ->
|
||||
t ::= addMap (deref (t), s, [addSet (emptySet (), k), emptySet ()]);
|
||||
t ::= addMap (deref (t), s, [addSet (emptySet (compare), k), emptySet (compare)]);
|
||||
f (fun (r) {
|
||||
r := lookupMemo (restab, r);
|
||||
if log then printf ("Running continuation with result %s\n", r.string) fi;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
HashTab internal structure: MNode (-624426958, {[{1, 2, 3}, 100]}, 0, 0, 0)
|
||||
HashTab internal structure: MNode (-624426958, {[{1, 2, 3}, 200], [{1, 2, 3}, 100]}, 0, 0, 0)
|
||||
HashTab internal structure: [0, 0, {[{1, 2, 3}, 100]}, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
|
||||
HashTab internal structure: [0, 0, {[{1, 2, 3}, 200], [{1, 2, 3}, 100]}, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
|
||||
Searching: Some (200)
|
||||
Searching: Some (200)
|
||||
Replaced: Some (800)
|
||||
|
|
|
|||
|
|
@ -98,3 +98,103 @@
|
|||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
1
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
import Collection;
|
||||
|
||||
local s = emptySet (), i;
|
||||
local s = emptySet (compare), i;
|
||||
|
||||
for i := 0, i < 100, i := i+1
|
||||
do
|
||||
|
|
@ -8,7 +8,7 @@ do
|
|||
validateColl (s)
|
||||
od;
|
||||
|
||||
printf ("Set internal structure: %s\n", s.string);
|
||||
printf ("Set internal structure: %s\n", internalOf (s).string);
|
||||
printf ("Set elements: %s\n", elements (s).string);
|
||||
|
||||
for i := 0, i < 100, i := i+1
|
||||
|
|
@ -23,7 +23,7 @@ do
|
|||
validateColl (s)
|
||||
od;
|
||||
|
||||
printf ("Set internal structure: %s\n", s.string);
|
||||
printf ("Set internal structure: %s\n", internalOf (s).string);
|
||||
printf ("Set elements: %s\n", elements (s).string);
|
||||
|
||||
for i := 0, i < 100, i := i+1
|
||||
|
|
@ -31,20 +31,20 @@ do
|
|||
printf ("Testing %-3d => %d\n", i, memSet (s, i))
|
||||
od;
|
||||
|
||||
printf ("List set: %s\n", listSet ({1, 2, 3, 4, 5}).string);
|
||||
printf ("List set: %s\n", internalOf (listSet ({1, 2, 3, 4, 5}, compare)).string);
|
||||
|
||||
{
|
||||
local u = union (listSet ({1, 2, 3, 4, 5}), listSet ({11, 22, 33, 44, 55})), u1;
|
||||
local u = union (listSet ({1, 2, 3, 4, 5}, compare), listSet ({11, 22, 33, 44, 55}, compare)), u1;
|
||||
|
||||
validateColl (u);
|
||||
|
||||
printf ("Set union: %s\n", u.string);
|
||||
printf ("Set union: %s\n", internalOf (u).string);
|
||||
printf ("Elements: %s\n", elements (u).string);
|
||||
|
||||
u1 := diff (u, listSet ({1, 22, 3, 44, 5}));
|
||||
u1 := diff (u, listSet ({1, 22, 3, 44, 5}, compare));
|
||||
validateColl (u1);
|
||||
|
||||
printf ("Set difference: %s\n", u1.string);
|
||||
printf ("Set difference: %s\n", internalOf (u1).string);
|
||||
printf ("Elements: %s\n", elements (u1).string)
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
import Collection;
|
||||
|
||||
local s = emptyMap (), i;
|
||||
local s = emptyMap (compare), i;
|
||||
|
||||
for i := 0, i < 100, i := i+1
|
||||
do
|
||||
|
|
@ -8,7 +8,7 @@ do
|
|||
validateColl (s)
|
||||
od;
|
||||
|
||||
printf ("Map internal structure: %s\n", s.string);
|
||||
printf ("Map internal structure: %s\n", internalOf (s).string);
|
||||
printf ("Map elements: %s\n", bindings (s).string);
|
||||
|
||||
for i := 0, i < 100, i := i+1
|
||||
|
|
@ -23,7 +23,7 @@ do
|
|||
validateColl (s)
|
||||
od;
|
||||
|
||||
printf ("Map internal structure: %s\n", s.string);
|
||||
printf ("Map internal structure: %s\n", internalOf (s).string);
|
||||
printf ("Map elements: %s\n", bindings (s).string);
|
||||
|
||||
for i := 0, i < 100, i := i+1
|
||||
|
|
@ -31,4 +31,4 @@ do
|
|||
printf ("Testing %-3d => %s\n", i, findMap (s, i).string)
|
||||
od;
|
||||
|
||||
printf ("List map: %s\n", listMap ({[1, 10], [2, 20], [3, 30], [4, 40], [5, 50]}).string)
|
||||
printf ("List map: %s\n", internalOf (listMap ({[1, 10], [2, 20], [3, 30], [4, 40], [5, 50]}, compare)).string)
|
||||
|
|
@ -1,25 +1,21 @@
|
|||
import Collection;
|
||||
|
||||
local a = {1, 2, 3}, b = {1, 2, 3}, t = emptyHashTab ();
|
||||
local a = {1, 2, 3}, b = {1, 2, 3}, t = emptyHashTab (16, hash, compare);
|
||||
|
||||
t := addHashTab (t, a, 100);
|
||||
validateColl (t);
|
||||
printf ("HashTab internal structure: %s\n", t.string);
|
||||
printf ("HashTab internal structure: %s\n", internalOf (t).string);
|
||||
|
||||
t := addHashTab (t, b, 200);
|
||||
validateColl (t);
|
||||
printf ("HashTab internal structure: %s\n", t.string);
|
||||
printf ("HashTab internal structure: %s\n", internalOf (t).string);
|
||||
|
||||
printf ("Searching: %s\n", findHashTab (t, a).string);
|
||||
printf ("Searching: %s\n", findHashTab (t, b).string);
|
||||
|
||||
t := addHashTab (t, a, 800);
|
||||
validateColl (t);
|
||||
|
||||
printf ("Replaced: %s\n", findHashTab (t, a).string);
|
||||
|
||||
t := removeHashTab (t, a);
|
||||
validateColl (t);
|
||||
printf ("Restored: %s\n", findHashTab (t, a).string)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -3,83 +3,7 @@ import Ref;
|
|||
import Random;
|
||||
import Array;
|
||||
import Fun;
|
||||
|
||||
local m = emptyPtrMap ();
|
||||
|
||||
fun eq (x, y) {
|
||||
local m = ref (emptyPtrMap ());
|
||||
|
||||
fun alreadyEq (x, y) {
|
||||
fun find (x) {
|
||||
fun walk (r) {
|
||||
case r of
|
||||
[#unboxed] -> r
|
||||
| [x] -> walk (x)
|
||||
esac
|
||||
}
|
||||
|
||||
case findPtrMap (deref (m), x) of
|
||||
Some (r) -> Some (walk (r))
|
||||
| x -> x
|
||||
esac
|
||||
}
|
||||
|
||||
case [find (x), find (y)] of
|
||||
[None, None] ->
|
||||
local v = [1];
|
||||
m ::= addPtrMap (addPtrMap (deref (m), x, v), y, v);
|
||||
false
|
||||
|
||||
| [None, Some (ry)] ->
|
||||
m ::= addPtrMap (deref (m), x, ry);
|
||||
false
|
||||
|
||||
| [Some (rx), None] ->
|
||||
m ::= addPtrMap (deref (m), y, rx);
|
||||
false
|
||||
|
||||
| [Some (rx), Some (ry)] ->
|
||||
if rx == ry
|
||||
then true
|
||||
else
|
||||
rx [0] := ry;
|
||||
false
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
fun eqargs (x, y, from) {
|
||||
local continue = true;
|
||||
|
||||
if x.length != y.length
|
||||
then false
|
||||
else
|
||||
for local i = from;, i<x.length && continue, i := i + 1 do
|
||||
continue := eqrec (x[i], y[i])
|
||||
od;
|
||||
|
||||
continue
|
||||
fi
|
||||
}
|
||||
|
||||
fun eqrec (x, y) {
|
||||
if alreadyEq (x, y)
|
||||
then true
|
||||
else
|
||||
if rawTag (x) != rawTag (y) then false
|
||||
else
|
||||
case x of
|
||||
#array -> eqargs (x, y, 0)
|
||||
| #fun -> if x[0] == y[0] then eqargs (x, y, 1) else false fi
|
||||
| #sexp -> if compareTags (x, y) == 0 then eqargs (x, y, 0) else false fi
|
||||
| _ -> compare (x, y) == 0
|
||||
esac
|
||||
fi
|
||||
fi
|
||||
}
|
||||
|
||||
eqrec (x, y)
|
||||
}
|
||||
import Data;
|
||||
|
||||
fun genCyclicArrays (n, eq, cross) {
|
||||
local f = ref (true);
|
||||
|
|
@ -154,34 +78,49 @@ fun genCyclicArrays (n, eq, cross) {
|
|||
genrec (n, [], [], 0)
|
||||
}
|
||||
|
||||
fun normalize (x) {
|
||||
if x < 0 then -1
|
||||
elif x > 0 then 1
|
||||
else 0
|
||||
fi
|
||||
}
|
||||
|
||||
fun not (x) {0 - x}
|
||||
|
||||
disableGC ();
|
||||
|
||||
for local i=0;, i<25, i:=i+1
|
||||
do
|
||||
case genCyclicArrays (1000, true, false) of
|
||||
[a, _] -> printf ("%d\n", eq (a, a) == true)
|
||||
| [a, b] -> printf ("%d\n", eq (a, b) == true)
|
||||
[a, b] ->
|
||||
printf ("%d\n", (a =?= a) == 0);
|
||||
printf ("%d\n", (a =?= b) == 0)
|
||||
esac
|
||||
od;
|
||||
|
||||
for local i=0;, i<25, i:=i+1
|
||||
do
|
||||
case genCyclicArrays (1000, true, true) of
|
||||
[a, _] -> printf ("%d\n", eq (a, a) == true)
|
||||
| [a, b] -> printf ("%d\n", eq (a, b) == true)
|
||||
[a, b] ->
|
||||
printf ("%d\n", (a =?= a) == 0);
|
||||
printf ("%d\n", (a =?= b) == 0)
|
||||
esac
|
||||
od;
|
||||
|
||||
for local i=0;, i<25, i:=i+1
|
||||
do
|
||||
case genCyclicArrays (1000, false, false) of
|
||||
[a, b] -> printf ("%d\n", eq (a, b) == false)
|
||||
[a, b] -> local x = normalize (a =?= b);
|
||||
printf ("%d\n", x != 0);
|
||||
printf ("%d\n", not (x) == normalize (b =?= a))
|
||||
esac
|
||||
od;
|
||||
|
||||
for local i=0;, i<25, i:=i+1
|
||||
do
|
||||
case genCyclicArrays (1000, false, true) of
|
||||
[a, b] -> printf ("%d\n", eq (a, b) == false)
|
||||
[a, b] -> local x = normalize (a =?= b);
|
||||
printf ("%d\n", x != 0);
|
||||
printf ("%d\n", not (x) == normalize (b =?= a))
|
||||
esac
|
||||
od
|
||||
Loading…
Add table
Add a link
Reference in a new issue