src/final.lisp (test-parse-c-type): Abstract out the tedious setup stage.
[sod] / src / final.lisp
CommitLineData
e33ea301
MW
1;;; -*-lisp-*-
2;;;
a9cffac1 3;;; Finishing touches for Sod
e33ea301
MW
4;;;
5;;; (c) 2015 Straylight/Edgeware
6;;;
7
8;;;----- Licensing notice ---------------------------------------------------
9;;;
e0808c47 10;;; This file is part of the Sensible Object Design, an object system for C.
e33ea301
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
26(cl:in-package #:sod)
27
a9cffac1 28;;;--------------------------------------------------------------------------
8f3f42a3
MW
29;;; Miscellaneous details.
30
31(export '*sod-version*)
32(defparameter *sod-version* sod-sysdef:*version*
33 "The version of the SOD translator system, as a string.")
34
35;;;--------------------------------------------------------------------------
a9cffac1
MW
36;;; Debugging utilities.
37
76618d28
MW
38(export '*debugout-pathname*)
39(defvar *debugout-pathname* #p"debugout.c")
40
e33ea301 41(export 'test-module)
60529354 42(defun test-module (path &key reason clear backtrace)
d164793c
MW
43 "Read a module from PATH, to exercise the machinery.
44
8ca4a019
MW
45 If CLEAR is non-nil, then reset the translator's state before proceeding.
46
d164793c
MW
47 If REASON is non-nil, then output the module to `*debugout-pathname*' with
48 that REASON.
49
50 Return a two-element list (NERROR NWARNING) of the number of errors and
51 warnings encountered while processing the module."
8ca4a019 52 (when clear (clear-the-decks))
31782597 53 (multiple-value-bind (module nerror nwarning)
60529354
MW
54 (if backtrace (read-module path)
55 (count-and-report-errors () (read-module path)))
118f5c00 56 (when (and module reason)
31782597
MW
57 (with-open-file (out *debugout-pathname*
58 :direction :output
59 :if-exists :supersede
60 :if-does-not-exist :create)
61 (output-module module reason out)))
62 (list nerror nwarning)))
e33ea301 63
b39de350
MW
64(defmacro with-test-scanner ((scanner string) &body body)
65 "Common machinery for `test-parse-MUMBLE' below.
66
67 This is too specialized to make more widely available."
68 (with-gensyms (in charscan)
69 (once-only (string)
70 `(with-input-from-string (,in ,string)
71 (let* ((*module-type-map* (make-hash-table))
72 (,charscan (make-instance 'charbuf-scanner
73 :stream ,in
74 :filename "<string>"))
75 (,scanner (make-instance 'sod-token-scanner
76 :char-scanner ,charscan
77 :filename "<string>")))
78 (with-parser-context (token-scanner-context :scanner ,scanner)
79 ,@body))))))
80
4fd69126
MW
81(export 'test-parse-c-type)
82(defun test-parse-c-type (string)
83 "Parse STRING as a C type, with optional kernel, and show the results."
b39de350
MW
84 (with-test-scanner (scanner string)
85 (multiple-value-bind (value winp consumedp)
86 (parse (seq ((decls (parse-c-type scanner))
87 (type (parse-declarator scanner decls :abstractp t))
88 :eof)
89 type))
90 (declare (ignore consumedp))
91 (if winp
92 (values t (car value) (cdr value)
93 (princ-to-string (car value)))
94 (values nil value)))))
4fd69126 95
3e21ae3f 96(export 'test-parser)
2b7ce7a5 97(defmacro test-parser ((scanner &key backtrace) parser input)
3e21ae3f
MW
98 "Convenient macro for testing parsers at the REPL.
99
100 This is a macro so that the parser can use the fancy syntax. The name
101 SCANNER is bound to a `sod-token-scanner' reading tokens from the INPUT
2b7ce7a5
MW
102 string. Then the PARSER is invoked and three values are returned: the
103 result of the parse, or `nil' if the main parse failed; a list containing
104 the number of errors and warnings (respectively) reported during the
105 parse; and a list consisting of the lookahead token type and value, and a
106 string containing the untokenized remaining input.
107
108 If BACKTRACE is nil (the default) then leave errors to the calling
109 environment to sort out (e.g., by entering the Lisp debugger); otherwise,
110 catch and report them as they happen so that you can test error recovery
111 strategies."
3e21ae3f 112 (once-only (input)
2b7ce7a5
MW
113 (with-gensyms (char-scanner value winp body consumedp where nerror nwarn)
114 `(let ((,char-scanner nil) (,scanner nil))
3e21ae3f 115 (with-parser-context (token-scanner-context :scanner ,scanner)
2b7ce7a5
MW
116 (multiple-value-bind (,value ,nerror ,nwarn)
117 (flet ((,body ()
118 (setf ,char-scanner (make-string-scanner ,input)
119 ,scanner (make-instance
120 'sod-token-scanner
121 :char-scanner ,char-scanner))
b543a2d9
MW
122 (with-default-error-location (,scanner)
123 (multiple-value-bind (,value ,winp ,consumedp)
124 (parse ,parser)
125 (declare (ignore ,consumedp))
126 (cond (,winp ,value)
127 (t (syntax-error ,scanner ,value)
128 nil))))))
2b7ce7a5
MW
129 (if ,backtrace (,body)
130 (count-and-report-errors ()
b543a2d9 131 (,body))))
3e21ae3f 132 (let ((,where (scanner-capture-place ,char-scanner)))
2b7ce7a5
MW
133 (values ,value
134 (list ,nerror ,nwarn)
135 (and ,scanner (list (token-type ,scanner)
136 (token-value ,scanner)
137 (subseq ,input ,where)))))))))))
3e21ae3f 138
180bfa7c
MW
139;;;--------------------------------------------------------------------------
140;;; Calisthenics.
141
142(export 'exercise)
143(defun exercise ()
144 "Exercise the pieces of the metaobject protocol.
145
146 In some Lisps, the compiler is run the first time methods are called, to
147 do fancy just-in-time optimization things. This is great, only the
148 program doesn't actually run for very long and a lot of that work is
149 wasted because we're going to have to do it again next time the program
150 starts. Only, if we exercise the various methods, or at least a large
151 fraction of them, before we dump an image, then everything will be fast.
152
153 That's the theory anyway. Call this function before you dump an image and
154 see what happens."
155
180bfa7c
MW
156 (dolist (reason '(:h :c))
157 (with-output-to-string (bitbucket)
158 (output-module *builtin-module* reason bitbucket)))
159
160 (clear-the-decks))
161
dc162ca6
MW
162;;;--------------------------------------------------------------------------
163;;; Make sure things work after loading the system.
164
165(clear-the-decks)
166
e33ea301 167;;;----- That's all, folks --------------------------------------------------