diff options
author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
---|---|---|
committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /parser/parser-debugger.scm |
Import to github.
Diffstat (limited to 'parser/parser-debugger.scm')
-rw-r--r-- | parser/parser-debugger.scm | 81 |
1 files changed, 81 insertions, 0 deletions
diff --git a/parser/parser-debugger.scm b/parser/parser-debugger.scm new file mode 100644 index 0000000..40d9382 --- /dev/null +++ b/parser/parser-debugger.scm @@ -0,0 +1,81 @@ +;;; These routines are strictly for debugging the parser. They could +;;; be removed from the system later. + +;;; define some debugging stuff +;;; Here's the debugging control: +;;; Capabilities: +;;; record start (line,token,production,k) +;;; record end (line,token,prodection,k) +;;; print end (line,token,prodection,k,value) +;;; break start +;;; break end + +(define *parser-debug-options* '()) +(define *parser-debug-lines* '()) +(define *parser-debug-id* 0) + +(define (watch-lines . lines) + (setf *parser-debug-lines* lines)) + +(define (watching-this-line?) + (and (not (eq? *parser-debug-lines* 'none)) + (or (null? *parser-debug-lines*) + (and (>= *current-line* (car *parser-debug-lines*)) + (or (null? (cdr *parser-debug-lines*)) + (<= *current-line* (cadr *parser-debug-lines*))))))) + +(define (ptrace-print-obj x) + (pprint x)) + +(define (ptrace-breakpoint) + (error "Breakpoint~%")) + +(define (parser-show-context id tag msg) + (format '#t "~A parse of ~A(~A) Line: ~A Token: ~A" + msg tag id *current-line* *token*) + (when (not (null? *token-args*)) + (format '#t " ~A" *token-args*)) + (format '#t "~%")) + +(define (ptrace-clear) + (setf *parser-debug-options* '())) + +(define (ptrace-pop) + (pop *parser-debug-options*)) + +(define (ptrace-watch . things) + (dolist (x things) + (push (cons x 'watch) *parser-debug-options*))) + +(define (ptrace-show . things) + (dolist (x things) + (push (cons x 'show) *parser-debug-options*))) + +(define (ptrace-break . things) + (dolist (x things) + (push (cons x 'break) *parser-debug-options*))) + +;;; Routines called by the trace-parser macro + +(define (tracing-parse/entry tag) + (let ((all? (assq 'all *parser-debug-options*)) + (this? (assq tag *parser-debug-options*))) + (cond ((or all? this?) + (incf *parser-debug-id*) + (parser-show-context *parser-debug-id* tag "Entering") + (when (and this? (eq? (cdr this?) 'break)) + (ptrace-breakpoint)) + *parser-debug-id*) + (else 0)))) + +(define (tracing-parse/exit tag id res) + (let ((all? (assq 'all *parser-debug-options*)) + (this? (assq tag *parser-debug-options*))) + (when (and (or all? this?) (not (eq? tag 0))) + (setf (dynamic *returned-obj*) res) + (parser-show-context id tag "Exiting") + (when (and this? (eq? (cdr this?) 'show)) + (ptrace-print-obj res)) + (when (and this? (eq? (cdr this?) 'break)) + (ptrace-breakpoint))))) + |