Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv8925
Modified Files: syntax.lisp Log Message: A parser state now stores its parser instead of just the grammar of the parser so that we can get to the initial state and the target of the parser from a given state.
Added functions for analysing parse stack.
Date: Wed Mar 2 06:21:08 2005 Author: rstrandh
Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.31 climacs/syntax.lisp:1.32 --- climacs/syntax.lisp:1.31 Wed Mar 2 05:07:26 2005 +++ climacs/syntax.lisp Wed Mar 2 06:21:07 2005 @@ -135,10 +135,9 @@ ;;; parser
(defclass parser () - ((grammar :initarg :grammar) + ((grammar :initarg :grammar :reader parser-grammar) (target :initarg :target :reader target) - (initial-state :reader initial-state) - (lexer :initarg :lexer))) + (initial-state :reader initial-state)))
(defclass rule-item () ())
@@ -202,7 +201,7 @@ nil)
(defclass parser-state () - ((grammar :initarg :grammar :reader state-grammar) + ((parser :initarg :parser :reader parser) (incomplete-items :initform (make-hash-table :test #'eq) :reader incomplete-items) (parse-trees :initform (make-hash-table :test #'eq) @@ -245,7 +244,7 @@ nil) (t (push item (gethash orig-state (incomplete-items to-state))) - (loop for rule in (rules (state-grammar to-state)) + (loop for rule in (rules (parser-grammar (parser to-state))) do (when (let ((sym1 (aref (symbols (rule item)) (dot-position item))) (sym2 (left-hand-side rule))) (or (subtypep sym1 sym2) (subtypep sym2 sym1))) @@ -269,7 +268,7 @@ (defmethod initialize-instance :after ((parser parser) &rest args) (declare (ignore args)) (with-slots (grammar initial-state) parser - (setf initial-state (make-instance 'parser-state :grammar grammar)) + (setf initial-state (make-instance 'parser-state :parser parser)) (loop for rule in (rules grammar) do (when (let ((sym (left-hand-side rule))) (or (subtypep (target parser) sym) @@ -286,12 +285,44 @@ initial-state initial-state)))))
(defun advance-parse (parser tokens state) - (with-slots (grammar) parser - (let ((new-state (make-instance 'parser-state :grammar grammar))) - (loop for token in tokens - do (potentially-handle-parse-tree token state new-state)) - new-state))) - -(defclass lexer () ()) - -(defgeneric lex (lexer)) + (let ((new-state (make-instance 'parser-state :parser parser))) + (loop for token in tokens + do (potentially-handle-parse-tree token state new-state)) + new-state)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Code for analysing parse stack + +(defun parse-stack-top (state) + "given a parse state, return a list of all incomplete items that did +not originate in that state, or if no such items exist, a list of all +parse trees of state that originated in the initial state." + (let ((items '())) + (map-over-incomplete-items + state + (lambda (key item) + (unless (eq key state) + (push item items)))) + (unless items + (loop with target = (target (parser state)) + for parse-tree in (gethash (initial-state (parser state)) + (parse-trees state)) + when (subtypep parse-tree target) + do (push parse-tree items))) + items)) + +(defun parse-stack-next (incomplete-item) + "given an incomplete item, return a list of all incomplete items it +could have been predicted from." + (let ((items '()) + (orig-state (orig-state incomplete-item)) + (sym1 (left-hand-side (rule incomplete-item)))) + (map-over-incomplete-items + orig-state + (lambda (key item) + (unless (eq key orig-state) + (when (let ((sym2 (aref (symbols (rule item)) (dot-position item)))) + (or (subtypep sym1 sym2) (subtypep sym2 sym1))) + (push item items))))) + items))