branch: externals/parser-generator
commit b040d9b521facd990c01df38e50b5fca6ae38663
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Tests for infix calculator working
---
parser-generator-lr.el | 43 +++++++++++++++++++---------------------
parser-generator.el | 6 ++++--
test/parser-generator-lr-test.el | 18 ++++++++++-------
3 files changed, 35 insertions(+), 32 deletions(-)
diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index b84b914..8c74a52 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -653,16 +653,10 @@
(dolist (lr-item lr-items)
(let ((symbols (nth 2 lr-item)))
(when symbols
+ ;; Convert symbols in grammar with attributes to simple symbols
(let ((next-symbol
- (car symbols)))
-
- ;; Convert symbols with attributes to simple symbols
- (when
- (listp next-symbol)
- (setq
- next-symbol
- (car next-symbol)))
-
+ (parser-generator--get-symbol-without-attributes
+ (car symbols))))
(let ((temp-hash-key
(format
"%S"
@@ -1335,15 +1329,11 @@
lr-item-suffix-rest
(cdr lr-item-suffix))
- ;; Remove potential attributes from symbol for comparison
- (if
- (listp lr-item-suffix-first)
- (setq
- lr-item-suffix-first-wo-attributes
- (car lr-item-suffix-first))
- (setq
- lr-item-suffix-first-wo-attributes
- lr-item-suffix-first))
+ ;; NOTE x is always without attributes
+ (setq
+ lr-item-suffix-first-wo-attributes
+ (parser-generator--get-symbol-without-attributes
+ lr-item-suffix-first))
(parser-generator--debug
(message "lr-item: %s" lr-item)
@@ -1364,7 +1354,8 @@
(let ((combined-prefix
(append
lr-item-prefix
- (list lr-item-suffix-first))))
+ (list
+ lr-item-suffix-first))))
(let ((lr-new-item-1))
(if
(=
@@ -1397,9 +1388,9 @@
(while added-new
(setq added-new nil)
- ;; TODO Use caches to optimize this loop?
(dolist (lr-item lr-new-item)
- (let ((lr-item-suffix (nth 2 lr-item)))
+ (let ((lr-item-suffix
+ (nth 2 lr-item)))
(let ((lr-item-suffix-first
(car lr-item-suffix))
(lr-item-suffix-rest
@@ -1408,6 +1399,10 @@
(nth 3 lr-item))))
(parser-generator--debug
(message
+ "lr-item-suffix-first: %s from %s"
+ lr-item-suffix-first
+ lr-item-suffix)
+ (message
"lr-item-suffix-rest: %s from %s + %s"
lr-item-suffix-rest
(cdr lr-item-suffix)
@@ -1416,8 +1411,10 @@
;; (b) If [A -> a . Bb, u] has been placed in V(X1,...,Xi)
;; and B -> D is in P
(when
- (parser-generator--valid-non-terminal-p
- lr-item-suffix-first)
+ (and
+ lr-item-suffix-first
+ (parser-generator--valid-non-terminal-p
+ lr-item-suffix-first))
(let ((lr-item-suffix-rest-first
(parser-generator--first
diff --git a/parser-generator.el b/parser-generator.el
index befa2ca..eea8285 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -17,7 +17,7 @@
(defvar
parser-generator--debug
- t
+ nil
"Whether to print debug messages or not.")
(defvar
@@ -849,7 +849,9 @@
(setq
valid-attribute
nil))
- (setq symbol (car symbol)))
+ (setq
+ symbol
+ (car symbol)))
(and
valid-attribute
(gethash
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index f8e4848..013e3c1 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -791,18 +791,13 @@
(exp "-" exp (lambda(args) (- (nth 0 args) (nth 2 args))))
(exp "*" exp (lambda(args) (* (nth 0 args) (nth 2 args))))
(exp "/" exp (lambda(args) (/ (nth 0 args) (nth 2 args))))
- ("-" (exp (%prec NEG)) (lambda(args) (- (nth 1 args))))
+ ("-" exp (lambda(args) (- (nth 1 args))))
(exp "^" exp (lambda(args) (expt (nth 0 args) (nth 2 args))))
("(" exp ")" (lambda(args) (nth 1 args)))))
start))
(parser-generator-process-grammar)
- ;; TODO What we want is that after - exp there is a reduce action
- (let ((lr-item-sets (parser-generator-lr-generate-parser-tables)))
- (message "")
- (message "RAMBO: %S" lr-item-sets)
- (message ""))
-
+ (parser-generator-lr-generate-parser-tables)
(let ((buffer (generate-new-buffer "*buffer*")))
(switch-to-buffer buffer)
@@ -841,6 +836,15 @@
(parser-generator-lr-translate)))
(message "Passed -33+5 with correct result")
+ (switch-to-buffer buffer)
+ (kill-region (point-min) (point-max))
+ (insert "-33-3\n")
+ (should
+ (equal
+ -36
+ (parser-generator-lr-translate)))
+ (message "Passed -33-3 with correct result")
+
(kill-buffer))
(message "Passed tests for (parser-generator-lr--parse)"))
