File psl-1983/3-1/util/chars.lsp artifact d50a4c91f4 part of check-in 5f584e9b52


;;;
;;; CHARS.LSP - Common Lisp operations on characters
;;; 
;;; Author:      Eric Benson
;;;		 Symbolic Computation Group
;;;              Computer Science Dept.
;;;              University of Utah
;;; Date:        7 April 1982
;;; Copyright (c) 1982 University of Utah
;;;

; <PSL.UTIL>CHARS.LSP.4,  2-Sep-82 14:22:45, Edit by BENSON
; Fixed bug in CHAR-UPCASE and CHAR-DOWNCASE

(defvar char-code-limit 128 "Upper bound of character code values")

(defvar char-font-limit 1 "Upper bound on supported fonts")

(defvar char-bits-limit 1 "Upper bound on values produces by char-bits")

;;;; STANDARD-CHARP - ASCII definition
(defun standard-charp (c)
  (and (characterp c)
       (or (not (or (char< c #\Space) (char> c #\Rubout)))
	   (eq c #\Eol)
	   (eq c #\Tab)
	   (eq c #\FF))))

;;;; GRAPHICP - printable character
(defun graphicp (c)
  (and (characterp c)
    (not (char< c #\Space))
    (char< c #\Rubout)))

;;;; STRING-CHARP - a character that can be an element of a string
(defun string-charp (c)
  (and (characterp c)
       (>= (char-int c) 0)
       (<= (char-int c) #\Rubout)))

;;;; ALPHAP - an alphabetic character
(defun alphap (c)
  (or (uppercasep c)
      (lowercasep c)))

;;;; UPPERCASEP - an uppercase letter
(defun uppercasep (c)
  (and (characterp c)
       (not (char< c #\A))
       (not (char> c #\Z))))

;;;; LOWERCASEP - a lowercase letter
(defun lowercasep (c)
  (and (characterp c)
       (not (char< c #\\a))
       (not (char> c #\\z))))

;;;; BOTHCASEP - same as ALPHAP
(fset 'bothcasep (fsymeval 'alphap))

;;;; DIGITP - a digit character (optional radix not supported)
(defun digitp (c)
  (when (and (characterp c)
	     (not (char< c #\0))
	     (not (char> c #\9)))
        (- (char-int c) (char-int #\0))))

;;;; ALPHANUMERICP - a digit or an alphabetic
(defun alphanumericp (c)
  (or (alphap c) (digitp c)))

;;;; CHAR= - strict character comparison
(defun char= (c1 c2)
  (eql (char-int c1) (char-int c2)))

;;;; CHAR-EQUAL - similar character objects
(defun char-equal (c1 c2)
  (or (char= c1 c2)
      (and (string-charp c1)
	   (string-charp c2)
	   (or (char< c1 #\Space) (char> c1 #\?))
	   (or (char< c2 #\Space) (char> c2 #\?))
	   (eql (logand (char-int c1) (char-int #\))
		(logand (char-int c2) (char-int #\))))))

;;;; CHAR< - strict character comparison
(defun char< (c1 c2)
  (< (char-int c1) (char-int c2)))

;;;; CHAR> - strict character comparison
(defun char> (c1 c2)
  (> (char-int c1) (char-int c2)))

;;;; CHAR-LESSP - ignore case and bits for CHAR<
(defun char-lessp (c1 c2)
  (or (char< c1 c2)
      (and (string-charp c1)
	   (string-charp c2)
	   (or (char< c1 #\Space) (char> c1 #\?))
	   (or (char< c2 #\Space) (char> c2 #\?))
	   (< (logand (char-int c1) (char-int #\))
	      (logand (char-int c2) (char-int #\))))))

;;;; CHAR-GREATERP - ignore case and bits for CHAR>
(defun char-greaterp (c1 c2)
  (or (char> c1 c2)
      (and (string-charp c1)
	   (string-charp c2)
	   (or (char< c1 #\Space) (char> c1 #\?))
	   (or (char< c2 #\Space) (char> c2 #\?))
	   (> (logand (char-int c1) (char-int #\))
	      (logand (char-int c2) (char-int #\))))))

;;;; CHAR-CODE - character to integer conversion
(defmacro char-code (c)
  c)

;;;; CHAR-BITS - bits attribute of a character
(defmacro char-bits (c)
  0)

;;;; CHAR-FONT - font attribute of a character
(defmacro char-font (c)
  0)

;;;; CODE-CHAR - integer to character conversion, optional bits, font ignored
(defmacro code-char (c)
  c)

;;;; CHARACTER - character plus bits and font, which are ignored
(defun character (c)
  (cond ((characterp c) c)
        ((stringp c) (char c 0))
        ((symbolp c) (char (get-pname c) 0))
	(t (stderror (bldmsg "%r cannot be coerced to a character" c)))))

;;;; CHAR-UPCASE - raise a character
(defun char-upcase (c)
  (if (not (or (char< c #\\a)
	       (char> c #\\z)))
      (int-char (+ (char-int #\A)
		   (- (char-int c)
		      (char-int #\\a))))
      c))

;;;; CHAR-DOWNCASE - lower a character
(defun char-downcase (c)
  (if (not (or (char< c #\A)
	       (char> c #\Z)))
      (int-char (+ (char-int #\\a)
		   (- (char-int c)
		      (char-int #\A))))
      c))

;;;; DIGIT-CHAR - convert character to digit (optional radix, bits, font NYI)
(defun digit-char (i)
  (when (and (>= i 0) (<= i 10))
        (int-char (+ (char-int #\0) i))))

;;;; CHAR-INT - convert character to integer
(defmacro char-int (c)
  ;; Identity operation in PSL
  c)

;;;; INT-CHAR - convert integer to character
(defmacro int-char (c)
  ;; Identity operation in PSL
  c)


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]