Commit c93b5e31 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Corrected error formatting.

parent f8d1f885
......@@ -49,7 +49,7 @@
"WORD-EQUAL"
"*SPACE*"
;; SCANNER:
"SCANNER" "SCANNER-CURRENT-TOKEN"
"SCANNER"
"SCANNER-SOURCE" "SCANNER-FILE" "SCANNER-LINE" "SCANNER-COLUMN" "SCANNER-STATE"
"SCANNER-SPACES" "SCANNER-TAB-WIDTH"
"SCANNER-TOKEN-KIND-PACKAGE"
......@@ -81,7 +81,7 @@ License:
AGPL3
Copyright Pascal J. Bourguignon 2004 - 2015
Copyright Pascal J. Bourguignon 2004 - 2016
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
......
......@@ -169,7 +169,10 @@
(:documentation "TAB aligns to column number modulo TAB-WIDTH."))
(defgeneric scanner-current-token (scanner)
(:documentation "The last token read."))
(defgeneric scanner-current-text (scanner)
(:documentation "Text of the current token")
(:method ((scanner scanner))
(prin1-to-string (scanner-current-token scanner))))
(defclass scanner (sloted-object)
((source :initarg :source
......
......@@ -31,6 +31,7 @@
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil)))
(defpackage "COM.INFORMATIMAGO.RDP"
......
......@@ -439,15 +439,18 @@ RETURN: an equivalent, cleaned list of rules.
(assert (string= --> '-->)
() "Rules should be written as (--> <non-terminal> <rhs> [:action <form>...])~%~
Invalid rule: ~S" rule)
`(,non-terminal ,(clean
(cond
((find :action items)
`(seq ,@items))
((and (= 1 (length items))
(listp (first items)))
(first items))
(t
`(seq ,@items :action `(,',non-terminal ,@,(dollar 0)))))))))
(handler-case
`(,non-terminal ,(clean
(cond
((find :action items)
`(seq ,@items))
((and (= 1 (length items))
(listp (first items)))
(first items))
(t
`(seq ,@items :action `(,',non-terminal ,@,(dollar 0)))))))
(error (err)
(error "While cleaning rule ~S~%~A" rule err)))))
rules))
;;;
......@@ -579,8 +582,20 @@ RETURN: A hash-table containing the firsts-set for each symbol of the
() "There are duplicates in the first sets of the rules for the non-terminal ~S: ~S"
non-terminal (duplicates firsts-set))
(setf (gethash non-terminal firsts-sets) unique-firsts-set)))))
(map nil (function firsts-set) (grammar-all-terminals grammar))
(map nil (function firsts-set) (grammar-all-non-terminals grammar)))
(map nil (lambda (terminal)
(handler-case
(firsts-set terminal)
(error (err)
(error "While computing the firsts set of terminal ~S~%~A"
terminal err))))
(grammar-all-terminals grammar))
(map nil (lambda (non-terminal)
(handler-case
(firsts-set non-terminal)
(error (err)
(error "While computing the firsts set of non-terminal ~S~%~A"
non-terminal err))))
(grammar-all-non-terminals grammar)))
firsts-sets))
......@@ -1044,25 +1059,28 @@ RETURN: the new production set; the new non-terminal set
;; :non-terminals *non-terminal-stack*))
,@body))
(defun error-unexpected-token (scanner expected-tokens production)
(restart-case
(error 'unexpected-token-error
:file (scanner-file scanner)
:line (scanner-line scanner)
:column (scanner-column scanner)
:state (scanner-state scanner)
;; :grammar (grammar-named ',(grammar-name grammar))
:scanner scanner
:non-terminal-stack (copy-list *non-terminal-stack*)
:expected-tokens expected-tokens
:format-control "Unexpected token ~A (~S)~:[~@[~%Expected ~{~A~}~]~;~%Expected one of ~{~A~^, ~}~]~%~S~@[~%~{~A --> ~S~}~]"
:format-arguments (list
(scanner-current-token scanner)
(scanner-current-text scanner)
(cdr expected-tokens)
expected-tokens
*non-terminal-stack*
production))
(let ((err (make-condition 'unexpected-token-error
:file (scanner-file scanner)
:line (scanner-line scanner)
:column (scanner-column scanner)
:state (scanner-state scanner)
;; :grammar (grammar-named ',(grammar-name grammar))
:scanner scanner
:non-terminal-stack (copy-list *non-terminal-stack*)
:expected-tokens expected-tokens
:format-control "Unexpected token ~A (~S)~:[~@[~%Expected ~{~A~}~]~;~%Expected one of ~{~A~^, ~}~]~%~S~@[~%~S~]"
:format-arguments (list
(scanner-current-token scanner)
(scanner-current-text scanner)
(cdr expected-tokens)
expected-tokens
*non-terminal-stack*
production))))
(error err))
(skip-token-and-continue ()
:report (lambda (stream)
(format stream "Skip token ~:[~A ~A~;~*<~A>~], and continue"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment