HH-Parse / parser.lisp

(in-package :hh-parse)

;; ---------------------------------------------------------------------------------------------------------------------
;; LALR(1) parser construction

;; Classes + types

(defclass lalr1-parser ()
  ((grammar :initarg :grammar :accessor grammar)
   (lexer :initarg :lexer :accessor lexer)
   (stack :initform () :accessor stack)))

(defun parse-token (parser token)
  "Advance the state of the parser by parsing a single token; does not assume token came from lexer"
  (let ((grammar (grammar parser)))
    (destructuring-bind (token-symbol token-value) (if token token (list :eof nil))
      (declare (ignorable token-value))
      (loop with continue = t
	 with result = nil
	 while continue
	 do (destructuring-bind (stack-state stack-token) (car (stack parser))
	      (declare (ignorable stack-token))
	      (let ((action (gethash (list stack-state token-symbol) (entries (actions grammar)))))
		(if action
		    (destructuring-bind (op arg) action

		      (cond ((equal :shift op)
			     (let ((next-state arg))
			       (push (list next-state token) (stack parser))
			       (setf continue nil)
			       (setf result :continue)))

			    ((equal :reduce op)
			     ;; NOTE : if there is a semantic action, after the reduction is a good time to call it
			     (let ((production arg))
			       (loop for i from 1 to (length (slot-value production 'rhs))
				  do (pop (stack parser)))
			       (destructuring-bind (new-stack-state new-stack-token) (car (stack parser))
				 (declare (ignorable new-stack-token))
				 (push (list (gethash (list new-stack-state (slot-value production 'rule-name )) (entries (gotos grammar))) 
					     (slot-value production 'rule-name))
				       (stack parser)))))

			    ((equal :accept op)
			     (setf continue nil)
			     (setf result :succeeded))

			    (t (setf continue nil)
			       (setf result :failed))))
		      (setf continue nil)
		      (setf result :failed)))))
	 finally (return (values result (car (stack parser))))))))

(defun make-parser (lexer grammar)
  (let ((parser (make-instance 'lalr1-parser :lexer lexer :grammar grammar)))
    (push (list 0 'start-rule) (stack parser))

(defun get-parse-result (parser)
  (when (stack parser)
    (destructuring-bind (stack-state stack-token) (car (stack parser))
      (declare (ignore stack-state))

(defun parse-input (parser)
  (let ((lexer (lexer parser)))
    (loop for result = (parse-token parser (next-token lexer))
       while (equal :continue result)
       finally (return (values result (get-parse-result parser))))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.