#lang racket/base

(require racket/function
         racket/list
         syntax/parse
         phc-toolkit/untyped
         (for-syntax racket/base
                     syntax/parse
                     syntax/parse/experimental/template
                     racket/syntax
                     phc-toolkit/untyped)
         "parameters.rkt"
         "no-order.rkt")

(provide ~global-or
         ~global-and
         ~global-counter
         aggregate-global-or
         aggregate-global-and
         aggregate-global-counter)

(define-for-syntax (make-~global f [default #f])
  (syntax-parser
    [(_ (~or [name v] (~and name
                            (~fail #:unless default)
                            (~bind [v default])))
        pat ...)
     #:with clause-value (get-new-clause!)
     (eh-post-group! '~global-name
                     #'name
                     f
                     #'clause-value)
     ;; protect the values inside an immutable box, so that a #f can be
     ;; distinguished from a failed match.
     #'(~and pat ...
             (~bind [clause-value (box-immutable v)]))]))

(define (aggregate-global-or . bs)
  (true? ;; force the result to be a boolean, the order of terms is unimportant
   (ormap unbox ;; remove the layer of protection
          (filter identity ;; remove failed bindings
                  (flatten bs))))) ;; don't care about ellipsis nesting
(define-eh-mixin-expander ~global-or
  (make-~global #'aggregate-global-or #'#t))

(define (aggregate-global-and . bs)
  (let ([matches (filter identity ;; remove failed bindings
                         (flatten bs))])
    (if (null? matches)
        'none ;; no matches occurred
        (true? ;; coerce to boolean, so that the order of terms is unimportant
         (andmap unbox ;; remove the layer of protection
                 matches))))) ;; don't care about ellipsis nesting
(define-eh-mixin-expander ~global-and
  (make-~global #'aggregate-global-and))

(define (aggregate-global-counter . bs)
  (apply + (map unbox
                (filter identity ;; remove failed bindings
                        (flatten bs))))) ;; don't care about ellipsis nesting
(define-eh-mixin-expander ~global-counter
  (make-~global #'aggregate-global-counter #'+1))