#lang racket
(require (for-syntax racket/base))

(provide formals ; a parameter keeping a list of formal functions
         define-formal ; a form which defines symbols to denote algebraic pseudo-structures
         formal? ; a predicate which distinguishes algebraic pseudo-structures
         n/f-list? n/f-pair? ; predicates for non-algebraic lists and pairs
         ?eq? ?eqv? ?equal? ?= ?> ?< ?>= ?<=)

;;================================================================================
;; Expander that mimics formal functions
;;================================================================================
(define formals (make-parameter '()))

(define-syntax (define-formal stx)
  (syntax-case stx ()
    [(_ id) (let* ([str (symbol->string (syntax-e #'id))]
                   [str? (string->symbol (string-append str "?"))])
              (with-syntax ([id? (datum->syntax #'id str? #'id)])
                #'(begin
                    (define-match-expander id 
                      (syntax-rules () 
                        [(id x (... ...)) (list (quote id) x (... ...))])
                      (syntax-id-rules (id) 
                        [id  (λ x (cons (quote id) x))]
                        [(id x (... ...))  (list (quote id) x (... ...))]))
                    (define (id? x) (and (pair? x)
                                         (list? x) 
                                         (eq? (car x) (quote id))))
                    (formals (cons id? (formals))))))]
    [(_ ids ...) #'(begin (define-formal ids) ...)]))

(define (formal? x)
  (ormap (λ(f)(f x)) (formals)))

(define (n/f-list? x)
  (and (list? x)
       (not (formal? x))))

(define (n/f-pair? x)
  (and (pair? x)
       (not (formal? x))))

;;================================================================================
;; Match-expanders
;;================================================================================

(define-match-expander ?eq?
  (syntax-rules () 
    [(?eq? x) (? (λ(y)(eq? x y)))]))

(define-match-expander ?eqv?
  (syntax-rules () 
    [(?eqv? x) (? (λ(y)(eqv? x y)))]))

(define-match-expander ?equal?
  (syntax-rules () 
    [(?equal? x) (? (λ(y)(equal? x y)))]))

(define-match-expander ?=
  (syntax-rules () 
    [(?= x) (? (λ(y)(= x y)))]))

(define-match-expander ?<
  (syntax-rules () 
    [(?< x) (? (λ(y)(< x y)))]))

(define-match-expander ?>
  (syntax-rules () 
    [(?> x) (? (λ(y)(> x y)))]))

(define-match-expander ?<=
  (syntax-rules () 
    [(?<= x) (? (λ(y)(<= x y)))]))

(define-match-expander ?>=
  (syntax-rules () 
    [(?>= x) (? (λ(y)(>= x y)))]))