From e660a7ad3a6e0412b7e3ab330a9eb7607b5b45f8 Mon Sep 17 00:00:00 2001 From: digikar Date: Tue, 23 Apr 2024 08:36:00 +0530 Subject: [PATCH] [change] readtable-case is :invert or :preserve: don't lispify names --- src/arg-list.lisp | 45 ++++++++++++++++++++++++++++++++++++------ src/import-export.lisp | 4 +++- 2 files changed, 42 insertions(+), 7 deletions(-) diff --git a/src/arg-list.lisp b/src/arg-list.lisp index 573ab1c..19ecbfa 100644 --- a/src/arg-list.lisp +++ b/src/arg-list.lisp @@ -27,20 +27,53 @@ (destructuring-bind (word . rem-chars) (collect-first-word char-list) (cons word (break-into-words rem-chars))))) +(defun upper-case-string-p (string) + (declare (optimize speed)) + (every (lambda (char) + (or (not (alpha-char-p char)) + (upper-case-p char))) + string)) + +(defun lower-case-string-p (string) + (declare (optimize speed)) + (every (lambda (char) + (or (not (alpha-char-p char)) + (lower-case-p char))) + string)) + (declaim (ftype (function (string) string) lispify-name)) (defun lispify-name (name) - "Converts NAME to a lisp-like name. Specifically: + "Converts NAME to a lisp-like name if the readtable case +is :UPCASE or :DOWNCASE. Specifically: 1. Replaces underscores with hyphens. - 2. CamelCase is converted to CAMEL-CASE" + 2. CamelCase is converted to CAMEL-CASE + +If the readtable case is :PRESERVE it returns the name as it is. + +If the readtable case is :INVERT, it inverts the case of the name and returns it." (let* ((words (mapcar (lambda (word) (coerce word 'string)) (remove-if #'null (break-into-words (coerce name 'list))))) (prefinal-string (string-upcase (format nil "~{~A~^-~}" words)))) - (remove-if (lambda (ch) - (char= ch #\_)) - prefinal-string - :end (1- (length prefinal-string))))) + (ecase (readtable-case *readtable*) + ((:upcase :downcase) + (remove-if (lambda (ch) + (char= ch #\_)) + prefinal-string + :end (1- (length prefinal-string)))) + (:preserve + name) + (:invert + ;; What is mixed stays mixed. + ;; All uppercase becomes lowercase + ;; All lowercase becomes uppercase + (cond ((upper-case-string-p name) + (string-downcase name)) + ((lower-case-string-p name) + (string-upcase name)) + (t + name)))))) (defun get-unique-symbol (symbol-name package-name) (declare (type string symbol-name)) diff --git a/src/import-export.lisp b/src/import-export.lisp index 40a60f9..87abb11 100644 --- a/src/import-export.lisp +++ b/src/import-export.lisp @@ -78,7 +78,9 @@ def _py4cl_non_callable(ele): (lisp-fun-name (lispify-name pyfun-name))) (intern (progn ;; Some python modules (like meep) have class_name as well as ClassName - (when (eq 'class callable-type) + (when (and (eq 'class callable-type) + (member (readtable-case cl:*readtable*) + '(:upcase :downcase))) (setq lisp-fun-name (concatenate 'string lisp-fun-name "/CLASS"))) (get-unique-symbol lisp-fun-name lisp-package)) lisp-package))