Today's wip.
[sod] / src / parser / scanner-token-impl.lisp
1 ;;; -*-lisp-*-
2 ;;;
3 ;;; Tokenizing scanner
4 ;;;
5 ;;; (c) 2009 Straylight/Edgeware
6 ;;;
7
8 ;;;----- Licensing notice ---------------------------------------------------
9 ;;;
10 ;;; This file is part of the Sensble Object Design, an object system for C.
11 ;;;
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
16 ;;;
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25
26 (cl:in-package #:sod-parser)
27
28 ;;;--------------------------------------------------------------------------
29 ;;; Token scanner implementation.
30
31 (defmethod shared-initialize :after
32 ((scanner token-scanner) slot-names &key)
33 (declare (ignore slot-names))
34 (scanner-step scanner))
35
36 (defmethod scanner-at-eof-p ((scanner token-scanner))
37 (with-slots (type) scanner
38 (eq type :eof)))
39
40 (defmethod scanner-step ((scanner token-scanner))
41 (with-slots (type value tail captures line column) scanner
42 (acond ((and tail (token-scanner-place-next tail))
43 (setf type (token-scanner-place-type it)
44 value (token-scanner-place-value it)
45 line (token-scanner-place-line it)
46 column (token-scanner-place-column it)
47 tail it))
48 (t
49 (multiple-value-bind (ty val) (scanner-token scanner)
50 (setf type ty
51 value val)
52 (if (plusp captures)
53 (let ((next (make-token-scanner-place
54 :type ty :value val
55 :line line :column column)))
56 (setf (token-scanner-place-next tail) next
57 tail next))
58 (setf tail nil)))))))
59
60 (defmethod scanner-capture-place ((scanner token-scanner))
61 (with-slots (type value captures tail line column) scanner
62 (incf captures)
63 (or tail
64 (setf tail (make-token-scanner-place
65 :type type :value value :line line :column column)))))
66
67 (defmethod scanner-restore-place ((scanner token-scanner) place)
68 (with-slots (type value tail line column) scanner
69 (setf type (token-scanner-place-type place)
70 value (token-scanner-place-value place)
71 line (token-scanner-place-line place)
72 column (token-scanner-place-column place)
73 tail place)))
74
75 (defmethod scanner-release-place ((scanner token-scanner) place)
76 (with-slots (captures) scanner
77 (decf captures)))
78
79 ;;;----- That's all, folks --------------------------------------------------