From d4bee4db183f5e63f693df7c64b0571861c15821 Mon Sep 17 00:00:00 2001 From: Utz-Uwe Haus Date: Thu, 2 Oct 2008 23:31:24 +0200 Subject: [PATCH] Improve parser progress tracing. Indented `trying to parse ... found/not found' tree gets printed when *trace* is non-nil in the generated parser's package, for all rules of the grammar, but not for built-ins like SEQ, MANY, OPTIONAL. These increase indent, though. Signed-off-by: Utz-Uwe Haus --- TODO | 3 +- pegutils.lisp | 92 +++++++++++++++++++++++++++++++++-------------------------- 2 files changed, 53 insertions(+), 42 deletions(-) diff --git a/TODO b/TODO index 3041cf7..7360e40 100644 --- a/TODO +++ b/TODO @@ -1,3 +1,4 @@ +* Add better tracing/debugging of parser progress and failure * Fix opossum.peg until it - works for example.peg @@ -8,5 +9,5 @@ * profile -$Id:$ +$Id$ diff --git a/pegutils.lisp b/pegutils.lisp index 7a52b7a..4171af8 100644 --- a/pegutils.lisp +++ b/pegutils.lisp @@ -58,7 +58,9 @@ (children :accessor children :initform nil) (value :accessor value :initarg :value :initform nil) (start-index :accessor start-index :initarg :start-index :initform nil) - (end-index :accessor end-index :initarg :end-index :initform nil)) + (end-index :accessor end-index :initarg :end-index :initform nil) + (depth :accessor depth :initarg :depth :initform 0 + :documentation "How deep in the tree is this context?")) (:documentation "The parser context.")) (defmethod print-object ((obj context) stream) @@ -82,7 +84,8 @@ :action-counter (action-counter ctx) :parent ctx :rule rule - :start-index (end-index ctx))) + :start-index (end-index ctx) + :depth (1+ (depth ctx)))) (defun ctx-failed-p (ctx) (unless ctx @@ -94,10 +97,9 @@ (setf (value ctx) value) (setf (start-index ctx) start-index) (setf (end-index ctx) end-index) - ; (break "generated success context ~A" ctx) - (when *trace* - (format *trace-output* "Matched: ~A (~D:~D)~%" - (rule ctx) (start-index ctx) (end-index ctx))) + ;; (when *trace* + ;; (format *trace-output* "Matched: ~A (~D:~D)~%" + ;; (rule ctx) (start-index ctx) (end-index ctx))) ctx) (defun fail () @@ -111,11 +113,11 @@ ;; probably some of these copies can be saved :dst-package (dst-package *context*) :actions (actions *context*) - :action-counter (action-counter *context*)))) - ; (break "generated failure context ~A" ctx ) - (when *trace* - (format *trace-output* "(failed: ~A ~A ~A)~%" - (value ctx) (start-index ctx) (end-index ctx))) + :action-counter (action-counter *context*) + :depth (1+ (depth *context*))))) + ;; (when *trace* + ;; (format *trace-output* "(failed: ~A ~A ~A)~%" + ;; (value ctx) (start-index ctx) (end-index ctx))) ctx)) @@ -141,13 +143,21 @@ (defmacro build-parser-function (name parser) `(lambda (offset) - (let* ((*context* (clone-ctx *context* ,name)) - (result (funcall ,parser offset))) - (unless result - (break "Yow")) - (if (ctx-failed-p result) - (fail) - (succeed *context* (value result) (start-index result) (end-index result)))))) + (let ((indent (depth *context*))) + (when *trace* (format *trace-output* "~vTTrying to parse a ~A at pos ~D~%" indent ,name offset)) + (let* ((*context* (clone-ctx *context* ,name)) + (result (funcall ,parser offset))) + (unless result + (error "Parser function ~A did not return a value" ,parser)) + (if (ctx-failed-p result) + (progn + (when *trace* (format *trace-output* "~vT... no ~A at pos ~D~%" indent ,name offset)) + (fail)) + (progn + (when *trace* (format *trace-output* "~vT... found ~A at ~D:~D~%" + indent + ,name (start-index result) (end-index result))) + (succeed *context* (value result) (start-index result) (end-index result)))))))) @@ -163,8 +173,8 @@ (defun match-char (char-list) #'(lambda (offset) (let ((input (input *context*))) - (when *trace* - (format *trace-output* "match-char: looking for one of `~{~A~}'~%" char-list)) +;; (when *trace* +;; (format *trace-output* "match-char: looking for one of `~{~A~}'~%" char-list)) (if (and (> (length input) offset) (member (char input offset) char-list :test #'char=)) @@ -176,8 +186,8 @@ (let ((c (+ i3 (* 8 i2) (* 64 i1)))) #'(lambda (offset) (let ((input (input *context*))) - (when *trace* - (format *trace-output* "match-octal-char-code: looking for ~D~%" c)) +;; (when *trace* +;; (format *trace-output* "match-octal-char-code: looking for ~D~%" c)) (if (and (> (length input) offset) (= (char-int (char input offset)) c)) (succeed (clone-ctx *context* 'opossum-char) (char input offset) offset (+ offset 1)) @@ -187,8 +197,8 @@ "Match characters in the range between LOWER-CHAR and UPPER-CHAR (inclusive) as decided by CL:CHAR-CODE." #'(lambda (offset) (let ((input (input *context*))) - (when *trace* - (format *trace-output* "match-char-range: looking for ~A-~A~%" lower-char upper-char)) +;; (when *trace* +;; (format *trace-output* "match-char-range: looking for ~A-~A~%" lower-char upper-char)) (if (and (> (length input) offset) (let ((x (char-code (char input offset)))) (and (>= x (char-code lower-char)) @@ -201,8 +211,8 @@ #'(lambda (offset) "Match any character at OFFSET, fail only on EOF." (let ((input (input *context*))) - (when *trace* - (format *trace-output* "match-any-char~%")) +;; (when *trace* +;; (format *trace-output* "match-any-char~%")) (if (< (1+ offset) (length input)) (succeed (clone-ctx *context* 'opossum-anychar) (char input offset) offset (+ offset 1)) (fail))))) @@ -215,8 +225,8 @@ #'(lambda (offset) "Match next character at OFFSET against the characters in CHAR-CLASS." (let ((input (input *context*))) - (when *trace* - (format *trace-output* "match-char-class on ~A~%")) +;; (when *trace* +;; (format *trace-output* "match-char-class on ~A~%")) (if (and (< (1+ offset) (length input)) (let ((c (char input offset))) (cl-ppcre:scan cc (make-string 1 :initial-element c)))) @@ -253,8 +263,8 @@ returns the result of that function, or a failure context if none succeeded." #'(lambda (offset) (let ((*context* (clone-ctx *context* 'opossum-either))) - (when *trace* - (format *trace-output* "either: ~A ~A~%" *context* parsers)) + ;; (when *trace* + ;; (format *trace-output* "either: ~A ~A~%" *context* parsers)) (loop :for p :in parsers :as result = (funcall p offset) :when (not (ctx-failed-p result)) @@ -265,8 +275,8 @@ returns the result of that function, or a failure context if none succeeded." (defun optional (parser) #'(lambda (offset) (let ((*context* (clone-ctx *context* 'opossum-optional))) - (when *trace* - (format *trace-output* "optional: ~A ~A~%" *context* parser)) +;; (when *trace* +;; (format *trace-output* "optional: ~A ~A~%" *context* parser)) (let ((result (funcall parser offset))) (if (ctx-failed-p result) (succeed *context* 'optional offset offset) @@ -275,8 +285,8 @@ returns the result of that function, or a failure context if none succeeded." (defun follow (parser) #'(lambda (offset) (let ((*context* (clone-ctx *context* 'opossum-follow))) - (when *trace* - (format *trace-output* "follow: ~A ~A~%" *context* parser)) +;; (when *trace* +;; (format *trace-output* "follow: ~A ~A~%" *context* parser)) (let ((result (funcall parser offset))) (if (ctx-failed-p result) (fail) @@ -289,8 +299,8 @@ returns the result of that function, or a failure context if none succeeded." (let ((*context* (clone-ctx *context* 'opossum-many)) (start-offset offset) children) - (when *trace* - (format *trace-output* "many: ~A ~A~%" *context* parser)) +;; (when *trace* +;; (format *trace-output* "many: ~A ~A~%" *context* parser)) (loop :as result := (funcall parser offset) :while (not (ctx-failed-p result)) :do (progn (push (value result) children) @@ -302,8 +312,8 @@ returns the result of that function, or a failure context if none succeeded." #'(lambda (offset) (let* ((*context* (clone-ctx *context* 'opossum-many1)) (result (funcall parser offset))) - (when *trace* - (format *trace-output* "many1: ~A ~A~%" *context* parser)) +;; (when *trace* +;; (format *trace-output* "many1: ~A ~A~%" *context* parser)) (if (not (ctx-failed-p result)) (let ((result2 (funcall (many parser) (end-index result)))) (if (end-index result2) @@ -319,11 +329,11 @@ returns the result of that function, or a failure context if none succeeded." (start-offset offset) child-values child-nodes) - (when *trace* - (format *trace-output* "seq: ~A ~A~%" *context* parsers)) +;; (when *trace* +;; (format *trace-output* "seq: ~A ~A~%" *context* parsers)) ;; run the parsers (loop :for p :in parsers - :do (when *trace* (format *trace-output* " (seq ~A) trying ~A~%" *context* p)) +;; :do (when *trace* (format *trace-output* " (seq ~A) trying ~A~%" *context* p)) :do (cond ((consp p) (push (succeed (clone-ctx *context* 'action) nil offset offset) child-nodes) -- 2.11.4.GIT