## digraph.pkg
#
# Simple general-purposee fully-persistent directed graph.
# This is a specialization of src/lib/src/tuplebase.pkg#
# Space usage will be dominated by Edges rather than Nodes:
#
# Each Edge will consume:
# 3 words directly
# 2 words each in 3 single-field indices.
# 4 words each in 3 double-field indices.
# 1 word each in 1 Edge-set index.
# --------------
# 22 words total. Internal heap overhead will add another 9 words or so; call it 30 words/edge == 120 bytes/edge on a 32-bit machine.
#
# So on a 32-bit machine a graph containing million edges will
# consume about 128MB -- quite reasonable on today's desktop machines.
#
# On a 64-bit machine that would be 256MB -- except Mythryl doesn't
# support 64-bit architectures yet. :-) -- 2014-07-16 CrT
# Compiled by:
# src/lib/std/standard.lib# Compare to:
# src/lib/src/digraphxy.pkg# src/lib/src/tuplebase.pkg# src/lib/graph/digraph-by-adjacency-list.pkg# src/lib/compiler/back/low/mcg/machcode-controlflow-graph-g.pkgstipulate
package im1 = int_red_black_map; # int_red_black_map is from src/lib/src/int-red-black-map.pkg package is1 = int_red_black_set; # int_red_black_set is from src/lib/src/int-red-black-set.pkgherein
package digraph
: Digraph # Digraph is from src/lib/src/digraph.api {
Other = Exception;
#
Datum = NONE
| INT Int
| ID Id
| FLOAT Float
| STRING String
| OTHER Other
| TBASE Exception # Making Datum and Graph mutually recursive would be messy, so we use the exception hack instead.
;
Node = { id: Int,
datum: Datum
};
Tag = { id: Int,
datum: Datum
};
Tagless_Edge = (Node, Node);
Edge = (Node, Tag, Node);
fun compare_i2
( ( i1a: Int,
i1b: Int
),
( i2a: Int,
i2b: Int
)
)
=
case (int::compare (i1a, i2a))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => int::compare (i1b, i2b);
esac;
fun compare_12of2
( ( { id => id1a, ... },
{ id => id1b, ... }
): Tagless_Edge,
( { id => id2a, ... },
{ id => id2b, ... }
): Tagless_Edge
)
=
case (int::compare (id1a, id2a))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => (int::compare (id1b, id2b));
esac;
fun compare_12of3
( ( { id => id1a, ... },
{ id => id1b, ... },
{ id => id1c, ... }
): Edge,
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge
)
=
case (int::compare (id1a, id2a))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => (int::compare (id1b, id2b));
esac;
fun compare_13of3
( ( { id => id1a, ... },
{ id => id1b, ... },
{ id => id1c, ... }
): Edge,
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge
)
=
case (int::compare (id1a, id2a))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => (int::compare (id1c, id2c));
esac;
fun compare_23of3
( ( { id => id1a, ... },
{ id => id1b, ... },
{ id => id1c, ... }
): Edge,
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge
)
=
case (int::compare (id1b, id2b))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => (int::compare (id1c, id2c));
esac;
fun compare_123of3
( ( { id => id1a, ... },
{ id => id1b, ... },
{ id => id1c, ... }
): Edge,
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge
)
=
case (int::compare (id1a, id2a))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => case (int::compare (id1b, id2b))
GREATER => GREATER;
LESS => LESS;
EQUAL => int::compare (id1c, id2c);
esac;
esac;
fun compare_123of3
( ( { id => id1a, ... },
{ id => id1b, ... },
{ id => id1c, ... }
): Edge,
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge
)
=
case (int::compare (id1a, id2a))
#
GREATER => GREATER;
LESS => LESS;
EQUAL => case (int::compare (id1b, id2b))
GREATER => GREATER;
LESS => LESS;
EQUAL => int::compare (id1c, id2c);
esac;
esac;
package im2
=
red_black_map_g (
#
package {
Key = (Int, Int);
#
compare = compare_i2;
}
);
package ts # Sets of Tagless_Edges
=
red_black_set_g ( # red_black_set_g is from src/lib/src/red-black-set-g.pkg #
package {
Key = Tagless_Edge;
#
compare = compare_12of2;
}
);
package es # Sets of Edges
=
red_black_set_g ( # red_black_set_g is from src/lib/src/red-black-set-g.pkg #
package {
Key = Edge;
#
compare = compare_123of3;
}
);
Graph
=
{ index_1of2: im1::Map( ts::Set ),
index_2of2: im1::Map( ts::Set ),
#
index_12of2: ts::Set,
#
#
index_1of3: im1::Map( es::Set ),
index_2of3: im1::Map( es::Set ),
index_3of3: im1::Map( es::Set ),
#
index_12of3: im2::Map( es::Set ),
index_13of3: im2::Map( es::Set ),
index_23of3: im2::Map( es::Set ),
#
index_123of3: es::Set
};
empty_graph
=
{ index_1of2 => im1::empty: im1::Map( ts::Set ),
index_2of2 => im1::empty: im1::Map( ts::Set ),
#
index_12of2 => ts::empty: ts::Set,
#
#
index_1of3 => im1::empty: im1::Map( es::Set ),
index_2of3 => im1::empty: im1::Map( es::Set ),
index_3of3 => im1::empty: im1::Map( es::Set ),
#
index_12of3 => im2::empty: im2::Map( es::Set ),
index_13of3 => im2::empty: im2::Map( es::Set ),
index_23of3 => im2::empty: im2::Map( es::Set ),
#
index_123of3 => es::empty: es::Set
};
fun put_tagless_edge
(
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph,
tagless_edge as
( { id => id1, ... },
{ id => id2, ... }
): Tagless_Edge
)
=
{ index_1of2
=
case (im1::get (index_1of2, id1))
#
THE set => im1::set (index_1of2, id1, ts::add (set, tagless_edge));
NULL => im1::set (index_1of2, id1, ts::singleton(tagless_edge));
esac;
index_2of2
=
case (im1::get (index_2of2, id2))
#
THE set => im1::set (index_2of2, id2, ts::add (set, tagless_edge));
NULL => im1::set (index_2of2, id2, ts::singleton(tagless_edge));
esac;
index_12of2
=
ts::add (index_12of2, tagless_edge);
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph;
};
fun put_edge
(
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph,
edge as
( { id => id1, ... },
{ id => id2, ... },
{ id => id3, ... }
): Edge
)
=
{ index_1of3
=
case (im1::get (index_1of3, id1))
#
THE set => im1::set (index_1of3, id1, es::add (set, edge));
NULL => im1::set (index_1of3, id1, es::singleton(edge));
esac;
index_2of3
=
case (im1::get (index_2of3, id2))
#
THE set => im1::set (index_2of3, id2, es::add (set, edge));
NULL => im1::set (index_2of3, id2, es::singleton(edge));
esac;
index_3of3
=
case (im1::get (index_3of3, id3))
#
THE set => im1::set (index_3of3, id3, es::add (set, edge));
NULL => im1::set (index_3of3, id3, es::singleton(edge));
esac;
index_12of3
=
case (im2::get (index_12of3, (id1, id2)))
#
THE set => im2::set (index_12of3, (id1, id2), es::add (set, edge));
NULL => im2::set (index_12of3, (id1, id2), es::singleton(edge));
esac;
index_13of3
=
case (im2::get (index_13of3, (id1, id3)))
#
THE set => im2::set (index_13of3, (id1, id3), es::add (set, edge));
NULL => im2::set (index_13of3, (id1, id3), es::singleton(edge));
esac;
index_23of3
=
case (im2::get (index_23of3, (id2, id3)))
#
THE set => im2::set (index_23of3, (id2, id3), es::add (set, edge));
NULL => im2::set (index_23of3, (id2, id3), es::singleton(edge));
esac;
index_123of3
=
es::add (index_123of3, edge);
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph;
};
fun drop_tagless_edge
(
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph,
tagless_edge as
( { id => id1, ... },
{ id => id2, ... }
): Tagless_Edge
)
=
{ index_1of2
=
case (im1::get (index_1of2, id1))
#
THE set => if (ts::vals_count(set) > 1) im1::set (index_1of2, id1, ts::drop (set, tagless_edge));
else im1::drop (index_1of2, id1);
fi;
NULL => index_1of2; # Tagless_Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_2of2
=
case (im1::get (index_2of2, id2))
#
THE set => if (ts::vals_count(set) > 1) im1::set (index_2of2, id2, ts::drop (set, tagless_edge));
else im1::drop (index_1of2, id2);
fi;
NULL => index_2of2; # Tagless_Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_12of2
=
ts::drop (index_12of2, tagless_edge);
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph;
};
fun drop_edge
(
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph,
edge as
( { id => id1, ... },
{ id => id2, ... },
{ id => id3, ... }
): Edge
)
=
{ index_1of3
=
case (im1::get (index_1of3, id1))
#
THE set => if (es::vals_count(set) > 1) im1::set (index_1of3, id1, es::drop (set, edge));
else im1::drop (index_1of3, id1);
fi;
NULL => index_1of3; # Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_2of3
=
case (im1::get (index_2of3, id2))
#
THE set => if (es::vals_count(set) > 1) im1::set (index_2of3, id2, es::drop (set, edge));
else im1::drop (index_2of3, id2);
fi;
NULL => index_2of3; # Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_3of3
=
case (im1::get (index_3of3, id3))
#
THE set => if (es::vals_count(set) > 1) im1::set (index_3of3, id3, es::drop (set, edge));
else im1::drop (index_3of3, id3);
fi;
NULL => index_3of3; # Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_12of3
=
case (im2::get (index_12of3, (id1, id2)))
#
THE set => if (es::vals_count(set) > 1) im2::set (index_12of3, (id1, id2), es::drop (set, edge));
else im2::drop (index_12of3, (id1, id2));
fi;
NULL => index_12of3; # Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_13of3
=
case (im2::get (index_13of3, (id1, id3)))
#
THE set => if (es::vals_count(set) > 1) im2::set (index_13of3, (id1, id3), es::drop (set, edge));
else im2::drop (index_13of3, (id1, id3));
fi;
NULL => index_13of3; # Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_23of3
=
case (im2::get (index_23of3, (id2, id3)))
#
THE set => if (es::vals_count(set) > 1) im2::set (index_23of3, (id2, id3), es::drop (set, edge));
else im2::drop (index_23of3, (id2, id3));
fi;
NULL => index_23of3; # Edge isn't in graph. Possibly we should raise an exception here.
esac;
index_123of3
=
es::drop (index_123of3, edge);
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph;
};
fun get_tagless_edges (t: Graph) = t.index_12of2;
#
fun get_tagless_edges1 (t: Graph, a: Node) = im1::get (t.index_1of2, a.id);
fun get_tagless_edges2 (t: Graph, a: Node) = im1::get (t.index_2of2, a.id);
#
fun has_tagless_edge (t: Graph, d: Tagless_Edge) = ts::member (t.index_12of2, d);
fun get_edges (t: Graph) = t.index_123of3;
#
fun get_edges1 (t: Graph, a: Node) = im1::get (t.index_1of3, a.id);
fun get_edges2 (t: Graph, a: Node) = im1::get (t.index_2of3, a.id);
fun get_edges3 (t: Graph, a: Node) = im1::get (t.index_3of3, a.id);
#
fun get_edges12 (t: Graph, a: Node, b: Node) = im2::get (t.index_12of3, (a.id, b.id));
fun get_edges13 (t: Graph, a: Node, c: Node) = im2::get (t.index_13of3, (a.id, c.id));
fun get_edges23 (t: Graph, b: Node, c: Node) = im2::get (t.index_23of3, (b.id, c.id));
#
fun has_edge (t: Graph, d: Edge) = es::member (t.index_123of3, d);
fun make_node ()
=
{ id => id_to_int (issue_unique_id ()),
datum => NONE
};
fun make_int_node (i: Int)
=
{ id => id_to_int (issue_unique_id ()),
datum => INT i
};
fun make_id_node (i: Id)
=
{ id => id_to_int (issue_unique_id ()),
datum => ID i
};
fun make_string_node (s: String)
=
{ id => id_to_int (issue_unique_id ()),
datum => STRING s
};
fun make_float_node (f: Float)
=
{ id => id_to_int (issue_unique_id ()),
datum => FLOAT f
};
fun make_other_node (x: Other)
=
{ id => id_to_int (issue_unique_id ()),
datum => OTHER x
};
exception GRAPH Graph; # Making Datum and Graph mutually recursive would be messy, so we use the exception hack instead.
fun make_graph_node (graph: Graph)
=
{ id => id_to_int (issue_unique_id ()),
datum => TBASE (GRAPH graph)
};
fun node_datum ({ datum, ... }: Node) = datum;
fun node_int ({ id, datum => INT i }: Node) => THE i;
node_int _ => NULL;
end;
fun node_id ({ id, datum => ID i }: Node) => THE i;
node_id _ => NULL;
end;
fun node_string ({ id, datum => STRING s }: Node) => THE s;
node_string _ => NULL;
end;
fun node_float ({ id, datum => FLOAT f }: Node) => THE f;
node_float _ => NULL;
end;
fun node_other ({ id, datum => OTHER x }: Node) => THE x;
node_other _ => NULL;
end;
fun node_graph ({ id, datum => TBASE (GRAPH graph) }: Node) => THE graph;
node_graph _ => NULL;
end;
fun make_tag ()
=
{ id => id_to_int (issue_unique_id ()),
datum => NONE
};
fun make_int_tag (i: Int)
=
{ id => id_to_int (issue_unique_id ()),
datum => INT i
};
fun make_id_tag (i: Id)
=
{ id => id_to_int (issue_unique_id ()),
datum => ID i
};
fun make_string_tag (s: String)
=
{ id => id_to_int (issue_unique_id ()),
datum => STRING s
};
fun make_float_tag (f: Float)
=
{ id => id_to_int (issue_unique_id ()),
datum => FLOAT f
};
fun make_other_tag (x: Other)
=
{ id => id_to_int (issue_unique_id ()),
datum => OTHER x
};
fun make_graph_tag (graph: Graph)
=
{ id => id_to_int (issue_unique_id ()),
datum => TBASE (GRAPH graph)
};
fun tag_datum ({ datum, ... }: Tag) = datum;
fun tag_int ({ id, datum => INT i }: Tag) => THE i;
tag_int _ => NULL;
end;
fun tag_id ({ id, datum => ID i }: Tag) => THE i;
tag_id _ => NULL;
end;
fun tag_string ({ id, datum => STRING s }: Tag) => THE s;
tag_string _ => NULL;
end;
fun tag_float ({ id, datum => FLOAT f }: Tag) => THE f;
tag_float _ => NULL;
end;
fun tag_other ({ id, datum => OTHER x }: Tag) => THE x;
tag_other _ => NULL;
end;
fun tag_graph ({ id, datum => TBASE (GRAPH graph) }: Tag) => THE graph;
tag_graph _ => NULL;
end;
fun nodes_apply # Apply do_node to all Nodes in Graph.
( { index_12of2,
index_123of3,
...
}: Graph
)
(do_node: Node -> Void)
=
{ ts::apply do_tagless_edge index_12of2;
es::apply do_edge index_123of3;
}
where
already_seen = REF is1::empty;
#
fun do_tagless_edge ((a1, a2): Tagless_Edge)
=
{
if (not (is1::member (*already_seen, a1.id)))
#
already_seen := is1::add (*already_seen, a1.id);
do_node a1;
fi;
if (not (is1::member (*already_seen, a2.id)))
#
already_seen := is1::add (*already_seen, a2.id);
do_node a2;
fi;
};
fun do_edge ((a1, t2, a3): Edge)
=
{
if (not (is1::member (*already_seen, a1.id)))
#
already_seen := is1::add (*already_seen, a1.id);
do_node a1;
fi;
if (not (is1::member (*already_seen, a3.id)))
#
already_seen := is1::add (*already_seen, a3.id);
do_node a3;
fi;
};
end;
fun tags_apply # Apply do_tag to all Tags in Graph.
( { index_123of3,
...
}: Graph
)
(do_tag: Tag -> Void)
=
{ es::apply do_edge index_123of3;
}
where
already_seen = REF is1::empty;
#
fun do_edge ((a1, t2, a3): Edge)
=
{
if (not (is1::member (*already_seen, t2.id)))
#
already_seen := is1::add (*already_seen, t2.id);
do_tag t2;
fi;
};
end;
};
end;