## digraphxy.pkg
#
# Just like src/lib/src/digraph.pkg# except Node(N) replaces Node,
# and Tag(T) replaces Tag (etc),
# thus allowing arbitrary user data
# to be attached to Nodes and Tags
# without using the exception hack.
# Also, we don't directly support
# subgraphs, because I can't make the
# types work for that.
# Compiled by:
# src/lib/std/standard.lib# Compare to:
# src/lib/src/digraph.pkg# src/lib/src/tuplebasex.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 digraphxy
: Digraphxy # Digraphxy is from src/lib/src/digraphxy.api {
Node_Datum(N) = NNONE
| NINT Int
| NID Id
| NFLOAT Float
| NSTRING String
| NOTHER N
;
Node(N) = { id: Int,
datum: Node_Datum(N)
};
Tag_Datum(T) = TNONE
| TINT Int
| TID Id
| TFLOAT Float
| TSTRING String
| TOTHER T
;
Tag(T) = { id: Int,
datum: Tag_Datum(T)
};
Tagless_Edge(N) = (Node(N), Node(N));
Edge(N,T) = (Node(N), Tag(T), Node(N));
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(N),
( { id => id2a, ... },
{ id => id2b, ... }
): Tagless_Edge(N)
)
=
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(N,T),
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge(N,T)
)
=
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(N,T),
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge(N,T)
)
=
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(N,T),
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge(N,T)
)
=
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(N,T),
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge(N,T)
)
=
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(N,T),
( { id => id2a, ... },
{ id => id2b, ... },
{ id => id2c, ... }
): Edge(N,T)
)
=
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_setx_g ( # red_black_setx_g is from src/lib/src/red-black-setx-g.pkg #
package {
Key(N) = Tagless_Edge(N);
#
compare = compare_12of2;
}
);
package es # Sets of Edges
=
red_black_setxy_g ( # red_black_setxy_g is from src/lib/src/red-black-setxy-g.pkg #
package {
Key(N,T) = Edge(N,T);
#
compare = compare_123of3;
}
);
Graph(N,T)
=
{ index_1of2: im1::Map( ts::Set(N) ),
index_2of2: im1::Map( ts::Set(N) ),
#
index_12of2: ts::Set(N),
#
#
index_1of3: im1::Map( es::Set(N,T) ),
index_2of3: im1::Map( es::Set(N,T) ),
index_3of3: im1::Map( es::Set(N,T) ),
#
index_12of3: im2::Map( es::Set(N,T) ),
index_13of3: im2::Map( es::Set(N,T) ),
index_23of3: im2::Map( es::Set(N,T) ),
#
index_123of3: es::Set(N,T)
};
empty_graph
=
{ index_1of2 => im1::empty: im1::Map( ts::Set(N) ),
index_2of2 => im1::empty: im1::Map( ts::Set(N) ),
#
index_12of2 => ts::empty: ts::Set(N),
#
#
index_1of3 => im1::empty: im1::Map( es::Set(N,T) ),
index_2of3 => im1::empty: im1::Map( es::Set(N,T) ),
index_3of3 => im1::empty: im1::Map( es::Set(N,T) ),
#
index_12of3 => im2::empty: im2::Map( es::Set(N,T) ),
index_13of3 => im2::empty: im2::Map( es::Set(N,T) ),
index_23of3 => im2::empty: im2::Map( es::Set(N,T) ),
#
index_123of3 => es::empty: es::Set(N,T)
};
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(N,T),
tagless_edge as
( { id => id1, ... },
{ id => id2, ... }
): Tagless_Edge(N)
)
=
{ 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(N,T);
};
fun put_edge
(
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph(N,T),
edge as
( { id => id1, ... },
{ id => id2, ... },
{ id => id3, ... }
): Edge(N,T)
)
=
{ 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(N,T);
};
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(N,T),
tagless_edge as
( { id => id1, ... },
{ id => id2, ... }
): Tagless_Edge(N)
)
=
{ 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(N,T);
};
fun drop_edge
(
{ index_1of2,
index_2of2,
#
index_12of2,
#
#
index_1of3,
index_2of3,
index_3of3,
#
index_12of3,
index_13of3,
index_23of3,
#
index_123of3
}: Graph(N,T),
edge as
( { id => id1, ... },
{ id => id2, ... },
{ id => id3, ... }
): Edge(N,T)
)
=
{ 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(N,T);
};
fun get_tagless_edges (t: Graph(N,T)) = t.index_12of2;
#
fun get_tagless_edges1 (t: Graph(N,T), a: Node(N)) = im1::get (t.index_1of2, a.id);
fun get_tagless_edges2 (t: Graph(N,T), a: Node(N)) = im1::get (t.index_2of2, a.id);
#
fun has_tagless_edge (t: Graph(N,T), d: Tagless_Edge(N)) = ts::member (t.index_12of2, d);
fun get_edges (t: Graph(N,T)) = t.index_123of3;
#
fun get_edges1 (t: Graph(N,T), a: Node(N)) = im1::get (t.index_1of3, a.id);
fun get_edges2 (t: Graph(N,T), a: Tag(T) ) = im1::get (t.index_2of3, a.id);
fun get_edges3 (t: Graph(N,T), a: Node(N)) = im1::get (t.index_3of3, a.id);
#
fun get_edges12 (t: Graph(N,T), a: Node(N), b: Tag(T) ) = im2::get (t.index_12of3, (a.id, b.id));
fun get_edges13 (t: Graph(N,T), a: Node(N), c: Node(N)) = im2::get (t.index_13of3, (a.id, c.id));
fun get_edges23 (t: Graph(N,T), b: Tag(T), c: Node(N)) = im2::get (t.index_23of3, (b.id, c.id));
#
fun has_edge (t: Graph(N,T), d: Edge(N,T)) = es::member (t.index_123of3, d);
fun make_node ()
=
{ id => id_to_int (issue_unique_id ()),
datum => NNONE
};
fun make_int_node (i: Int)
=
{ id => id_to_int (issue_unique_id ()),
datum => NINT i
};
fun make_id_node (i: Id)
=
{ id => id_to_int (issue_unique_id ()),
datum => NID i
};
fun make_string_node (s: String)
=
{ id => id_to_int (issue_unique_id ()),
datum => NSTRING s
};
fun make_float_node (f: Float)
=
{ id => id_to_int (issue_unique_id ()),
datum => NFLOAT f
};
fun make_other_node (n: N)
=
{ id => id_to_int (issue_unique_id ()),
datum => NOTHER n
};
fun node_datum ({ datum, ... }: Node(N)) = datum;
fun node_int ({ id, datum => NINT i }: Node(N)) => THE i;
node_int _ => NULL;
end;
fun node_id ({ id, datum => NID i }: Node(N)) => THE i;
node_id _ => NULL;
end;
fun node_string ({ id, datum => NSTRING s }: Node(N)) => THE s;
node_string _ => NULL;
end;
fun node_float ({ id, datum => NFLOAT f }: Node(N)) => THE f;
node_float _ => NULL;
end;
fun node_other ({ id, datum => NOTHER x }: Node(N)) => THE x;
node_other _ => NULL;
end;
fun make_tag ()
=
{ id => id_to_int (issue_unique_id ()),
datum => TNONE
};
fun make_int_tag (i: Int)
=
{ id => id_to_int (issue_unique_id ()),
datum => TINT i
};
fun make_id_tag (i: Id)
=
{ id => id_to_int (issue_unique_id ()),
datum => TID i
};
fun make_string_tag (s: String)
=
{ id => id_to_int (issue_unique_id ()),
datum => TSTRING s
};
fun make_float_tag (f: Float)
=
{ id => id_to_int (issue_unique_id ()),
datum => TFLOAT f
};
fun make_other_tag (t: T)
=
{ id => id_to_int (issue_unique_id ()),
datum => TOTHER t
};
fun tag_datum ({ datum, ... }: Tag(T)) = datum;
fun tag_int ({ id, datum => TINT i }: Tag(T)) => THE i;
tag_int _ => NULL;
end;
fun tag_id ({ id, datum => TID i }: Tag(T)) => THE i;
tag_id _ => NULL;
end;
fun tag_string ({ id, datum => TSTRING s }: Tag(T)) => THE s;
tag_string _ => NULL;
end;
fun tag_float ({ id, datum => TFLOAT f }: Tag(T)) => THE f;
tag_float _ => NULL;
end;
fun tag_other ({ id, datum => TOTHER t }: Tag(T)) => THE t;
tag_other _ => NULL;
end;
fun nodes_apply # Apply do_node to all Nodes in Graph.
( { index_12of2,
index_123of3,
...
}: Graph(N,T)
)
(do_node: Node(N) -> 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(N))
=
{
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(N,T))
=
{
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(N,T)
)
(do_tag: Tag(T) -> Void)
=
{ es::apply do_edge index_123of3;
}
where
already_seen = REF is1::empty;
#
fun do_edge ((a1, t2, a3): Edge(N,T))
=
{
if (not (is1::member (*already_seen, t2.id)))
#
already_seen := is1::add (*already_seen, t2.id);
do_tag t2;
fi;
};
end;
};
end;