diff options
Diffstat (limited to 'ipl/procs/mset.icn')
| -rw-r--r-- | ipl/procs/mset.icn | 111 |
1 files changed, 111 insertions, 0 deletions
diff --git a/ipl/procs/mset.icn b/ipl/procs/mset.icn new file mode 100644 index 0000000..db9dc75 --- /dev/null +++ b/ipl/procs/mset.icn @@ -0,0 +1,111 @@ +############################################################################ +# +# File: mset.icn +# +# Subject: Procedures for multi-sets +# +# Author: Jan P. de Ruiter +# +# Date: January 3, 1994 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# The idea of the mset type is that no two identical data-structures can be +# present in a set, where identity is defined as "containing the same +# elements". +# +# Definitions implicit in the procedure same_value(..,..): +# +# TYPE IDENTITY TEST +# +# all types === and if this test fails... +# +# integer = +# real = +# cset, string == +# record all fields have same value +# list all elements are the same, including ordering +# table same keys, and every key has the same associated value +# set contain the same elements +# +############################################################################ + +# +# This is the core routine. +# It succeeds if two things have the same value(s). +# +procedure same_value(d1,d2) + if d1 === d2 then return # same object + else + if type(d1) ~== type(d2) then fail # not the same type + else + if *d1 ~= *d2 then fail # not the same size + else + case type(d1) of { # the same type and size + ("set" | "table" ) : return same_elements(sort(d1,1),sort(d2,1)) + ("list") : return same_elements(d1,d2) + ("real" | "integer") : return(d1 = d2) + ("cset" | "string" ) : return(d1 == d2) + default : return same_elements(d1,d2) # user defined type + } +end + +# +# used in same_value: +# + +procedure same_elements(l1,l2) + local i + if l1 === l2 then return # same objects + else + if *l1 ~= *l2 then fail # not the same size + else { + if *l1 = 0 then return # both lists empty + else { + every(i := 1 to *l1) do + if not same_value(l1[i],l2[i]) then fail # recursion + return + } + } +end + +# +# The new insert operation. Insert2 always succeeds +# +procedure insert2(S,el) + every (if same_value(el,!S) then return) + return insert(S,el) +end + +# +# The new member operation, that also detects equal-valued elements +# +procedure member2(S,el) + every(if same_value(!S,el) then return) + fail +end + +# +# The new delete operation, that detects equal-valued elements. +# Always succeeds +# +procedure delete2(S,el) + local t + every(t := !S) do if same_value(t,el) then return delete(S,t) + return +end + +# +# conversion of standard icon set into new mset. +# +procedure reduce2(iset) + local temp + temp := set() + every(insert2(temp,!iset)) + return temp +end + |