Commit | Line | Data |
---|---|---|
bf090e02 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Top-level parser for module syntax | |
4 | ;;; | |
5 | ;;; (c) 2010 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 | (in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Toplevel syntax. | |
30 | ||
31 | (export 'module) | |
32 | ||
33 | ;;; Type names. | |
34 | ||
35 | (define-pluggable-parser module typename (scanner) | |
36 | ;; `typename' ID ( `,' ID )* `;' | |
37 | ||
38 | (with-parser-context (token-scanner-context :scanner scanner) | |
39 | (parse (and "typename" | |
40 | (skip-many (:min 1) | |
41 | (seq ((id :id)) | |
42 | (if (gethash id *module-type-map*) | |
43 | (cerror* "Type `~A' already defined" id) | |
44 | (add-to-module *module* | |
45 | (make-instance 'type-item | |
46 | :name id)))) | |
47 | #\,) | |
48 | #\;)))) | |
49 | ||
50 | ;;; Fragments. | |
51 | ||
52 | (define-pluggable-parser module code (scanner) | |
53 | ;; `code' ID `:' ID [ CONSTRAINTS ] `{' C-FRAGMENT `}' | |
54 | ||
55 | (with-parser-context (token-scanner-context :scanner scanner) | |
56 | (parse (seq ("code" | |
57 | (reason :id) | |
58 | #\: | |
59 | (name :id) | |
60 | (constraints (? (seq (#\[ | |
61 | (constraints (list (:min 1) | |
62 | (list (:min 1) :id) | |
63 | #\,)) | |
64 | #\]) | |
65 | constraints))) | |
66 | (fragment (parse-delimited-fragment scanner #\{ #\}))) | |
67 | (add-to-module *module* (make-instance 'code-fragment-item | |
68 | :fragment fragment | |
69 | :constraints constraints | |
70 | :reason reason | |
71 | :name name)))))) | |
72 | ||
73 | ;;; External files. | |
74 | ||
75 | (defun read-module (pathname &key (truename (truename pathname)) location) | |
76 | "Parse the file at PATHNAME as a module, returning it. | |
77 | ||
78 | This is the main entry point for parsing module files. You may well know | |
79 | the file's TRUENAME already (e.g., because `probe-file' dropped it into | |
80 | your lap) so you can avoid repeating the search by providing it. | |
81 | ||
82 | The LOCATION is the thing which wanted the module imported -- usually a | |
83 | `file-location' object, though it might be anything other than `t' which | |
84 | can be printed in the event of circular imports." | |
85 | ||
86 | (define-module (pathname :location location :truename truename) | |
87 | (with-open-file (f-stream pathname :direction :input) | |
88 | (let* ((*readtable* (copy-readtable)) | |
89 | (char-scanner (make-instance 'charbuf-scanner | |
90 | :stream f-stream)) | |
91 | (scanner (make-instance 'sod-token-scanner | |
92 | :char-scanner char-scanner))) | |
93 | (with-default-error-location (scanner) | |
94 | (with-parser-context (token-scanner-context :scanner scanner) | |
95 | (parse (skip-many () (plug module scanner))))))))) | |
96 | ||
97 | (define-pluggable-parser module test (scanner) | |
98 | ;; `demo' STRING `;' | |
99 | ||
100 | (with-parser-context (token-scanner-context :scanner scanner) | |
101 | (parse (seq ("demo" (string :string) #\;) | |
102 | (format t ";; DEMO ~S~%" string))))) | |
103 | ||
104 | (define-pluggable-parser module file (scanner) | |
105 | ;; `import' STRING `;' | |
106 | ;; `load' STRING `;' | |
107 | ||
108 | (flet ((common (name type what thunk) | |
109 | (find-file scanner | |
110 | (merge-pathnames name | |
111 | (make-pathname :type type | |
112 | :case :common)) | |
113 | what | |
114 | thunk))) | |
115 | (with-parser-context (token-scanner-context :scanner scanner) | |
116 | (parse (or (seq ("import" (name :string) #\;) | |
117 | (common name "SOD" "module" | |
118 | (lambda (path true) | |
119 | (handler-case | |
120 | (let ((module (read-module path | |
121 | :truename true))) | |
122 | (when module | |
123 | (module-import module) | |
124 | (pushnew module | |
125 | (module-dependencies | |
126 | *module*)))) | |
127 | (file-error (error) | |
128 | (cerror* "Error reading module ~S: ~A" | |
129 | path error)))))) | |
130 | (seq ("load" (name :string) #\;) | |
131 | (common name "LISP" "Lisp file" | |
132 | (lambda (path true) | |
133 | (handler-case | |
134 | (load true :verbose nil :print nil) | |
135 | (error (error) | |
136 | (cerror* "Error loading Lisp file ~S: ~A" | |
137 | path error))))))))))) | |
138 | ||
139 | ;;; Lisp escape. | |
140 | ||
141 | (define-pluggable-parser module lisp (scanner) | |
142 | ;; `lisp' s-expression `;' | |
143 | ||
144 | (with-parser-context (token-scanner-context :scanner scanner) | |
145 | (parse (seq ((sexp (if (and (eql (token-type scanner) :id) | |
146 | (string= (token-value scanner) "lisp")) | |
147 | (let* ((stream (make-scanner-stream scanner)) | |
148 | (sexp (read stream t))) | |
149 | (scanner-step scanner) | |
150 | (values sexp t t)) | |
151 | (values '((:id "lisp")) nil nil))) | |
152 | #\;) | |
153 | (eval sexp))))) | |
154 | ||
155 | ;;;-------------------------------------------------------------------------- | |
156 | ;;; Class declarations. | |
157 | ||
158 | (define-pluggable-parser module class (scanner) | |
159 | ;; `class' id [`:' id-list] `{' class-item* `}' | |
160 | ||
161 | (with-parser-context (token-scanner-context :scanner scanner) | |
162 | (parse (seq ("class" | |
163 | (name :id) | |
164 | (supers (? (seq (#\: (supers (list (:min 1) :id #\,))) | |
165 | supers))) | |
166 | #\{ | |
167 | ||
168 | ||
169 | ;;;----- That's all, folks -------------------------------------------------- |