clorb-idl.lisp

;; clorb-idl

(in-package :clorb)

(defclass IDL-COMPILER () 
  ((include-directories :initform *default-include-directories*
                        :initarg :include-directories
                        :accessor include-directories)
   (defines   
     :initform nil
     :initarg :defines
     :accessor defines)))



(defgeneric load-repository (idl-compiler repository file))

(defvar *default-idl-compiler* nil)

(defvar *default-exclude* '("::CORBA" "::IOP" "::GIOP" "::IIOP"))

(defun corba:idl (file &key print (eval t) output (package-decl t)
                  only (exclude *default-exclude*)
                  (skeleton t) target repository
                  (compiler *default-idl-compiler*)
                  (pprint-dispatch *target-pprint-dispatch*))
  (assert (or file repository))
  (let ((repository (or repository (make-instance 'repository))))
    (when file
      (load-repository compiler repository file))
    (flet ((lookup (name) (op:lookup repository name)))
      (let* ((target (make-instance (or target (if skeleton
                                                   'all-target
                                                   'static-stub-target))
                                    :excludes (mapcar #'lookup exclude)))
             (code (if only
                       (make-progn (mapcar (lambda (name)
                                             (target-code (lookup name) target))
                                           (mklist only)))
                       (target-code repository target)))
             (*defining-repository* repository))
        (flet ((execute-code ()
                 (unless (and (consp code) (eq (car code) 'progn))
                   (setq code `(progn code)))
                 (dolist (x (cdr code))
                   (when x
                     (when print (terpri) (pprint x))
                     (when eval (eval x))))
                 (when print (terpri))))
          (cond (output
                 (setq print t)
                 (with-standard-io-syntax
                   (let ((*package* (find-package :net.cddr.clorb))
                         (*print-pprint-dispatch* pprint-dispatch))
                     (with-open-file (*standard-output* output
                                                        :direction :output
                                                        :if-exists :supersede)
                       (format t ";;;; Code generated by CLORB~%")
                       (pprint '(in-package :net.cddr.clorb))
                       (when package-decl
                         (pprint (target-ensure-packages target)))
                       (execute-code)))))
                (t
                 (let ((*print-pprint-dispatch* pprint-dispatch))
                   (execute-code)))))))
    (when file
      (add-idl-repository *internal-interface-repository*
                          (truename file)
                          repository))
    repository))


#|
 (CORBA:IDL "clorb:idl;interface-repository.idl" 
            :output "clorb:src;y-ifr-base.lisp" 
            :eval nil
            :exclude '("::CORBA::TypeCode")
            :skeleton nil )

 (CORBA:IDL "clorb:idl;interface-repository.idl" 
            :output "clorb:src;y-ifr-base.lisp"
            :pprint-dispatch nil
            :eval nil
            :exclude '("::CORBA::TypeCode")
            :skeleton nil )

 (CORBA:IDL "clorb:idl;CosNaming.idl" 
            :output "clorb:src;y-cosnaming-skel.lisp" 
            :package-decl t
            :eval nil
            :target 'servant-target )

 (CORBA:IDL "clorb:idl;corba-misc.idl"
            :output "clorb:src;clorb-misc.lisp"
            :package-decl nil
            :exclude NIL
            :eval nil)
|#

;;; clorb-idl.lisp ends here