<commit_before>(in-package :clorb)

(defun make-corba-symbol (name package)
  (let* ((package
          (or #+clisp (if (packagep package) package)
              (find-package package)
              (make-package package :use '())))
         (symbol (intern (string-upcase name) package)))
    (export symbol package)
    symbol))

(defun scoped-symbol (obj)
  (let* ((this-type (op:def_kind obj))
         (container (op:defined_in obj))
         (container-type (and container (op:def_kind container)))
         (name
          (if (or (null container) 
                  (eq container-type :dk_Repository)
                  (and (not (eq this-type :dk_Module))
                       (eq container-type :dk_Module)))
              (op:name obj)
            (concatenate 'string
              (symbol-name (scoped-symbol container)) "/" (op:name obj))))
         (package
          (if (eq this-type :dk_Module)
              :keyword
            ;; Find enclosing Module
            (do* ((container container (op:defined_in container))
                  (container-type container-type
                                  (and container (op:def_kind container))))
                ((or (null container) (eq container-type :dk_Module))
                 (if container (scoped-symbol container) 
                   "OMG.ORG/ROOT"))))))
    (make-corba-symbol name package)))


(defun gen-defclass (idef)
  (let ((bases (op:base_interfaces idef)))
    `(defclass ,(scoped-symbol idef) 
         ,(if bases 
              (map 'list 'scoped-symbol bases)
            '(CORBA:Object))
       ())))

(defun proxy-class-symbol (idef)
  (let ((scoped-symbol (scoped-symbol idef)))
    (make-corba-symbol (concatenate 'string
                         (symbol-name scoped-symbol)
                         "-PROXY")
                       (symbol-package scoped-symbol))))


(defun gen-defproxyclass (idef)
  (let ((bases (op:base_interfaces idef))
        (class-symbol (proxy-class-symbol idef)))
    `(progn
       (defclass ,class-symbol
         ,(if bases 
              (cons (scoped-symbol idef)
                    (map 'list 'proxy-class-symbol bases))
            (list (scoped-symbol idef) 'CORBA:Proxy))
         ())
       (register-proxy-class ,(op:id idef) ',class-symbol))))


(defun make-feature-symbol (name)
  (let ((symbol (make-corba-symbol name :op)))
    (unless (get symbol 'proxy-def)
      (eval `(defmethod ,symbol ((obj CORBA:Proxy) &rest args)
               (apply 'clorb::invoke obj ,name args)))
      (setf (get symbol 'proxy-def) t))
    symbol))




(defmethod gen-icode ((def contained) class)
  (declare (ignore class))
  (gen-code def))

(defmethod gen-icode ((op operation-def) class)
  (let* ((op-name (op:name op))
         (lisp-name (make-corba-symbol op-name :op)))
    `(defmethod ,lisp-name ((obj ,class) &rest args)
       (apply 'clorb::invoke obj ,op-name args))))

(defmethod gen-icode ((op attribute-def) class)
  (let* ((att-name (op:name op))
         (lisp-name (make-corba-symbol att-name :op)))
    `(progn
       (defmethod ,lisp-name ((obj ,class) &rest)
         (apply 'clorb::invoke obj ,(getter-name att-name)))
       ,@(if (eq (op:mode op) :attr_normal)
             (list `(defmethod (setf ,lisp-name) (newval (obj ,class))
                      (apply 'clorb::invoke obj ,(setter-name att-name)
                             newval)))))))


(defun setter-name (name)
  (concatenate 'string "_set_" name))

(defun getter-name (name)
  (concatenate 'string "_get_" name))

(defmethod gen-type ((obj primitive-def))
  (ecase (op:kind obj)
    (:pk_short 'CORBA:short)
    (:pk_string 'CORBA:string)))

(defmethod gen-type ((obj sequence-def))
  `sequence)

(defmethod gen-type ((obj alias-def))
  (scoped-symbol obj))


(defmethod gen-code ((x contained))
  (mess 4 "Can't generate code for ~A of kind ~S"
        (op:name x)
        (op:def_kind x))
  (describe x))

(defmethod gen-code ((x alias-def))
  `(deftype ,(scoped-symbol x) ()
     ',(gen-type (op:original_type_def x))))

(defun make-progn (l)
  (cons 'progn
        (loop for x in l
            append (if (eq 'progn (car x))
                       (cdr x)
                     (list x)))))

(defmethod gen-code ((idef interface-def))
  (let ((class (proxy-class-symbol idef)))
    (make-progn 
     (list* (gen-defclass idef)
            (gen-defproxyclass idef)
            (map 'list (lambda (x) (gen-icode x class))<commit_msg>updated gen-type<commit_after>(in-package :clorb)

(defun make-corba-symbol (name package)
  (let* ((package
          (or #+clisp (if (packagep package) package)
              (find-package package)
              (make-package package :use '())))
         (symbol (intern (string-upcase name) package)))
    (export symbol package)
    symbol))

(defun scoped-symbol (obj)
  (let* ((this-type (op:def_kind obj))
         (container (op:defined_in obj))
         (container-type (and container (op:def_kind container)))
         (name
          (if (or (null container) 
                  (eq container-type :dk_Repository)
                  (and (not (eq this-type :dk_Module))
                       (eq container-type :dk_Module)))
              (op:name obj)
            (concatenate 'string
              (symbol-name (scoped-symbol container)) "/" (op:name obj))))
         (package
          (if (eq this-type :dk_Module)
              :keyword
            ;; Find enclosing Module
            (do* ((container container (op:defined_in container))
                  (container-type container-type
                                  (and container (op:def_kind container))))
                ((or (null container) (eq container-type :dk_Module))
                 (if container (scoped-symbol container) 
                   "OMG.ORG/ROOT"))))))
    (make-corba-symbol name package)))


(defun gen-defclass (idef)
  (let ((bases (op:base_interfaces idef)))
    `(defclass ,(scoped-symbol idef) 
         ,(if bases 
              (map 'list 'scoped-symbol bases)
            '(CORBA:Object))
       ())))

(defun proxy-class-symbol (idef)
  (let ((scoped-symbol (scoped-symbol idef)))
    (make-corba-symbol (concatenate 'string
                         (symbol-name scoped-symbol)
                         "-PROXY")
                       (symbol-package scoped-symbol))))


(defun gen-defproxyclass (idef)
  (let ((bases (op:base_interfaces idef))
        (class-symbol (proxy-class-symbol idef)))
    `(progn
       (defclass ,class-symbol
         ,(if bases 
              (cons (scoped-symbol idef)
                    (map 'list 'proxy-class-symbol bases))
            (list (scoped-symbol idef) 'CORBA:Proxy))
         ())
       (register-proxy-class ,(op:id idef) ',class-symbol))))


(defun make-feature-symbol (name)
  (let ((symbol (make-corba-symbol name :op)))
    (unless (get symbol 'proxy-def)
      (eval `(defmethod ,symbol ((obj CORBA:Proxy) &rest args)
               (apply 'clorb::invoke obj ,name args)))
      (setf (get symbol 'proxy-def) t))
    symbol))




(defmethod gen-icode ((def contained) class)
  (declare (ignore class))
  (gen-code def))

(defmethod gen-icode ((op operation-def) class)
  (let* ((op-name (op:name op))
         (lisp-name (make-corba-symbol op-name :op)))
    `(defmethod ,lisp-name ((obj ,class) &rest args)
       (apply 'clorb::invoke obj ,op-name args))))

(defmethod gen-icode ((op attribute-def) class)
  (let* ((att-name (op:name op))
         (lisp-name (make-corba-symbol att-name :op)))
    `(progn
       (defmethod ,lisp-name ((obj ,class) &rest)
         (apply 'clorb::invoke obj ,(getter-name att-name)))
       ,@(if (eq (op:mode op) :attr_normal)
             (list `(defmethod (setf ,lisp-name) (newval (obj ,class))
                      (apply 'clorb::invoke obj ,(setter-name att-name)
                             newval)))))))


(defun setter-name (name)
  (concatenate 'string "_set_" name))

(defun getter-name (name)
  (concatenate 'string "_get_" name))

(defmethod gen-type ((obj primitive-def))
  (ecase (op:kind obj)
    ;;(:pk_null 'CORBA:null)
    (:pk_short 'CORBA:short)
    (:pk_long 'CORBA:long)
    (:pk_ushort 'CORBA:ushort)
    (:pk_ulong 'CORBA:ulong)
    (:pk_float 'CORBA:float)
    (:pk_double 'CORBA:double)
    (:pk_boolean 'CORBA:boolean)
    (:pk_char 'CORBA:char)
    (:pk_octet 'CORBA:octet)
    (:pk_any 'CORBA:any)
    (:pk_TypeCode 'CORBA:TypeCode)
    (:pk_string 'CORBA:string)
    (:pk_objref 'CORBA:Object)
    (:pk_longlong 'CORBA:longlong)
    (:pk_ulonglong 'CORBA:ulonglong)
    ;;(:pk_longdouble 'CORBA:longdouble)
    (:pk_wchar 'CORBA:wchar)
    ;;(:pk_wstring 'CORBA:wstring)
))




(defmethod gen-type ((obj sequence-def))
  `sequence)

(defmethod gen-type ((obj alias-def))
  (scoped-symbol obj))


(defmethod gen-code ((x contained))
  (mess 4 "Can't generate code for ~A of kind ~S"
        (op:name x)
        (op:def_kind x))
  (describe x))

(defmethod gen-code ((x alias-def))
  `(deftype ,(scoped-symbol x) ()
     ',(gen-type (op:original_type_def x))))

(defun make-progn (l)
  (cons 'progn
        (loop for x in l
            append (if (eq 'progn (car x))
                       (cdr x)
                     (list x)))))

(defmethod gen-code ((idef interface-def))
  (let ((class (proxy-class-symbol idef)))
    (make-progn 
     (list* (gen-defclass idef)
            (gen-defproxyclass idef)
            (map 'list (lambda (x) (gen-icode x class))
{'fraction_non_alphanumeric': 0.14973488865323437, 'fraction_numerical': 0.00021208907741251324, 'mean_word_length': 2.2264796442011634, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5952326', 'n_tokens_mistral': 3187, 'n_tokens_neox': 3051, 'n_words': 788}