mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-09 08:18:44 +00:00
Massive renaming
This commit is contained in:
Dmitry Boulytchev
parent
241ab0a9ae
commit
61296c51e7
152 changed files with 45 additions and 29 deletions
|
|
@ -1,302 +0,0 @@
|
|||
-- Collection package.
|
||||
-- (C) Dmitry Boulytchev, JetBrains Research, St. Petersburg State University, 2020
|
||||
--
|
||||
-- This package provides a simplistic implementation of immutable set/map/hashtable
|
||||
-- data structures.
|
||||
|
||||
import List;
|
||||
import Ref;
|
||||
|
||||
fun insertColl (m, pk, v, sort) {
|
||||
local k = case sort of Hash -> hash (pk) | _ -> pk esac;
|
||||
|
||||
fun append (v, vs) {
|
||||
case sort of
|
||||
Map -> v : vs
|
||||
| Set -> v
|
||||
| Hash -> [pk, v] : vs
|
||||
esac
|
||||
}
|
||||
|
||||
fun rot (left, node) {
|
||||
if left
|
||||
then case node of
|
||||
MNode (k, v, _, l, MNode (rk, rv, _, ll, rr)) ->
|
||||
MNode (rk, rv, 0, MNode (k, v, 0, l, ll), rr)
|
||||
esac
|
||||
else case node of
|
||||
MNode (k, v, _, MNode (lk, lv, _, ll, rr), r) ->
|
||||
MNode (lk, lv, 0, ll, MNode (k, v, 0, rr, r))
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
fun factor (x) {x [2]}
|
||||
|
||||
fun inner (m) {
|
||||
case m of
|
||||
{} -> [true, MNode (k, append (v, {}), 0, {}, {})]
|
||||
| MNode (kk, vv, bf, l, r) ->
|
||||
local c = compare (k, kk);
|
||||
if c == 0
|
||||
then [false, MNode (kk, append (v, vv), bf, l, r)]
|
||||
else if c < 0
|
||||
then
|
||||
case inner (l) of
|
||||
[true, ll] -> if bf < 0
|
||||
then [false, MNode (kk, vv, bf + 1, ll, r)]
|
||||
elif bf == 1
|
||||
then if ll.factor > 0
|
||||
then [false, rot (false, MNode (kk, vv, bf, ll, r))]
|
||||
else [false, rot (false, MNode (kk, vv, bf, rot (true, ll), r))]
|
||||
fi
|
||||
else [true, MNode (kk, vv, bf + 1, ll, r)]
|
||||
fi
|
||||
| [false, ll] -> [false, MNode (kk, vv, bf, ll, r)]
|
||||
esac
|
||||
else
|
||||
case inner (r) of
|
||||
[true, rr] -> if bf > 0
|
||||
then [false, MNode (kk, vv, bf - 1, l, rr)]
|
||||
elif bf == -1
|
||||
then if rr.factor < 0
|
||||
then [false, rot (true, MNode (kk, vv, bf, l, rr))]
|
||||
else [false, rot (true, MNode (kk, vv, bf, l, rot (false, rr)))]
|
||||
fi
|
||||
else [true, MNode (kk, vv, bf - 1, l, rr)]
|
||||
fi
|
||||
| [false, rr] -> [false, MNode (kk, vv, bf, l, rr)]
|
||||
esac
|
||||
fi
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
inner (m).snd
|
||||
}
|
||||
|
||||
fun findColl (m, pk, sort) {
|
||||
local k = case sort of Hash -> hash (pk) | _ -> pk esac;
|
||||
|
||||
fun extract (vv) {
|
||||
case sort of
|
||||
Map -> case vv of v : _ -> Some (v) | _ -> None esac
|
||||
| Set -> Some (vv)
|
||||
| Hash -> case find (fun (x) {x.fst == pk}, vv) of
|
||||
Some (p) -> Some (p.snd)
|
||||
| None -> None
|
||||
esac
|
||||
esac
|
||||
}
|
||||
|
||||
fun inner (m) {
|
||||
case m of
|
||||
{} -> None
|
||||
| MNode (kk, vv, _, l, r) ->
|
||||
local c = compare (k, kk);
|
||||
if c == 0
|
||||
then extract (vv)
|
||||
else inner (if c < 0 then l else r fi)
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
inner (m)
|
||||
}
|
||||
|
||||
fun removeColl (m, pk, sort) {
|
||||
local k = case sort of Hash -> hash (pk) | _ -> pk esac;
|
||||
|
||||
fun delete (vs) {
|
||||
case sort of
|
||||
Map -> case vs of {} -> {} | _ : vv -> vv esac
|
||||
| Set -> false
|
||||
| Hash -> remove (fun (x) {x.fst == pk}, vs)
|
||||
esac
|
||||
}
|
||||
|
||||
fun inner (m) {
|
||||
case m of
|
||||
{} -> m
|
||||
| MNode (kk, vv, bf, l, r) ->
|
||||
local c = compare (k, kk);
|
||||
if c == 0
|
||||
then MNode (kk, delete (vv), bf, l, r)
|
||||
else if c < 0
|
||||
then MNode (kk, vv, bf, inner (l), r)
|
||||
else MNode (kk, vv, bf, l, inner (r))
|
||||
fi
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
inner (m)
|
||||
}
|
||||
|
||||
fun contents (m, sort) {
|
||||
fun append (k, vs, acc) {
|
||||
case sort of
|
||||
Map -> 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
|
||||
| MNode (k, vv, _, l, r) -> inner (l, append (k, vv, inner (r, acc)))
|
||||
esac
|
||||
}
|
||||
|
||||
inner (m, {})
|
||||
}
|
||||
|
||||
public fun validateColl (t) {
|
||||
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});
|
||||
|
||||
if bf == lh - rh
|
||||
then 1 + if lh > rh then lh else rh fi
|
||||
else failure ("Collection::validateColl: balance violation on key %s\n", k.string)
|
||||
fi
|
||||
else failure ("Collection::validateColl: order violation on key %s\n", k.string)
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
inner (t, fun (x) {true})
|
||||
}
|
||||
|
||||
-- Map structure
|
||||
public fun emptyMap () {
|
||||
{}
|
||||
}
|
||||
|
||||
public fun addMap (m, k, v) {
|
||||
insertColl (m, k, v, Map)
|
||||
}
|
||||
|
||||
public fun findMap (m, k) {
|
||||
findColl (m, k, Map)
|
||||
}
|
||||
|
||||
public fun removeMap (m, k) {
|
||||
removeColl (m, k, Map)
|
||||
}
|
||||
|
||||
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 iterMap (f, m) {
|
||||
iter (f, bindings (m))
|
||||
}
|
||||
|
||||
public fun mapMap (f, m) {
|
||||
listMap (map (fun (p) {[p.fst, f (p.snd)]}, bindings (m)))
|
||||
}
|
||||
|
||||
public fun foldMap (f, acc, m) {
|
||||
foldl (f, acc, bindings (m))
|
||||
}
|
||||
|
||||
-- Set structure
|
||||
public fun emptySet () {
|
||||
{}
|
||||
}
|
||||
|
||||
public fun addSet (s, v) {
|
||||
insertColl (s, v, true, Set)
|
||||
}
|
||||
|
||||
public fun memSet (s, v) {
|
||||
case findColl (s, v, Set) of
|
||||
None -> false
|
||||
| Some (f) -> f
|
||||
esac
|
||||
}
|
||||
|
||||
public fun removeSet (s, v) {
|
||||
removeColl (s, v, Set)
|
||||
}
|
||||
|
||||
public fun elements (m) {
|
||||
contents (m, Set)
|
||||
}
|
||||
|
||||
public fun union (a, b) {
|
||||
foldl (addSet, a, elements (b))
|
||||
}
|
||||
|
||||
public fun diff (a, b) {
|
||||
foldl (removeSet, a, elements (b))
|
||||
}
|
||||
|
||||
public fun listSet (l) {
|
||||
foldl (addSet, emptySet (), l)
|
||||
}
|
||||
|
||||
public fun iterSet (f, s) {
|
||||
iter (f, elements (s))
|
||||
}
|
||||
|
||||
public fun mapSet (f, s) {
|
||||
listSet (map (f, elements (s)))
|
||||
}
|
||||
|
||||
public fun foldSet (f, acc, s) {
|
||||
foldl (f, acc, elements (s))
|
||||
}
|
||||
|
||||
-- Hash consing
|
||||
public fun emptyMemo () {
|
||||
ref ({})
|
||||
}
|
||||
|
||||
public fun lookupMemo (m, v) {
|
||||
case v of
|
||||
#unboxed -> v
|
||||
| _ ->
|
||||
case findMap (deref (m), v) of
|
||||
Some (w) -> w
|
||||
| None ->
|
||||
case v of
|
||||
#string -> m ::= addMap (deref (m), v, v); v
|
||||
| _ ->
|
||||
local vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac;
|
||||
for skip, i < v.length, i := i + 1 do
|
||||
vc [i] := lookupMemo (m, vc [i])
|
||||
od;
|
||||
m ::= addMap (deref (m), vc, vc);
|
||||
vc
|
||||
esac
|
||||
esac
|
||||
esac
|
||||
}
|
||||
|
||||
-- Maps of hashed pointers
|
||||
public fun emptyHashTab () {
|
||||
{}
|
||||
}
|
||||
|
||||
public fun addHashTab (t, k, v) {
|
||||
insertColl (t, k, v, Hash)
|
||||
}
|
||||
|
||||
public fun findHashTab (t, k) {
|
||||
findColl (t, k, Hash)
|
||||
}
|
||||
|
||||
public fun removeHashTab (t, k) {
|
||||
removeColl (t, k, Hash)
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue