#lang scheme/base
(provide (all-defined-out))

(define-syntax-rule (hash-intersection hash hashes for/xxx)
  (let ([rest hashes])
    (for/xxx ([(key value) hash]
              #:when (andmap (lambda (h)
                               (hash-ref h key (lambda () #f)))
                             rest))
      (values key #t))))

(define-syntax-rule (hash-difference hash hashes for/xxx)
  (let ([rest hashes])
    (for/xxx ([(key value) hash]
              #:when (not (ormap (lambda (h)
                                   (hash-ref h key (lambda () #f)))
                                 rest)))
      (values key #t))))

(define ((hash-partition empty) hash hashes)
  (for/fold ([diff empty]
             [intersection empty])
            ([(key value) hash])
    (if (ormap (lambda (h)
                 (hash-ref h key (lambda () #f)))
               hashes)
        (values diff (hash-set intersection key #t))
        (values (hash-set diff key #t) intersection))))

(define (union1 hash1 hash2)
  (for/fold ([result hash1])
            ([(key value) hash2])
    (hash-set result key #t)))

(define ((xor1 empty) hash1 hash2)
  (for/fold ([result (for/fold ([init empty])
                               ([(key value) hash1]
                                #:when (not (hash-ref hash2 key (lambda () #f))))
                       (hash-set init key #t))])
            ([(key value) hash2]
             #:when (not (hash-ref hash1 key (lambda () #f))))
    (hash-set result key #t)))

(define (<=?1 hash1 hash2)
  (let/ec return
    (for ([(key value) hash1]
          #:when (not (hash-ref hash2 key (lambda () #f))))
      (return #f))
    #t))

(define (=?1 hash1 hash2)
  (let/ec return
    (for ([(key value) hash1]
          #:when (not (hash-ref hash2 key (lambda () #f))))
      (return #f))
    (for ([(key value) hash2]
          #:when (not (hash-ref hash1 key (lambda () #f))))
      (return #f))
    #t))

(define (write-hash prefix hash [port (current-output-port)] [write? #t])
  (display "#<" port)
  (display prefix port)
  (display ":" port)
  (for ([(key value) hash]
        [i (in-naturals)])
    (when (> i 0)
      (display " " port))
    (if write? (write key port) (display key port)))
  (display ">" port))