diff --git a/collects/mrflow/assoc-set-hash.ss b/collects/mrflow/assoc-set-hash.ss index fbafda956a..9e611d330c 100644 --- a/collects/mrflow/assoc-set-hash.ss +++ b/collects/mrflow/assoc-set-hash.ss @@ -46,6 +46,7 @@ (assoc-set-union ((assoc-set? assoc-set? (any/c any/c . -> . any)) ((symbols 'new 'first 'second)) . opt-> . assoc-set?)) (assoc-set-intersection ((assoc-set? assoc-set? (any/c any/c . -> . any)) ((symbols 'new 'first 'second)) . opt-> . assoc-set?)) (assoc-set-difference ((assoc-set? assoc-set?) ((symbols 'new 'first 'second)) . opt-> . assoc-set?)) + (assoc-set-subset? (assoc-set? assoc-set? . -> . boolean?)) ) ; (opt 'equal) -> assoc-set @@ -260,4 +261,14 @@ ;[else (argexn:raise-arg-mismatch-exn "assoc-set-difference" '(union new first second) which-set)] ))))) - ) + ; assoc-set assoc-set -> boolean + ; compares keys only + (define (assoc-set-subset? assoc-set1 assoc-set2) + (let/ec k + (hash-table-for-each (assoc-set-table assoc-set1) + (lambda (key value) + (unless (assoc-set-in? assoc-set2 key) + (k #f)))) + #t)) + + ) diff --git a/collects/mrflow/assoc-set-list.ss b/collects/mrflow/assoc-set-list.ss index 85c5bf162c..341fb624f2 100644 --- a/collects/mrflow/assoc-set-list.ss +++ b/collects/mrflow/assoc-set-list.ss @@ -48,6 +48,7 @@ (assoc-set-union ((assoc-set? assoc-set? (any/c any/c . -> . any)) ((symbols 'new 'first 'second)) . opt-> . assoc-set?)) (assoc-set-intersection ((assoc-set? assoc-set? (any/c any/c . -> . any)) ((symbols 'new 'first 'second)) . opt-> . assoc-set?)) (assoc-set-difference ((assoc-set? assoc-set?) ((symbols 'new 'first 'second)) . opt-> . assoc-set?)) + (assoc-set-subset? (assoc-set? assoc-set? . -> . boolean?)) ) ; (opt 'equal) -> assoc-set @@ -357,4 +358,11 @@ (set-assoc-set-table! assoc-set2 (assoc-set-table new-assoc-set)) assoc-set2])))) + ; assoc-set assoc-set -> boolean + ; compares keys only + (define (assoc-set-subset? assoc-set1 assoc-set2) + (andmap (lambda (key value) + (assoc-set-in? assoc-set2 key)) + (assoc-set-table assoc-set1))) + ) diff --git a/collects/mrflow/info.ss b/collects/mrflow/info.ss deleted file mode 100644 index c8f768de66..0000000000 --- a/collects/mrflow/info.ss +++ /dev/null @@ -1,14 +0,0 @@ - -(module info (lib "infotab.ss" "setup") - - ; for mzc - (define compile-omit-files '("test.ss" "tests.ss" "primitives.ss")) - - ; for DrScheme - (define name "MrFlow") - (define tools '(("gui.ss"))) - (define tool-icons '(("mrflow.gif" "icons"))) - ; this name shows up in the "About Drscheme" menu - (define tool-names '("MrFlow Static Debugger")) - (define tool-urls '("http://www.plt-scheme.org/software/mrflow/")) - ) diff --git a/collects/mrflow/set-hash.ss b/collects/mrflow/set-hash.ss index 40cca6b57c..89ea1594f9 100644 --- a/collects/mrflow/set-hash.ss +++ b/collects/mrflow/set-hash.ss @@ -44,6 +44,7 @@ (set-union ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?)) (set-intersection ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?)) (set-difference ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?)) + (set-subset? (set? set? . -> . boolean?)) ) ; (opt 'equal) -> set @@ -242,4 +243,13 @@ (set-set-cardinality! set2 (set-cardinality new-set)) set2]))))) + ; set set -> boolean + (define (set-subset? set1 set2) + (let/ec k + (hash-table-for-each (set-table set1) + (lambda (value dummy) + (unless (set-in? set2 value) + (k #f)))) + #t)) + ) diff --git a/collects/mrflow/set-list.ss b/collects/mrflow/set-list.ss index fe010ba465..ed91259201 100644 --- a/collects/mrflow/set-list.ss +++ b/collects/mrflow/set-list.ss @@ -47,6 +47,7 @@ (set-union ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?)) (set-intersection ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?)) (set-difference ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?)) + (set-subset? (set? set? . -> . boolean?)) ) ; (opt 'equal) -> set @@ -337,4 +338,10 @@ (set-set-table! set2 (set-table new-set)) set2])))) + ; set set -> boolean + (define (set-subset? set1 set2) + (andmap (lambda (value) + (set-in? set2 value)) + (set-table set1))) + )