remove-not-basic-ej-char.lisp

(ql:quickload :cl-unicode)

(defun basic-ej-char? (symb)
  (or (eq symb 'CL-UNICODE-NAMES::HIRAGANA)
      (eq symb 'CL-UNICODE-NAMES::KATAKANA)
      (eq symb 'CL-UNICODE-NAMES::CJKUNIFIEDIDEOGRAPHS)
      (eq symb 'CL-UNICODE-NAMES::CJKSYMBOLSANDPUNCTUATION)
      (eq symb 'CL-UNICODE-NAMES::BASICLATIN)))

(defun count-basic-ej-char (str)
  (loop for char across str
        count
        (multiple-value-bind (s symb)
            (cl-unicode:code-block char)
          (declare (ignore s))
          (basic-ej-char? symb))))

(defun remove-not-basic-ej-char (str)
  (let ((result (make-string (count-basic-ej-char str)))
        (cnt 0))
    (loop for char across str do
      (multiple-value-bind (s symb)
          (cl-unicode:code-block char)
        (declare (ignore s))
        (when (basic-ej-char? symb)
          (setf (aref result cnt) char)
          (incf cnt))))
    result))