Changeset 12108


Ignore:
Timestamp:
May 22, 2009, 9:48:35 AM (10 years ago)
Author:
gb
Message:

SYNTAX-CHAR-CODE: treat characters with codes >= 256 as if they were #\A.
(Not quite right: some are whitespace.)

SEARCH-CHAR-CODE-LIMIT: set to CHAR-CODE-LIMIT.

SEARCH-CHAR-CODE: just use CHAR-CODE.

SEARCH-HASH-CODE: handle non-ASCII chars.

DO-ALPHA-CHARS: execute loop for char-codes from that of #\A to 256.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/charmacs.lisp

    r8428 r12108  
    4040;;; flying off the end.
    4141(defmacro syntax-char-code (char)
    42   `(min (char-code ,char) 255))
     42  (let* ((code (gensym)))
     43    `(let* ((,code (char-code ,char)))
     44      (declare (type (mod #x110000) ,code))
     45      (if (< ,code 256)
     46        ,code
     47        (char-code #\A)))))
    4348
    4449
    4550;;;; Stuff used by the searching primitives (search)
    4651;;;
    47 (defconstant search-char-code-limit 128
     52(defconstant search-char-code-limit char-code-limit
    4853  "The exclusive upper bound on significant char-codes for searching.")
    4954(defmacro search-char-code (ch)
    50   `(logand (char-code ,ch) #x+7F))
     55  `(char-code ,ch))
    5156;;;
    5257;;;    search-hash-code must be a function with the following properties:
     
    5762;;;
    5863(defmacro search-hash-code (ch)
    59   `(logand (char-code ,ch) #x+5F))
     64  `(char-code (char-upcase ,ch)))
    6065
    6166;;; Doesn't do anything special, but it should fast and not waste any time
     
    7378;;; guarantees lower and upper case char codes to be separately in order,
    7479;;; but other characters may be interspersed within that ordering.
    75 (defmacro alpha-chars-loop (var start-char end-char result body)
     80(defmacro alpha-chars-loop (var test result body)
    7681  (let ((n (gensym))
    7782        (end-char-code (gensym)))
    78     `(do ((,n (char-code ,start-char) (1+ ,n))
    79           (,end-char-code (char-code ,end-char)))
     83    `(do ((,n (char-code #\A) (1+ ,n))
     84          (,end-char-code 255))
    8085         ((> ,n ,end-char-code) ,result)
    8186       (let ((,var (code-char ,n)))
    82          (when (alpha-char-p ,var)
     87         (when (,test ,var)
    8388           ,@body)))))
    8489
     
    9095  (case kind
    9196    (:both
    92      `(progn (alpha-chars-loop ,var #\a #\z nil ,forms)
    93              (alpha-chars-loop ,var #\A #\Z ,result ,forms)))
     97     `(progn (alpha-chars-loop ,var lower-case-p nil ,forms)
     98             (alpha-chars-loop ,var upper-case-p ,result ,forms)))
    9499    (:lower
    95      `(alpha-chars-loop ,var #\a #\z ,result ,forms))
     100     `(alpha-chars-loop ,var lower-case-p ,result ,forms))
    96101    (:upper
    97      `(alpha-chars-loop ,var #\A #\Z ,result ,forms))
     102     `(alpha-chars-loop ,var upper-case-p ,result ,forms))
    98103    (t (error "Kind argument not one of :lower, :upper, or :both -- ~S."
    99104              kind))))
Note: See TracChangeset for help on using the changeset viewer.