Track position paths, not just position tips. This gives much better error locs.
authorTony Garnock-Jones <tonyg@kcbbs.gen.nz>
Sun, 18 Jan 2009 00:22:47 +0000
changeset 29 7b6adad58777
parent 28 0a56ed00bf44
child 30 af04a16148de
Track position paths, not just position tips. This gives much better error locs.
ometa.scm
--- a/ometa.scm	Sat Jan 17 23:12:07 2009 +0000
+++ b/ometa.scm	Sun Jan 18 00:22:47 2009 +0000
@@ -113,8 +113,18 @@
   (lambda (err)
     (kf (merge-parse-errors err prev-err))))
 
+;; Note that the argument pos is a parse position tip, not a position
+;; path. It's wrapped in a list, making it into a position path,
+;; before being placed in the error structure. See also
+;; contextualize-parse-error.
 (define (make-parse-error pos error-report)
-  (cons pos (list error-report)))
+  (cons (list pos) (list error-report)))
+
+;; Note that the argument pos is a parse position tip, not a position
+;; path. It is prepended to the position path in err, thereby placing
+;; the err in the context of pos.
+(define (contextualize-parse-error pos err)
+  (and err (cons (cons pos (car err)) (cdr err))))
 
 ;; Input streams need to supply
 ;;  - head item
@@ -388,18 +398,18 @@
 			  (lambda (pos)
 			    (kf (make-parse-error pos0 `(expected ,item0)))))))))))
       ((nest)
-       (input (lambda (pos item tail)
-		(let ((stream (->input-stream-or-false item)))
-		  (if stream
-		      (e (cadr exp) env stream
-			 (lambda (sv new-env next err)
-			   (ks sv new-env tail err))
-			 kf)
-		      (kf (make-parse-error (input-stream-position input)
-					    `(expected sequence-for-nesting))))))
-	      (lambda (pos)
-		(kf (make-parse-error (input-stream-position input)
-				      `(expected sequence-for-nesting))))))
+       (let ((context-position (input-stream-position input)))
+	 (input (lambda (pos item tail)
+		  (let ((stream (->input-stream-or-false item)))
+		    (if stream
+			(e (cadr exp) env stream
+			   (lambda (sv new-env next err)
+			     (ks sv new-env tail (contextualize-parse-error context-position err)))
+			   (lambda (err)
+			     (kf (contextualize-parse-error context-position err))))
+			(kf #f))))
+		(lambda (pos)
+		  (kf #f)))))
       ((not)
        (e (cadr exp) env input
 	  (lambda (sv new-env next err)