Bind seen-positions hashtable to a context

This is so that it doesn't invalidate when used with parse-sequence,
which will continue parsing to obtain additional results after leaving
parse-sequence dynamic scope as required.

Also make type declaration in note-position use long-form to placate
ECL compiler (fixes #11).

basic.lisp

@@ -113,20 +113,15 @@ realising the non-realised ones in the backing store."
     (do-notation spec 'bind ignore-gensym)))
 
 (defparameter *memo-table* (make-hash-table))
-(defparameter *seen-positions-table* nil)
-
-(defun note-position (posn)
-  (declare ((integer 0) posn)
-           (special *seen-positions-table*))
-  (incf (gethash posn *seen-positions-table* 0)))
 
 (defun parse-sequence (parser sequence)
   "Parse a sequence (where a sequence is any object which implementes CONTEXT interface), return a
 PARSE-RESULT object. All returned values may share structure."
   (let ((*memo-table* (make-hash-table))
         (context (make-context sequence)))
     (values (make-parse-result (funcall parser context))
-            (front-of context))))
+            (front-of context)
+            (seen-positions-of context))))
 
 (defun parse-string (parser string)
   "Synonym for parse-sequence. Parse a string, return a PARSE-RESULT object. All returned values may share structure."
@@ -145,25 +140,24 @@ position -- which should provide a rough hint at how problematic that particular
  If COMPLETE is T, return the first parse to consume the input
 completely. If COMPLETE is :FIRST return the first result only when it the whole input was consumed,
 or immediately return nil."
-  (let ((*seen-positions-table* (make-hash-table)))
-    (multiple-value-bind (parse-result front) (parse-sequence (ensure-parser parser) sequence)
-      (ecase complete
-        ((nil :first)
-         (let ((result
-                (current-result parse-result)))
-           (cond ((or (null result)
-                      (and (eql complete :first)
-                           (not (end-context-p (suffix-of result)))))
-                  (values nil nil nil front))
-                 ((not (end-context-p (suffix-of result)))
-                  (values (tree-of result) (suffix-of result) t front *seen-positions-table*))
-                 (t (values (tree-of result) nil t nil *seen-positions-table*)))))
-        (t (iter (with results = parse-result)
-                 (for result = (next-result results))
-                 (while result)
-                 (when (end-context-p (suffix-of result))
-                   (return (values (tree-of result) nil t nil *seen-positions-table*)))
-                 (finally (return (values nil nil nil front)))))))))
+  (multiple-value-bind (parse-result front seen-positions) (parse-sequence (ensure-parser parser) sequence)
+    (ecase complete
+      ((nil :first)
+       (let ((result
+               (current-result parse-result)))
+         (cond ((or (null result)
+                    (and (eql complete :first)
+                         (not (end-context-p (suffix-of result)))))
+                (values nil nil nil front))
+               ((not (end-context-p (suffix-of result)))
+                (values (tree-of result) (suffix-of result) t front seen-positions))
+               (t (values (tree-of result) nil t nil seen-positions)))))
+      (t (iter (with results = parse-result)
+           (for result = (next-result results))
+           (while result)
+           (when (end-context-p (suffix-of result))
+             (return (values (tree-of result) nil t nil seen-positions)))
+           (finally (return (values nil nil nil front))))))))
 
 (defun parse-string* (parser string &key (complete nil))
   "Synonym for parse-sequence*.  Parse a string and return as multiple values the first result,

contexts.lisp

@@ -7,9 +7,10 @@
    (tags    :accessor tags-of    :initarg :tags    :initform nil)))
 
 (defclass context-common ()
-  ((length      :accessor length-of      :initarg :length      :initform 0)
-   (front       :accessor front-of       :initarg :front       :initform (make-instance 'context-front))
-   (cache       :accessor cache-of       :initarg :cache       :initform nil)))
+  ((length        :accessor length-of        :initarg :length        :initform 0)
+   (front         :accessor front-of         :initarg :front         :initform (make-instance 'context-front))
+   (cache         :accessor cache-of         :initarg :cache         :initform nil)
+   (seen-postions :accessor seen-postions-of :initarg :seen-position :initform (make-hash-table))))
 
 (defclass context ()
   ((common      :accessor common-of      :initarg :common)
@@ -24,6 +25,9 @@
 (defmethod front-of ((context context))
   (front-of (common-of context)))
 
+(defmethod seen-positions-of ((context context))
+  (seen-postions-of (common-of context)))
+
 (defmethod (setf front-of) (new-value (context context))
   (setf (front-of (common-of context)) new-value))
 
@@ -41,13 +45,17 @@
                                        `(,initarg (,accessor ,context)))))
                   ,@additional-arguments))
 
+(defun note-position (context posn)
+  (declare (type (integer 0) posn))
+  (incf (gethash posn (seen-positions-of context) 0)))
+
 (defgeneric context-peek (context))
 
 (defgeneric make-context-at-position (base-context position))
 
 (defmethod make-context-at-position :around ((context context) position)
   (let ((cache (cache-of context)))
-    (note-position position)
+    (note-position context position)
     (etypecase cache
       (null (call-next-method))
       (vector (or (aref cache position)
@@ -183,7 +191,7 @@
 (defmethod initialize-instance :around ((context context) &rest initargs &key &allow-other-keys)
   (declare (ignore initargs))
   (let ((rest (call-next-method)))
-    (note-position (slot-value rest 'position))
+    (note-position context (slot-value rest 'position))
     rest))
 
 (defmethod make-context ((vector vector) &optional (cache-type *default-context-cache*))