;;; ----------------------------------------------------------------------
;;;
;;; GFMULTIARG: Undescribed module
;;;
;;; ----------------------------------------------------------------------
;;;
;;; This file is part of ILOG Talk.
;;; Inquiries to ILOG S.A.
;;;              9 rue de Verdun, BP 85,
;;;              94253 Gentilly Cedex, France.
;;;
;;; Copyright (c) 1994-1996 by ILOG
;;; ----------------------------------------------------------------------
;;;

(defmacro define-multiarg-generic (name min-args max-args)
  ;; Define function discriminating on the number of args, from
  ;; min-args to max-args.  Both must be unevaluated fixes.
  (assert (intp min-args))
  (assert (intp max-args))
  (let ((defs
         (collecting
           (for ((i from: min-args to: max-args))
            (collect (.define-1-multiarg-generic name i))))))
    `(progn ,@(mapcar #'car defs)

            (defun ,name (multiple: args)
              ;; Function for discrimination
              (case (mlen args)
                ,@(mapcar #'cadr defs)
                (t (error ',name #!errwna ,min-args ,max-args (mlen args)))))

            (defmacro ,name (multiple: args)
              ;; Macro for static discrimination
              (case (mlen args)
                ,@(mapcar #'caddr defs)
                (t (error ',name #!errwna 
                          ,min-args ,max-args (mlen args))))))))

(defmacro define-multiarg-method (name lambda-list rest: body)
  `(defmethod ,(.multi-gf-name name (llen lambda-list)) ,lambda-list
     ,@body))

(defun .define-1-multiarg-generic (name n-args)
  ;; Return a list of:
  ;;  1. generic function definition
  ;;  2. function selectq clause
  ;;  3. macro selectq clause
  (let ((fn-name (.multi-gf-name name n-args)))
    (list `(defgeneric ,fn-name ,(.make-gensym-list n-args))
          `(,n-args (,fn-name ,@(.make-arg-list n-args)))
          `(,n-args (list ',fn-name ,@(.make-arg-list n-args))))))

(defun .multi-gf-name (name n-args)
  ;; Return a standardized gf-name based on NAME and the number of
  ;; argument N-ARGS.
  (symbol (or (id-package name) 'internal)
          (catenate name "#" (string n-args))))

(defun .make-gensym-list (n)
  (collecting (repeat n (collect (gensym "_arg_")))))

(defun .make-arg-list (n)
  (collecting
    (for ((i from: 0 below: n))
      (collect `(mref args ,i)))))
