#lang racket/base

(require racket/math racket/set
         racket/flonum
         (for-syntax racket/base))

(define-syntax define-alias
  (syntax-rules ()
    ((_ new old)
     (define-syntax new
       (syntax-id-rules (new)
         ((new args (... ...)) (old args (... ...)))
         (new old))))))

(define-syntax define-abbrev
  (syntax-rules ()
    ((_ (name args ...) expr)
     (define-syntax name
       (syntax-id-rules (name)
         ((name args ...) expr)
         (name (λ (args ...) expr)))))))

;; Numerical operations
(provide ≤ ≥ ≠ √) 
(define-alias ≤ <=)
(define-alias ≥ >=)
(define-abbrev (≠ x y) (not (= x y)))
(define-alias √ sqrt)

;; Famous numbers
(provide π ∞ -∞)
(define-alias π pi)
(define-alias ∞ +inf.0)
(define-alias -∞ -inf.0)

;; Logical operations
(provide ∧ ∨ ¬ ⇒ ⇐ ⇔)
(define-alias ∧ and)
(define-alias ∨ or)
(define-alias ¬ not)
;; Implications: shortcutting where possible.
(define-syntax ⇒ (syntax-rules () ((_ a b) (∨ (¬ a) b))))
(define-syntax ⇐ (syntax-rules () ((_ a b) (∨ a (¬ b)))))
(define-abbrev (⇔ a b) (eq? (¬ a) (¬ b))) 

;; Function operations
(provide ∘)
(define-alias ∘ compose)

;; Set operations
(provide ∋ ∈ ∪ ∩ ⊆ ⊇ ⊂ ⊃)
(define-alias ∋ set-member?)
(define-abbrev (∈ e s) (∋ s e))
(define-alias ∪ set-union) 
(define-alias ∩ set-intersect) 
(define-alias ⊆ subset?)
(define-abbrev (⊇ a b) (⊆ b a))
(define-alias ⊂ proper-subset?)
(define-abbrev (⊃ a b) (⊂ b a))

;; Famous sets
(provide ∅ ∅eqv ∅eq)
(define ∅ (set))
(define ∅eqv (seteqv))
(define ∅eq (seteq))

;; Some well-known comprehensions.
(provide ∀ ∀* ∃ ∃*)
(define-alias ∀ for/and)
(define-alias ∀* for*/and)
(define-alias ∃ for/or)
(define-alias ∃* for*/or)

;; New comprehensions.
(provide Σ Σ* Π Π*)

(define-syntax make-comprehension-helper
  (syntax-rules ()
    ((_ for/fold/derived name init op)
     (define-syntax (name syn)
       (syntax-case syn ()
         ((_ for-clauses expr (... ...))
          (with-syntax ((full-form syn))
            #'(for/fold/derived full-form ((var init)) for-clauses (op var (begin expr (... ...)))))))))))

(define-syntax make-comprehension
  (syntax-rules ()
    ((_ name name* init op)
     (begin
       (make-comprehension-helper for/fold/derived name init op)
       (make-comprehension-helper for*/fold/derived name* init op)))))

(make-comprehension Σ Σ* 0 +)
(make-comprehension Π Π* 1 *)

;; Flonum variants.
(provide flΣ flΣ* flΠ flΠ*)

(make-comprehension flΣ flΣ* 0.0 fl+)
(make-comprehension flΠ flΠ* 1.0 fl*)