;;; comprehensions.ss

; This file provides set-ec and :set. They were put in this file
; in order to avoid any the prefix from, say,
;   (require (prefix set: (planet "set.ss" ("cce" "galore.plt" 1))))

(module comprehensions mzscheme
  (require (prefix set: "set.ss")
           (lib "42.ss" "srfi"))
  
  (provide set-ec :set)
  
  ;;;
  ;;; SRFI 42 SUPPORT
  ;;;
  
  (require (lib "42.ss" "srfi"))
  
  ;; Old SRFI-42 definition.
  #;(define-syntax set-ec
    (syntax-rules ()
      [(_ empty etc1 etc ...)
       (fold-ec empty etc1 etc ... set:insert)]))
  
  (define-derived-comprehension set-ec ()
    ((set-ec empty etc etcs ... body)
     (etc etcs ...)
     (fold-ec empty etc etcs ... body set:insert)))
  
  (define-generator :set
    (lambda (stx)
      (syntax-case stx (index)
        ((:set var (index i) arg)
         (syntax/loc stx
           (:parallel (:set var arg)
                      (:integers i))))
        ((:set var arg)
         (syntax/loc stx
           (:do (let ())
                ((s arg))
                (not (set:empty? s))
                (let ((var (set:select s))))
                #t
                ((set:remove var s))))))))
  
  ;; Old SRFI-42 definition
  #;(define-syntax :set
      (syntax-rules (index)
        ((:set cc var (index i) arg)
         (:parallel cc (:set var arg) (:integers i)))
        ((:set cc var arg)
         (:do cc
              (let ())
              ((s arg))
              (not (set:empty? s))
              (let ((var (set:select s))))
            #t
            ((set:remove var s))
            ))))
  
  (define (:set-dispatch args)
    (cond
      [(null? args)
       'set]
      [(and (= (length args) 1)
            (set:set? (car args)))
       (:generator-proc (:set (car args)))]
      [else
       #f]))
  
  (:-dispatch-set! 
   (dispatch-union (:-dispatch-ref) :set-dispatch)))