3 ;;; Parser protocol implementation.
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble Object Design, an object system for C.
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.
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.
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.
26 (cl:in-package #:sod-parser)
28 ;;;--------------------------------------------------------------------------
29 ;;; Hairy functions used by parser syntax expanders.
31 (declaim (inline %many))
32 (defun %many (update final parser &key (min 0) max)
33 "Helper function for the `many' parser syntax.
35 This deals with simple repetition, without separators. See the parser
36 syntax documentation for details."
38 (let ((consumed-any-p nil))
40 ((and max (>= i max)))
41 (multiple-value-bind (value winp consumep) (funcall parser)
42 (when consumep (setf consumed-any-p t))
43 (cond (winp (funcall update value))
44 ((or consumep (< i min))
45 (return-from %many (values value nil consumed-any-p)))
47 (values (funcall final) t consumed-any-p)))
49 (defun %many-sep (update final parser sep &key (min 1) max (commitp t))
50 "Helper function for the `many' parser syntax.
52 This deals with the hairy separator and commit stuff. See the parser
53 syntax documentation for details."
55 (let ((consumed-any-p nil)
59 (multiple-value-bind (value winp consumep) (funcall sep)
60 (when consumep (setf consumed-any-p t))
62 (if (and (>= i min) (not consumep)) (return)
63 (return-from %many-sep
64 (values value nil consumed-any-p))))))
67 (multiple-value-bind (value winp consumep) (funcall parser)
68 (when consumep (setf consumed-any-p t))
69 (cond (winp (funcall update value))
70 ((or mustp consumep (< i min))
71 (return-from %many-sep
72 (values value nil consumed-any-p)))
76 (when (eql max 0) (return))
81 (loop (when (and max (>= i max)) (return)) (sep) (main t))
82 (loop (sep) (when (and max (>= i max)) (return)) (main nil)))))
84 (values (funcall final) t consumed-any-p)))
86 ;;;--------------------------------------------------------------------------
87 ;;; Token parser implementation.
89 (defmethod parser-at-eof-p ((context token-parser-context))
90 `(eq ,(parser-token-type context) :eof))
92 ;;;--------------------------------------------------------------------------
93 ;;; Simple list-based parser; useful for testing.
96 (defclass list-parser ()
97 ((var :initarg :var :type symbol :reader parser-var)))
99 (defmethod parser-at-eof-p ((context list-parser))
100 `(not ,(parser-var context)))
102 (defmethod parser-capture-place ((context list-parser))
103 `,(parser-var context))
105 (defmethod parser-restore-place ((context list-parser) place)
106 `(setf ,(parser-var context) ,place))
108 (defmethod expand-parser-spec ((context list-parser) parser)
110 (expand-parser-form context 'quote (list parser))
113 (defparse quote (:context (context list-parser) object)
114 `(if (and ,(parser-var context)
115 (eql (car ,(parser-var context)) ',object))
116 (progn (pop ,(parser-var context)) (values ',object t t))
117 (values (list ',object) nil nil)))
119 (defparse type (:context (context list-parser) type)
120 `(if (and ,(parser-var context)
121 (typep (car ,(parser-var context)) ',type))
122 (values (pop ,(parser-var context)) t t)
123 (values (list ',type) nil nil)))
125 (defmethod parser-places-must-be-released-p ((context list-parser)) nil)
127 ;;;--------------------------------------------------------------------------
128 ;;; Simple string-based parser; useful for testing.
130 (export 'string-parser)
131 (defclass string-parser (character-parser-context)
132 ((%string :initarg :string :reader parser-string)
133 (index :initarg :index :initform 0 :reader parser-index)
134 (%length :initform (gensym "LEN-") :reader parser-length)))
136 (defmethod wrap-parser ((context string-parser) form)
137 (with-slots ((string %string) index (length %length)) context
138 `(let* (,@(unless (symbolp string)
140 (setf string (gensym "STRING-"))
142 ,@(unless (symbolp index)
144 (setf index (gensym "INDEX-"))
146 (,length (length ,string)))
149 (defmethod parser-at-eof-p ((context string-parser))
150 `(>= ,(parser-index context) ,(parser-length context)))
152 (defmethod parser-current-char ((context string-parser))
153 `(char ,(parser-string context) ,(parser-index context)))
155 (defmethod parser-step ((context string-parser))
156 `(incf ,(parser-index context)))
158 (defmethod parser-capture-place ((context string-parser))
159 `,(parser-index context))
161 (defmethod parser-restore-place ((context string-parser) place)
162 `(setf ,(parser-index context) ,place))
164 (defmethod parser-places-must-be-released-p ((context string-parser)) nil)
166 ;;;----- That's all, folks --------------------------------------------------