compact.lisp

   1 (in-package :cxml-rng)
   2
   3 (defparameter *keywords*
   4   '("attribute" "default" "datatypes" "div" "element" "empty" "external"
   5     "grammar" "include" "inherit" "list" "mixed" "namespace" "notAllowed"
   6     "parent" "start" "string" "text" "token"
   7     ;; keywordlike:
   8     "=" "{" "}" "," "&" "|" "?" "*" "+" "(" ")" "|=" "&=" ":" ":*" "~"))
   9
  10 (clex:deflexer test
  11     ((space
  12       (or #.(code-char 9)
  13           #.(code-char 10)
  14           #.(code-char 13)
  15           #.(code-char 32)))
  16      (normal-char
  17       (or #.(code-char 33)
  18           (range #.(code-char 35) #.(code-char 38))
  19           (range #.(code-char 40) #.(code-char #xd7ff))
  20           (range #.(code-char #xe000) #.(code-char #xfffd))
  21           (range #.(code-char #x10000) #.(code-char #x10ffff))))
  22      (string-char (or normal-char space))
  23      (non-space
  24       (or #.(code-char 34) #.(code-char 39) normal-char))
  25      (char
  26       (or space non-space))
  27      (newline
  28       (or #.(code-char 10) #.(code-char 13))))
  29   ((* space))
  30
  31   (#\# (clex:begin 'comment))
  32   ((clex::in comment newline) (clex:begin 'clex:initial))
  33   ((clex::in comment char))
  34
  35   ((and "'''" (* (or string-char #\")) "'''")
  36    (return (subseq clex:bag 3 (- (length clex:bag) 3))))
  37
  38   ((and #\' (* (or string-char #\")) #\')
  39    (when (or (find (code-char 13) clex:bag)
  40              (find (code-char 10) clex:bag))
  41      (rng-error "disallowed newline in string literal"))
  42    (return
  43      (subseq clex:bag 1 (- (length clex:bag) 1))))
  44
  45   ((and #\" #\" #\" (* (or string-char #\")) #\" #\" #\")
  46    (return (subseq clex:bag 3 (- (length clex:bag) 3))))
  47
  48   ((and #\" (* (or string-char #\')) #\")
  49    (when (or (find (code-char 13) clex:bag)
  50              (find (code-char 10) clex:bag))
  51      (rng-error "disallowed newline in string literal"))
  52    (return
  53      (subseq clex:bag 1 (- (length clex:bag) 1))))
  54
  55   ((* non-space)
  56    (return
  57      (if (find clex:bag *keywords* :test #'equal)
  58          (intern (string-upcase clex:bag) :keyword)
  59          clex:bag))))
  60
  61 (defun compact (&optional (p #"/home/david/src/lisp/cxml-rng/test.rnc"))
  62   (if (pathnamep p)
  63       (with-open-file (s p)
  64         (let ((f (make-test-lexer s)))
  65           (loop
  66              for k = (funcall f)
  67              until (eq k :eof)
  68              collect k)))
  69       (with-input-from-string (s p)
  70         (let ((f (make-test-lexer s)))
  71           (loop
  72              for k = (funcall f)
  73              until (eq k :eof)
  74              collect k)))))
  75
  76 #+(or)
  77 (compact "\"foo'")