cvs diff - library additions
Christopher Rodd SPEIRS
crs at students.cs.mu.oz.au
Thu Feb 13 10:44:19 AEDT 1997
I have made a number of additions to the library. The main changes are in
bag.m. These changes to bag.m required some changes to be made to
code_exprn.m. The rest of the changes are additions to list.m, io.m and
map.m.
The additions were mainly where there seemed to be 'missing'
predicates. For example, there was list__merge/3,
list__merge_and_remove_dups/3, list__merge/4, but no
list__merge_and_remove_dups/4.
The changes to io.m are: I added io__tmpnam, and io__unlink_file,
which simply call the respective c functions.
Would someone please review these changes...
Index: bag.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/bag.m,v
retrieving revision 1.6
diff -u -r1.6 bag.m
--- bag.m 1996/01/22 08:42:23 1.6
+++ bag.m 1997/02/12 23:08:55
@@ -6,7 +6,7 @@
%
% file: bag.m
% An implementation of multisets.
-% main author: conway.
+% main author: conway, crs.
% stability: medium
%
%---------------------------------------------------------------------------%
@@ -30,16 +30,35 @@
:- pred bag__insert_list(bag(T), list(T), bag(T)).
:- mode bag__insert_list(in, in, out) is det.
+ % make a bag from a list
+:- pred bag__from_list(list(T), bag(T)).
+:- mode bag__from_list(in, out) is det.
+
% remove one occurrence of a particular value from a bag
+ % fail if the item does not exist in the bag
:- pred bag__remove(bag(T), T, bag(T)).
-:- mode bag__remove(in, in, out) is det.
+:- mode bag__remove(in, in, out) is semidet.
+
+ % remove one occurrence of a particular value from a bag
+ % abort if the item does not exist in the bag
+:- pred bag__det_remove(bag(T), T, bag(T)).
+:- mode bag__det_remove(in, in, out) is det.
+
+ % delete one occurrence of a particular value from a bag
+:- pred bag__delete(bag(T), T, bag(T)).
+:- mode bag__delete(in, in, out) is det.
% remove all occurrences of a particular value from a bag
+ % fail if the item does not exist in the bag
:- pred bag__remove_all(bag(T), T, bag(T)).
-:- mode bag__remove_all(in, in, out) is det.
+:- mode bag__remove_all(in, in, out) is semidet.
+
+ % delete all occurrences of a particular value from a bag
+:- pred bag__delete_all(bag(T), T, bag(T)).
+:- mode bag__delete_all(in, in, out) is det.
% check whether a bag contains a particular value
-:- pred bag__contains(T, bag(T)).
+:- pred bag__contains(bag(T), T).
:- mode bag__contains(in, in) is semidet.
% given a bag, produce a sorted list with no duplicates
@@ -47,6 +66,45 @@
:- pred bag__to_list_without_duplicates(bag(T), list(T)).
:- mode bag__to_list_without_duplicates(in, out) is det.
+ % bag__subtract(Bag0, SubBag, Bag)
+ % subtracts SubBag from Bag0 to produce Bag
+:- pred bag__subtract(bag(T), bag(T), bag(T)).
+:- mode bag__subtract(in, in, out) is det.
+
+ % The third bag is the union of the first 2 bags.
+ % {1, 1, 2, 2} U {2, 2, 3, 3} = {1, 1, 2, 2, 2, 2, 3, 3}
+:- pred bag__union(bag(T), bag(T), bag(T)).
+:- mode bag__union(in, in, out) is det.
+
+ % The third bag is the intersection of the first 2 bags
+:- pred bag__intersect(bag(T), bag(T), bag(T)).
+:- mode bag__intersect(in, in, out) is det.
+
+ % fails if there is no intersection between the 2 bags
+ % bag__intersect(A, B) :- bag__intersect(A, B, C), bag__is_empty(C).
+:- pred bag__intersect(bag(T), bag(T)).
+:- mode bag__intersect(in, in) is semidet.
+
+ % fails if the first bag is not a subbag of the second.
+:- pred bag__is_subbag(bag(T), bag(T)).
+:- mode bag__is_subbag(in, in) is semidet.
+
+:- pred bag__is_empty(bag(T)).
+:- mode bag__is_empty(in) is semidet.
+
+ % fails if the bag is empty
+:- pred bag__remove_smallest(bag(T), T, bag(T)).
+:- mode bag__remove_smallest(in, out, out) is semidet.
+
+ % compares the two bags, and returns whether the first bag is a
+ % subset (<), is equal (=), or is a superset (>) of the second
+ % bag__subset_compare(<, {apple, orange}, {apple, apple, orange}).
+ % bag__subset_compare(=, {apple, orange}, {apple, orange}).
+ % bag__subset_compare(>, {apple, apple, orange}, {apple, orange}).
+ % bag__subset_compare(_, {apple, apple}, {orange, orange}) :- fail.
+:- pred bag__subset_compare(comparison_result, bag(T), bag(T)).
+:- mode bag__subset_compare(out, in, in) is semidet.
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -81,32 +139,47 @@
bag__insert(Bag0, Item, Bag1),
bag__insert_list(Bag1, Items, Bag).
+bag__from_list(List, Bag) :-
+ bag__init(Bag0),
+ bag__insert_list(Bag0, List, Bag).
+
%---------------------------------------------------------------------------%
-bag__remove(Bag0, Item, Bag) :-
+bag__delete(Bag0, Item, Bag) :- % det
+ ( bag__remove(Bag0, Item, Bag1) ->
+ Bag = Bag1
+ ;
+ Bag = Bag0
+ ).
+
+bag__remove(Bag0, Item, Bag) :- % semidet
+ map__search(Bag0, Item, Count0),
(
- map__search(Bag0, Item, Count0)
+ Count0 > 1
->
Count is Count0 - 1,
- (
- Count > 0
- ->
- map__set(Bag0, Item, Count, Bag)
- ;
- map__delete(Bag0, Item, Bag)
- )
+ map__set(Bag0, Item, Count, Bag)
;
+ map__delete(Bag0, Item, Bag)
+ ).
+
+bag__det_remove(Bag0, Item, Bag) :- % det
+ ( bag__remove(Bag0, Item, Bag1) ->
+ Bag = Bag1
+ ;
+ error("Missing Item in bag."),
Bag = Bag0
).
-%---------------------------------------------------------------------------%
+bag__remove_all(Bag0, Item, Bag) :- % semidet
+ map__remove(Bag0, Item, Bag).
-bag__remove_all(Bag0, Item, Bag) :-
+bag__delete_all(Bag0, Item, Bag) :- % det
map__delete(Bag0, Item, Bag).
%---------------------------------------------------------------------------%
-bag__contains(Item, Bag) :-
+bag__contains(Bag, Item) :-
map__contains(Bag, Item).
%---------------------------------------------------------------------------%
@@ -115,5 +188,125 @@
map__keys(Bag, List).
%---------------------------------------------------------------------------%
+
+bag__subtract(Bag0, SubBag, Bag) :-
+ ( map__remove_smallest(SubBag, SubKey, SubVal, SubBag0) ->
+ ( map__search(Bag0, SubKey, Val) ->
+ NewVal = Val - SubVal,
+ ( NewVal > 0 ->
+ map__det_update(Bag0, SubKey, NewVal, Bag1)
+ ;
+ map__det_remove(Bag0, SubKey, Bag1)
+ )
+ ;
+ Bag1 = Bag0
+ ),
+ bag__subtract(Bag2, SubBag0, Bag)
+ ;
+ Bag = Bag0
+ ).
+
+
+bag__union(A, B, Out) :-
+ ( map__remove_smallest(A, Key, AVal,A0) ->
+ ( map__search(B, Key, BVal) ->
+ NewVal = AVal + BVal,
+ map__det_update(B, Key, NewVal, B0)
+ ;
+ map__det_insert(B, Key, AVal, B0)
+ ),
+ bag__union(A0, B0, Out)
+ ;
+ Out = B
+ ).
+
+
+
+bag__intersect(A, B, Out) :-
+ bag__init(Out0),
+ bag__intersect_2(A, B, Out0, Out).
+
+:- pred bag__intersect_2(bag(T), bag(T), bag(T), bag(T)).
+:- mode bag__intersect_2(in, in, in, out) is det.
+bag__intersect_2(A, B, Out0, Out) :-
+ ( map__remove_smallest(A, Key, AVal,A0) ->
+ ( map__search(B, Key, BVal) ->
+ ( AVal > BVal ->
+ map__det_insert(Out0, Key, BVal, Out1)
+ ;
+ map__det_insert(Out0, Key, AVal, Out1)
+ )
+ ;
+ map__det_insert(Out0, Key, AVal, Out1)
+ ),
+ bag__intersect_2(A0, B, Out1, Out)
+ ;
+ Out = Out0
+ ).
+
+bag__intersect(A, B) :-
+ map__remove_smallest(A, Key, _AVal,A0),
+ ( map__contains(B, Key) ->
+ true
+ ;
+ bag__intersect(A0, B)
+ ).
+
+%---------------------------------------------------------------------------%
+
+bag__is_subbag(SubBag, BigBag) :-
+ bag__subtract(SubBag, BigBag, SubBag0),
+ bag__is_empty(SubBag0).
+
%---------------------------------------------------------------------------%
+bag__is_empty(Bag) :-
+ map__is_empty(Bag).
+
+%---------------------------------------------------------------------------%
+
+bag__remove_smallest(Bag0, Item, Bag) :-
+ map__remove_smallest(Bag0, Item, Val, Bag1),
+ ( Val > 1 ->
+ NewVal = Val - 1,
+ map__det_insert(Bag1, Item, NewVal, Bag)
+ ;
+ Bag = Bag1
+ ).
+
+ % compares the two bags, and returns whether the first bag is a
+ % subset (<), is equal (=), or is a superset (>) of the second
+ % bag__subset_compare(<, {apple, orange}, {apple, apple, orange}).
+ % bag__subset_compare(=, {apple, orange}, {apple, orange}).
+ % bag__subset_compare(>, {apple, apple, orange}, {apple, orange}).
+ % bag__subset_compare(_, {apple, apple}, {orange, orange}) :- fail.
+ % :- pred bag__subset_compare(comparison_result, bag(T), bag(T)).
+ % :- mode bag__subset_compare(out, in, in) is semidet.
+bag__subset_compare(Res, A, B) :-
+ ( map__remove_smallest(A, Key, AVal, A0) ->
+ ( map__remove(B, Key, BVal, B0) ->
+ compare(ValRes, AVal, BVal),
+ (
+ ValRes = (>),
+ bag__is_subbag(B0, A0),
+ Res = (>)
+ ;
+ ValRes = (=),
+ bag__subset_compare(Res, A0, B0)
+ ;
+ ValRes = (<),
+ bag__is_subbag(A0, B0),
+ Res = (<)
+ )
+ ;
+ % B is empty, but A is not
+ Res = (>)
+ )
+ ;
+ % A is empty
+ ( map__is_empty(B) ->
+ Res = (=)
+ ;
+ Res = (<)
+ )
+ ).
Index: io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.110
diff -u -r1.110 io.m
--- io.m 1997/02/08 16:35:55 1.110
+++ io.m 1997/02/10 04:24:49
@@ -673,6 +673,17 @@
%-----------------------------------------------------------------------------%
+% returns a unique temporary filename.
+:- pred io__tmpnam(string, io__state, io__state).
+:- mode io__tmpnam(out, di, uo) is det.
+
+% deletes a file
+:- pred io__unlink_file(string, io__res, io__state, io__state).
+:- mode io__unlink_file(in, out, di, uo) is det.
+
+
+%-----------------------------------------------------------------------------%
+
% Memory management predicates.
% Write some memory/time usage statistics to stdout.
@@ -2069,6 +2080,53 @@
:- pragma(c_code, io__putenv(VarAndValue::in), "
SUCCESS_INDICATOR = (putenv(VarAndValue) == 0);
").
+
+/*---------------------------------------------------------------------------*/
+%#include <stdio.h>
+:- pragma(c_code, io__tmpnam(FileName::out, IO0::di, IO::uo), "{
+ Word tmp;
+ incr_hp_atomic(tmp, (L_tmpnam + sizeof(Word)) / sizeof(Word));
+ tmpnam(tmp);
+ FileName = (char *) tmp;
+ update_io(IO0, IO);
+}").
+
+/*---------------------------------------------------------------------------*/
+
+io__unlink_file(FileName, Result, IO, IO) :-
+ io__unlink_file_2(FileName, Res, ResString),
+ ( Res < 0 ->
+ Result = error(ResString)
+ ;
+ Result = ok
+ ).
+
+
+:- pred io__unlink_file_2(string, int, string).
+:- mode io__unlink_file_2(in, out, out) is det.
+
+%#include <string.h>
+:- pragma(c_header_code, "#include <errno.h>").
+:- pragma(c_header_code, "#include <unistd.h>").
+:- pragma(c_code, io__unlink_file_2(FileName::in, RetVal::out, RetStr::out), "{
+ Word tmp;
+ char * buf;
+
+ RetVal = unlink(FileName);
+
+ if (RetVal < 0) {
+ buf = strerror(errno);
+ incr_hp_atomic(tmp,(strlen(buf)+sizeof(Word)) / sizeof(Word));
+ RetStr = (char *) tmp;
+ strcpy(RetStr, (char *) tmp);
+ }
+ else
+ RetStr = NULL;
+
+
+
+}").
+
/*---------------------------------------------------------------------------*/
Index: list.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/list.m,v
retrieving revision 1.64
diff -u -r1.64 list.m
--- list.m 1996/10/24 05:57:42 1.64
+++ list.m 1997/01/31 00:05:59
@@ -392,6 +392,12 @@
:- pred list__merge(pred(X, X, comparison_result), list(X), list(X), list(X)).
:- mode list__merge(pred(in, in, out) is det, in, in, out) is det.
+:- pred list__merge_and_remove_dups(pred(X, X, comparison_result)
+ , list(X), list(X), list(X)).
+:- mode list__merge_and_remove_dups(pred(in, in, out) is det
+ , in, in, out) is det.
+
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -950,6 +956,26 @@
L = [H2|T],
list__merge(P, [H1|T1], T2, T)
).
+
+list__merge_and_remove_dups(_P, [], [], []).
+list__merge_and_remove_dups(_P, [], [Y|Ys], [Y|Ys]).
+list__merge_and_remove_dups(_P, [X|Xs], [], [X|Xs]).
+list__merge_and_remove_dups(P, [H1|T1], [H2|T2], L) :-
+ call(P, H1, H2, C),
+ (
+ C = (<),
+ L = [H1|T],
+ list__merge(P, T1, [H2|T2], T)
+ ;
+ C = (=),
+ L = [H1 | T],
+ list__merge(P, T1, T2, T)
+ ;
+ C = (>),
+ L = [H2|T],
+ list__merge(P, [H1|T1], T2, T)
+ ).
+
%-----------------------------------------------------------------------------%
Index: map.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/map.m,v
retrieving revision 1.55
diff -u -r1.55 map.m
--- map.m 1996/05/13 07:53:38 1.55
+++ map.m 1997/02/05 06:38:27
@@ -121,16 +121,26 @@
:- mode map__delete_list(di, in, uo) is det.
:- mode map__delete_list(in, in, out) is det.
- % delete a key-value pair from a map and return the value.
+ % remove a key-value pair from a map and return the value.
% fail if the key is not present
:- pred map__remove(map(K,V), K, V, map(K,V)).
:- mode map__remove(in, in, out, out) is semidet.
- % delete a key-value pair from a map and return the value.
+ % remove a key-value pair from a map.
+ % fail if the key is not present
+:- pred map__remove(map(K,V), K, map(K,V)).
+:- mode map__remove(in, in, out) is semidet.
+
+ % remove a key-value pair from a map and return the value.
% abort if the key is not present
:- pred map__det_remove(map(K,V), K, V, map(K,V)).
:- mode map__det_remove(in, in, out, out) is det.
+ % remove a key-value pair from a map.
+ % abort if the key is not present
+:- pred map__det_remove(map(K,V), K, map(K,V)).
+:- mode map__det_remove(in, in, out) is det.
+
% Count the number of elements in the map.
:- pred map__count(map(K, V), int).
:- mode map__count(in, out) is det.
@@ -276,9 +286,19 @@
map__remove(Map0, Key, Value, Map) :-
tree234__remove(Map0, Key, Value, Map).
+map__remove(Map0, Key, Map) :-
+ tree234__remove(Map0, Key, _Value, Map).
+
map__det_remove(Map0, Key, Value, Map) :-
( tree234__remove(Map0, Key, Value1, Map1) ->
Value = Value1,
+ Map = Map1
+ ;
+ error("map__det_remove: key not found")
+ ).
+
+map__det_remove(Map0, Key, Map) :-
+ ( tree234__remove(Map0, Key, _Value1, Map1) ->
Map = Map1
;
error("map__det_remove: key not found")
Index: ../compiler/code_exprn.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_exprn.m,v
retrieving revision 1.45
diff -u -r1.45 code_exprn.m
--- code_exprn.m 1997/01/21 05:04:50 1.45
+++ code_exprn.m 1997/02/05 23:13:40
@@ -607,7 +607,7 @@
{ Lval = reg(_, _) }
->
code_exprn__get_regs(Regs0),
- { bag__remove(Regs0, Lval, Regs) },
+ { bag__delete(Regs0, Lval, Regs) },
code_exprn__set_regs(Regs)
;
{ Lval = field(_Tag, Rval0, Rval1) }
@@ -1566,7 +1566,7 @@
code_exprn__get_spare_reg_2(RegType, N0, Regs, Lval) :-
TrialLval = reg(RegType, N0),
- ( bag__contains(TrialLval, Regs) ->
+ ( bag__contains(Regs, TrialLval) ->
N1 is N0 + 1,
code_exprn__get_spare_reg_2(RegType, N1, Regs, Lval)
;
@@ -1587,7 +1587,7 @@
code_exprn__acquire_reg_prefer_given(Type, Pref, Lval) -->
code_exprn__get_regs(Regs0),
{ PrefLval = reg(Type, Pref) },
- ( { bag__contains(PrefLval, Regs0) } ->
+ ( { bag__contains(Regs0, PrefLval) } ->
code_exprn__get_spare_reg(Type, Lval)
;
{ Lval = PrefLval }
@@ -1606,9 +1606,9 @@
{ set__delete(Acqu0, Lval, Acqu) },
code_exprn__set_acquired(Acqu),
code_exprn__get_regs(Regs0),
- { bag__remove(Regs0, Lval, Regs) },
+ { bag__delete(Regs0, Lval, Regs) },
(
- { bag__contains(Lval, Regs) }
+ { bag__contains(Regs, Lval) }
->
{ error("code_exprn__release_reg: reg still has references") }
;
@@ -1628,7 +1628,7 @@
code_exprn__unlock_reg(Reg) -->
code_exprn__get_regs(Regs0),
- { bag__remove(Regs0, Reg, Regs) },
+ { bag__delete(Regs0, Reg, Regs) },
code_exprn__set_regs(Regs).
%------------------------------------------------------------------------------%
More information about the developers
mailing list