Commit | Line | Data |
---|---|---|
bf090e02 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Parsing property sets | |
4 | ;;; | |
5 | ;;; (c) 2012 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
bf090e02 MW |
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 | ||
c91b90c3 MW |
26 | (in-package #:sod) |
27 | ||
239fa5bd MW |
28 | ;;;-------------------------------------------------------------------------- |
29 | ;;; The expression parser. | |
30 | ||
31 | (flet ((dispatch (name args &rest spec) | |
32 | (acond ((find :invalid args :key #'car) | |
33 | (cons :invalid nil)) | |
34 | ((find-if (lambda (item) | |
35 | (every (lambda (type arg) | |
36 | (eql type (car arg))) | |
37 | (cddr item) | |
38 | args)) | |
39 | spec) | |
40 | (cons (car it) (apply (cadr it) | |
41 | (mapcar #'cdr args)))) | |
42 | (t | |
43 | (cerror* "Type mismatch: operator `~A' applied to ~ | |
44 | types ~{~(~A~)~#[~; and ~;, ~]~}" | |
45 | name | |
46 | (mapcar #'car args)) | |
47 | (cons :invalid nil))))) | |
48 | (let ((add (binop "+" (x y 5) | |
49 | (dispatch "+" (list x y) (list :int #'+ :int :int)))) | |
50 | (sub (binop "-" (x y 5) | |
51 | (dispatch "-" (list x y) (list :int #'- :int :int)))) | |
52 | (mul (binop "*" (x y 7) | |
53 | (dispatch "*" (list x y) (list :int #'* :int :int)))) | |
54 | (div (binop "/" (x y 7) | |
55 | (dispatch "/" (list x y) | |
56 | (list :int | |
57 | (lambda (x y) | |
58 | (cond ((zerop y) | |
59 | (cerror* | |
60 | "Division by zero") | |
61 | (cons :invalid nil)) | |
62 | (t | |
63 | (floor x y)))) | |
64 | :int :int)))) | |
65 | (nop (preop "+" (x 9) | |
66 | (dispatch "+" (list x) (list :int #'+ :int)))) | |
67 | (neg (preop "-" (x 9) | |
68 | (dispatch "-" (list x) (list :int #'- :int)))) | |
69 | (lp (lparen #\))) | |
70 | (rp (rparen #\)))) | |
71 | ||
72 | (defun parse-expression (scanner) | |
73 | "Parse and evaluate a simple expression. | |
bf090e02 MW |
74 | |
75 | The result is a pair (TYPE . VALUE). Currently, type types are `:id', | |
48f119ec | 76 | `:int', `:string', `:char', `:fragment', `:type'. If an error prevented a sane value from |
bf090e02 MW |
77 | being produced, the type `:invalid' is returned. |
78 | ||
79 | The syntax of expressions is rather limited at the moment, but more may be | |
80 | added later. | |
81 | ||
82 | expression: term | expression `+' term | expression `-' term | |
83 | term: factor | term `*' factor | term `/' factor | |
84 | factor: primary | `+' factor | `-' factor | |
dbac800b | 85 | primary: int | id | string | `(' expression `)' | `{' fragment `}' |
6ee19709 | 86 | | `<' declspec+ declarator[empty] `>' | `?' lisp-expression |
bf090e02 MW |
87 | |
88 | Only operators for dealing with integers are provided." | |
239fa5bd MW |
89 | (with-parser-context (token-scanner-context :scanner scanner) |
90 | (parse (expr (:nestedp nestedp) | |
91 | (lisp (flet ((prop (type value) | |
bf090e02 | 92 | (scanner-step scanner) |
239fa5bd MW |
93 | (values (cons type value) t t))) |
94 | (case (token-type scanner) | |
95 | ((:int :id :char :string) | |
96 | (prop (token-type scanner) | |
97 | (token-value scanner))) | |
98 | (#\? | |
99 | (let* ((stream (make-scanner-stream scanner)) | |
100 | (sexp (read stream t))) | |
101 | (scanner-step scanner) | |
1d8cc67a | 102 | (multiple-value-bind (type value) |
c6ec484f MW |
103 | (restart-case (decode-property (eval sexp)) |
104 | (continue () (values :invalid nil))) | |
1d8cc67a | 105 | (values (cons type value) t t)))) |
dbac800b MW |
106 | (#\{ |
107 | (values (cons :fragment | |
108 | (parse-delimited-fragment scanner | |
109 | #\{ #\})) | |
110 | t t)) | |
6ee19709 MW |
111 | (#\< |
112 | (parse (seq (#\< | |
113 | (ds (parse-c-type scanner)) | |
114 | (dc (parse-declarator | |
115 | scanner ds | |
116 | :kernel (lambda () | |
117 | (values nil t nil)) | |
118 | :abstractp t)) | |
119 | #\>) | |
120 | (values (cons :type (car dc)) | |
121 | t t)))) | |
239fa5bd | 122 | (t |
ec81a2ac | 123 | (values (list :int :id :char :string #\? #\{ #\<) |
239fa5bd MW |
124 | nil nil))))) |
125 | (or (seq (#\+) add) | |
126 | (seq (#\-) sub) | |
127 | (seq (#\*) mul) | |
128 | (seq (#\/) div)) | |
129 | (or (seq (#\() lp) | |
130 | (seq (#\+) nop) | |
131 | (seq (#\-) neg)) | |
132 | (when nestedp (seq (#\)) rp)))))))) | |
133 | ||
134 | ;;;-------------------------------------------------------------------------- | |
135 | ;;; Parsing property sets. | |
bf090e02 | 136 | |
b944e68b | 137 | (export 'parse-property) |
bf090e02 MW |
138 | (defun parse-property (scanner pset) |
139 | "Parse a single property using the SCANNER; add it to the PSET." | |
239fa5bd MW |
140 | ;; property ::= id `=' expression |
141 | (with-parser-context (token-scanner-context :scanner scanner) | |
142 | (parse (seq ((name :id) #\= (result (parse-expression scanner))) | |
143 | (let ((type (car result)) | |
144 | (value (cdr result))) | |
145 | (unless (eq type :invalid) | |
146 | (add-property pset name value | |
147 | :type type | |
148 | :location scanner))))))) | |
149 | ||
150 | (export 'parse-property-set) | |
151 | (defun parse-property-set (scanner) | |
c91b90c3 | 152 | "Parse an optional property set from the SCANNER and return it." |
048d0b2d | 153 | ;; property-set ::= [`[' property-list `]'] |
239fa5bd | 154 | (with-parser-context (token-scanner-context :scanner scanner) |
048d0b2d MW |
155 | (parse (? (seq (#\[ |
156 | (pset (many (pset (make-property-set) pset) | |
157 | (error () | |
158 | (parse-property scanner pset) | |
159 | (skip-until () #\, #\])) | |
160 | #\,)) | |
161 | #\]) | |
162 | pset))))) | |
bf090e02 MW |
163 | |
164 | ;;;----- That's all, folks -------------------------------------------------- |