如何告诉lisp阅读器函数在解析过程中忽略错误

时间:2013-11-19 20:47:43

标签: lisp common-lisp token

我需要一种方法来抑制使用read-from-string解析代码时引发的任何错误消息,以便我可以使用以下内容从Clojure代码中读取:

(let* ((string-with-code "  '(func UpperCase \"string\")")
       (brace-pos (position #\( string-with-code))
       (end-of-token (+ brace-pos 
                        (position #\Space (subseq string-with-code brace-pos))))
       (first-token (subseq string-with-code (incf brace-pos) end-of-token)))
  (format t "Found function: '~a'" 
          (read-from-string first-token)))
  ;; ==> Found function: 'func'

它基本上从字符串中的lisp代码打印函数名称。它工作正常,直到您尝试使用点运算符(.)作为列表中的第一项。 Clojure使用.cons两者来访问Java包中的类,因此有效代码如下:

(defmacro chain
  ([x form] `(. ~x ~form))
  ([x form & more] `(chain (. ~x ~form) ~@more)))

会导致错误:

*** - READ from #<INPUT STRING-INPUT-STREAM>: token "." not allowed here

如果我要用它来打印代码中的每个函数。我希望一种忽略/禁止来自read-from-string 的错误消息的方法,以使此代码最好不用修改lisp阅读器的工作方式。

编辑:

完整的计划:

(defvar string-with-code "(defmacro chain
                    ([x form] `(d ~x ~form))
                    ([x form & more] `(chain (. ~x ~form) ~@more)))
    ")

(defvar end-of-token 0)
(defvar first-token 0)

(defun functions-in-string (code)
  (let ((bpos (position #\( code)))
    (unless (null bpos) 
      (setq end-of-token (+ bpos (position #\Space (subseq code bpos))))
      (setq first-token (subseq code (incf bpos) end-of-token))
      (ignore-errors
       (format t "Found function: '~(~A~)'~%" (read-from-string first-token)))
      (functions-in-string (subseq code end-of-token)))))

    ;; (ignore-errors
     ;; (functions-in-string 0 code))

(functions-in-string string-with-code)

输出:

Found function: 'defmacro'
Found function: '[x'
Found function: 'd'
Found function: '[x'
Found function: 'chain'
;; You'll get the error below if ignore-errors wraps around the function call
;; *** - READ from #<INPUT STRING-INPUT-STREAM>: token "." not allowed here

2 个答案:

答案 0 :(得分:3)

不清楚你在问什么,但忽略错误只是:

CL-USER 37 > (ignore-errors (read-from-string "(. foo bar)"))
NIL
#<CONDITIONS:SIMPLE-READER-ERROR 402000243B>

如果出现错误,IGNORE-ERRORS会返回NIL,而第二个返回值则是条件。

如果您想要更多控制,则需要编写错误处理程序。

答案 1 :(得分:2)

这是Clojure yacc解析器的开始。这需要您更多地关注处理特殊的Clojure读取器宏并可能确保其他一些语法方面,但这已经是一个有效的开始:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun print-args (&rest args) (format nil "~{~a~^ ~}" args) ))

(defun clojure-lexer (stream)
  (let ((digits '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
        (translations (make-hash-table)))
    (loop :for (key . value) :in
       '((#\( . oparen)
         (#\) . cparen)
         (#\[ . obracket)
         (#\] . cbracket)
         (#\' . squote)
         (#\` . accent)
         (#\: . colon)
         (#\, . comma)
         (#\@ . at)) :do
       (setf (gethash key translations) value))
    (labels ((%reverse-coerce (collected)
               (coerce (nreverse collected) 'string))
             (%read-token ()
               (loop
                  :with collected := nil
                  :and stringp := nil
                  :and commentp := nil
                  :for token := (read-char stream nil nil) :do
                  (cond
                    ((null token)
                     (return (and collected (%reverse-coerce collected))))
                    ((char= token #\;)
                     (push token collected)
                     (setf commentp t))
                    ((char= token #\")
                     (if commentp
                         (push token collected)
                         (if stringp
                             (progn
                               (push token collected)
                               (return (%reverse-coerce collected)))
                             (if collected
                                 (progn
                                   (unread-char token)
                                   (return (%reverse-coerce collected)))
                                 (progn
                                   (push token collected)
                                   (setf stringp t))))))
                    ((gethash token translations)
                     (if (or stringp commentp)
                         (push token collected)
                         (if collected
                             (progn
                               (unread-char token stream)
                               (return (%reverse-coerce collected)))
                             (return (gethash token translations)))))
                    ((member token '(#\Newline #\Rubout))
                     (if commentp
                         (return (and collected (%reverse-coerce collected)))
                         (if stringp
                             (push token collected)
                             (and collected (return (%reverse-coerce collected))))))
                    ((member token '(#\Space #\Tab))
                     (if (or stringp commentp)
                         (push token collected)
                         (and collected (return (%reverse-coerce collected)))))
                    (t (push token collected))))))
      (lambda ()
        (let* ((key (%read-token))
               (value (or (gethash key translations) key)))
          (if (null key)
              (values nil nil)
              (let ((terminal
                     (cond
                       ((member key '(oparen cparen squote colon accent
                                      comma at obracket cbracket))
                        key)
                       ((or (member (char key 0) digits)
                            (and (char= (char key 0) #\-)
                                 (> (length key) 1)
                                 (member (char key 1) digits)))
                        'number)
                       ((char= (char key 0) #\") 'string)
                       ((char= (char key 0) #\;) 'comment)
                       (t 'id))))
                (values terminal value))))))))

(yacc:define-parser *clojure-parser*
  (:start-symbol exp)
  (:terminals (id oparen cparen squote colon accent
                  comma at obracket cbracket string number))

  (exp
   (oparen id exp-list cparen #'print-args)
   (oparen id cparen #'print-args)
   (obracket exp-list cbracket #'print-args)
   (obracket cbracket #'print-args)
   (comment #'print-args)
   (accented-exp #'print-args)
   (quoted-exp #'print-args)
   (term #'print-args))

  (term id string number)
  (quoted-exp (quote exp))
  (accented-exp (accent exp) (accent at exp))
  (exp-list (exp exp-list) exp))

(defun parse-clojure (string)
  (yacc:parse-with-lexer
   (clojure-lexer (make-string-input-stream string)) *clojure-parser*))

(parse-clojure
 "(defn str-invoke [instance method-str & args]
            (clojure.lang.Reflector/invokeInstanceMethod 
                \"instance\" 123 
                method-str 
                (to-array args)))")

结果:

;; "OPAREN defn (str-invoke
;;              (OBRACKET (instance (method-str (& args))) CBRACKET
;;               OPAREN clojure.lang.Reflector/invokeInstanceMethod (\"instance\"
;;                                                     (123
;;                                                      (method-str
;;                                                       OPAREN to-array args CPAREN))) CPAREN)) CPAREN"

这里是上述语法的BNF(不是声称它是Clojure语法,它只反映了上面的Lisp代码):

exp ::= '(' id exp-list ')'
      | '(' id ')'
      | '[' exp-list ']'
      | '[' ']'
      | ';' /[^\n]*/
      | accented-exp
      | quoted-exp
      | term

term ::= id | '"' /[^"]*/ '"' | /-?[0-9][^\s]+/
quoted-exp ::= '\'' exp
accented-exp ::= '`' exp | '`' '@' exp
exp-list ::= exp exp-list | exp
id ::= /[^()[\]:,`@']+/

为简单起见,某些部分以正则表达式给出,这些部分由//分隔。