Browse Source

Update pseudonyms.lisp

master
Michał Herda 4 years ago
parent
commit
bec3e63697
1 changed files with 16 additions and 15 deletions
  1. 16
    15
      pseudonyms.lisp

+ 16
- 15
pseudonyms.lisp View File

@@ -42,7 +42,7 @@ Given a plist and a value, returns a key."
;;; ========================================================================
;;; DEFINE/UNDEFINE FUNCTIONS

(defun defpseudonym (raw-name raw-pseudonym &optional (pkgname (package-name *package*)))
(defun defpseudonym (raw-name raw-pseudonym &key (pkgname (package-name *package*)))
"This, given a package name and a pseudonym for it, allows you
to use a local pseudonym in form $pseudonym:symbol instead of
name:symbol within your code. This pseudonym is local to the package
@@ -58,7 +58,7 @@ This will signal an error whenever a nickname or pseudonym is
already taken."
(check-type raw-name string-designator)
(check-type raw-pseudonym string-designator)
(let* ((table (gethash pkgname *pseudonym-table*))
(let* ((table (gethash (string-downcase pkgname) *pseudonym-table*))
(name (string-downcase raw-name))
(pseudonym (string-downcase raw-pseudonym))
(first (car table)))
@@ -77,13 +77,13 @@ already taken."
"This pseudonym is already taken by name ~S."
(string=-getf-key table pseudonym))
(if (null table)
(setf (gethash pkgname *pseudonym-table*)
(setf (gethash (string-downcase pkgname) *pseudonym-table*)
(cons name (cons pseudonym nil)))
(setf (car table) name
(cdr table) (cons pseudonym (cons first (cdr table)))))
(format nil "~A => ~A" pseudonym name)))

(defun pmakunbound (datum &optional (pkgname (package-name *package*)))
(defun pmakunbound (datum &key (pkgname (package-name *package*)))
"This, given either a nickname-bound package name or a
package name-bound nickname, clears any name-nickname pair bound to it.

@@ -91,7 +91,7 @@ Argument must be a string designator.
An optional argument allows you to clear a pseudonym from a different
package."
(check-type datum string-designator)
(let ((table (gethash pkgname *pseudonym-table*)))
(let ((table (gethash (string-downcase pkgname) *pseudonym-table*)))
(setf datum (string-downcase datum)
table
(loop for (key value) on table by #'cddr
@@ -102,19 +102,20 @@ package."
;;; ========================================================================
;;; UTILITIES

(defun print-pseudonyms (&optional (pkgname (package-name *package*)))
(defun print-pseudonyms (&key (pkgname (package-name *package*)))
"This prints all pseudonyms in a fancy manner.
Optional argument designates the package name, from inside which
pseudonyms should be printed."
(check-type pkgname string)
(let ((table (gethash (package-name *package*) *pseudonym-table*)))
(if(null table)
(format t "No pseudonyms defined for package ~:@(~A~).~%" pkgname)
(progn
(format t "pseudonym => name (package ~:@(~A~)):~%" pkgname)
(list-length
(loop for (key value) on table by #'cddr collecting key
do (format t "~S => ~S~%" value key)))))))
(check-type pkgname string-designator)
(let* ((string (string-downcase pkgname))
(table (gethash string *pseudonym-table*)))
(if (null table)
(format t "No pseudonyms defined for package ~:@(~A~).~%" pkgname)
(progn
(format t "pseudonym => name (package ~:@(~A~)):~%" pkgname)
(list-length
(loop for (key value) on table by #'cddr collecting key
do (format t "~S => ~S~%" value key)))))))

;;; ========================================================================
;;; READER MACRO

Loading…
Cancel
Save