;;; Example file for cl-yacc-ebnf.

;;;

;;; (c) 2009 Mikhail Novikov, Plato Wu

;;;

;;; This file is part of cl-yacc-ebnf.

;;;

;;; Permission is hereby granted, free of charge, to any person obtaining a copy

;;; of this software and associated documentation files (the "Software"), to deal

;;; in the Software without restriction, including without limitation the rights

;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

;;; copies of the Software, and to permit persons to whom the Software is

;;; furnished to do so, subject to the following conditions:

;;;

;;; The above copyright notice and this permission notice shall be included in

;;; all copies or substantial portions of the Software.

;;;

;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE

;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN

;;; THE SOFTWARE.

(defpackage #:yacc-ebnf-example

  (:export #:ebnf-example)

  (:use #:cl #:yacc #:yacc-ebnf))

(in-package #:yacc-ebnf-example)

;;; The lexer

(define-condition lexer-error (yacc-runtime-error)

  ((character :initarg :character :reader lexer-error-character))

  (:report (lambda (e stream)

             (format stream "Lexing failed~@[: unexpected character ~S~]"

                     (lexer-error-character e)))))

(defun lexer-error (char)

  (error (make-condition 'lexer-error :character char)))

(defun lexer (&optional (stream *standard-input*))

  (loop

     (let ((c (read-char stream nil nil)))

       (cond

         ((member c '(nil #\Newline)) (return-from lexer (values nil nil)))

         ((member c '(#\- #\.))

          (let ((symbol (intern (string c) '#.*package*)))

            (return-from lexer (values symbol symbol))))

         ((digit-char-p c)

          (return-from lexer (values 'digit c)))

         (t

          (lexer-error c))))))

;;; The parser

(define-ebnf-parser *expression-ebnf-parser*

  (:start-symbol S)

  (:terminals (|.| - digit))

  (:precedence nil)

  (S ((:option -) (:plus D) (:option |.| (:plus D))) ())

  (D digit))

;;; The toplevel loop

(defun ebnf-example ()

  (format t "A EBNF example:

             S := '-'? D+ ('.' D+)?

             D := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9'~%")

  (loop

     (with-simple-restart (abort "Return to ebnf-example toplevel.")

       (format t "? ")

       (let ((e (parse-with-lexer #'lexer *expression-ebnf-parser*)))

         (when (null e)

           (return-from ebnf-example))

         (format t " => ~A~%" (print e))))))