src/method-{proto,impl}.lisp: Abstract out the receiver type.
[sod] / src / parser / scanner-impl.lisp
index 0849648..411cbc1 100644 (file)
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 (export '(string-scanner make-string-scanner string-scanner-p))
 (defstruct (string-scanner
             (:constructor make-string-scanner
-                (string &key (start 0) end
-                 &aux (index start)
+                (string
+                 &key (start 0) end filename
+                 &aux (%string string)
+                      (index start)
                       (limit (or end (length string))))))
   "Scanner structure for a simple string scanner."
-  (string "" :type string :read-only t)
+  (%string "" :type string :read-only t)
+  (filename "<string>" :type string :read-only t)
   (index 0 :type (and fixnum unsigned-byte))
-  (limit nil :type (and fixnum unsigned-byte) :read-only t))
+  (limit nil :type (and fixnum unsigned-byte) :read-only t)
+  (line 1 :type fixnum)
+  (column 0 :type fixnum))
+(define-access-wrapper string-scanner-string string-scanner-%string
+                      :read-only t)
 
 (defmethod scanner-at-eof-p ((scanner string-scanner))
   (>= (string-scanner-index scanner) (string-scanner-limit scanner)))
   (char (string-scanner-string scanner) (string-scanner-index scanner)))
 
 (defmethod scanner-step ((scanner string-scanner))
-  (incf (string-scanner-index scanner)))
+  (let ((index (string-scanner-index scanner)))
+    (setf (values (string-scanner-line scanner)
+                 (string-scanner-column scanner))
+         (update-position (char (string-scanner-string scanner) index)
+                          (string-scanner-line scanner)
+                          (string-scanner-column scanner))
+         (string-scanner-index scanner) (1+ index))))
+
+(defmethod scanner-unread ((scanner string-scanner) char)
+  (let ((index (1- (string-scanner-index scanner))))
+    (setf (values (string-scanner-line scanner)
+                 (string-scanner-column scanner))
+         (backtrack-position (char (string-scanner-string scanner) index)
+                             (string-scanner-line scanner)
+                             (string-scanner-column scanner))
+         (string-scanner-index scanner) index)))
+
+(defmethod scanner-filename ((scanner string-scanner))
+  (string-scanner-filename scanner))
+(defmethod scanner-line ((scanner string-scanner))
+  (string-scanner-line scanner))
+(defmethod scanner-column ((scanner string-scanner))
+  (string-scanner-column scanner))
+(defmethod file-location ((scanner string-scanner))
+  (make-file-location (string-scanner-filename scanner)
+                     (string-scanner-line scanner)
+                     (string-scanner-column scanner)))
 
 (defmethod scanner-capture-place ((scanner string-scanner))
   (string-scanner-index scanner))
 
 (defmethod scanner-interval
     ((scanner string-scanner) place-a &optional place-b)
-  (with-slots (string index) scanner
+  (with-slots ((string %string) index) scanner
     (subseq string place-a (or place-b index))))
 
+(defmethod make-scanner-stream ((scanner string-scanner))
+  (make-instance 'character-scanner-stream :scanner scanner))
+
 ;;;--------------------------------------------------------------------------
 ;;; List scanner.
 
-(export 'list-scanner)
+(export '(list-scanner list-scanner-p make-list-scanner))
 (defstruct (list-scanner
-            (:constructor make-list-scanner (list)))
+            (:constructor make-list-scanner (list &aux (%list list))))
   "Simple token scanner for lists.
 
    The list elements are the token semantic values; the token types are the
    names of the elements' classes.  This is just about adequate for testing
    purposes, but is far from ideal for real use."
-  (list nil :type list))
+  (%list nil :type list))
+(define-access-wrapper list-scanner-list list-scanner-%list)
 
 (defmethod scanner-step ((scanner list-scanner))
   (pop (list-scanner-list scanner)))