| 1 | (in-package "SPELL")
|
|---|
| 2 |
|
|---|
| 3 | ;;; FIXME: show where these things are documented
|
|---|
| 4 | (defconstant +V-mask+ (ash 1 13))
|
|---|
| 5 | (defconstant +N-mask+ (ash 1 12))
|
|---|
| 6 | (defconstant +X-mask+ (ash 1 11))
|
|---|
| 7 | (defconstant +H-mask+ (ash 1 10))
|
|---|
| 8 | (defconstant +Y-mask+ (ash 1 9))
|
|---|
| 9 | (defconstant +G-mask+ (ash 1 8))
|
|---|
| 10 | (defconstant +J-mask+ (ash 1 7))
|
|---|
| 11 | (defconstant +D-mask+ (ash 1 6))
|
|---|
| 12 | (defconstant +T-mask+ (ash 1 5))
|
|---|
| 13 | (defconstant +R-mask+ (ash 1 4))
|
|---|
| 14 | (defconstant +Z-mask+ (ash 1 3))
|
|---|
| 15 | (defconstant +S-mask+ (ash 1 2))
|
|---|
| 16 | (defconstant +P-mask+ (ash 1 1))
|
|---|
| 17 | (defconstant +M-mask+ 1)
|
|---|
| 18 |
|
|---|
| 19 | (defconstant flag-names-to-masks
|
|---|
| 20 | `((#\V . ,+V-mask+) (#\N . ,+N-mask+) (#\X . ,+X-mask+)
|
|---|
| 21 | (#\H . ,+H-mask+) (#\Y . ,+Y-mask+) (#\G . ,+G-mask+)
|
|---|
| 22 | (#\J . ,+J-mask+) (#\D . ,+D-mask+) (#\T . ,+T-mask+)
|
|---|
| 23 | (#\R . ,+R-mask+) (#\Z . ,+Z-mask+) (#\S . ,+S-mask+)
|
|---|
| 24 | (#\P . ,+P-mask+) (#\M . ,+M-mask+)))
|
|---|
| 25 |
|
|---|
| 26 | (defvar *flag-masks*
|
|---|
| 27 | (make-array 128 :element-type '(unsigned-byte 16) :initial-element 0)
|
|---|
| 28 | "This holds the masks for character flags, which is used when reading
|
|---|
| 29 | a text file of dictionary words. Illegal character flags hold zero.")
|
|---|
| 30 |
|
|---|
| 31 | (declaim (inline flag-mask))
|
|---|
| 32 | (defun flag-mask (char)
|
|---|
| 33 | (aref *flag-masks* (char-code char)))
|
|---|
| 34 | (defun %set-flag-mask (char value)
|
|---|
| 35 | (setf (aref *flag-masks* (char-code char)) value))
|
|---|
| 36 |
|
|---|
| 37 | (defsetf flag-mask %set-flag-mask)
|
|---|
| 38 |
|
|---|
| 39 | (dolist (e flag-names-to-masks)
|
|---|
| 40 | (let ((char (car e))
|
|---|
| 41 | (mask (cdr e)))
|
|---|
| 42 | (setf (flag-mask char) mask)
|
|---|
| 43 | (setf (flag-mask (char-downcase char)) mask)))
|
|---|
