3 ;;; Finishing touches for Sod
5 ;;; (c) 2015 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible 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.
28 ;;;--------------------------------------------------------------------------
29 ;;; Miscellaneous details.
31 (export '*sod-version*)
32 (defparameter *sod-version* sod-sysdef:*version*
33 "The version of the SOD translator system, as a string.")
35 ;;;--------------------------------------------------------------------------
36 ;;; Debugging utilities.
38 (export '*debugout-pathname*)
39 (defvar *debugout-pathname* #p"debugout.c")
42 (defun test-module (path &key reason)
43 "Read a module from PATH, to exercise the machinery.
45 If REASON is non-nil, then output the module to `*debugout-pathname*' with
48 Return a two-element list (NERROR NWARNING) of the number of errors and
49 warnings encountered while processing the module."
50 (multiple-value-bind (module nerror nwarning)
51 (count-and-report-errors () (read-module path))
52 (when (and module reason)
53 (with-open-file (out *debugout-pathname*
56 :if-does-not-exist :create)
57 (output-module module reason out)))
58 (list nerror nwarning)))
60 (export 'test-parse-c-type)
61 (defun test-parse-c-type (string)
62 "Parse STRING as a C type, with optional kernel, and show the results."
63 (with-input-from-string (in string)
64 (let* ((*module-type-map* (make-hash-table))
65 (charscan (make-instance 'charbuf-scanner
67 :filename "<string>"))
68 (tokscan (make-instance 'sod-token-scanner
69 :char-scanner charscan
70 :filename "<string>")))
71 (with-parser-context (token-scanner-context :scanner tokscan)
72 (multiple-value-bind (value winp consumedp)
73 (parse (seq ((decls (parse-c-type tokscan))
74 (type (parse-declarator tokscan decls :abstractp t))
77 (declare (ignore consumedp))
79 (values t (car value) (cdr value)
80 (princ-to-string (car value)))
81 (values nil value)))))))
84 (defmacro test-parser ((scanner &key backtrace) parser input)
85 "Convenient macro for testing parsers at the REPL.
87 This is a macro so that the parser can use the fancy syntax. The name
88 SCANNER is bound to a `sod-token-scanner' reading tokens from the INPUT
89 string. Then the PARSER is invoked and three values are returned: the
90 result of the parse, or `nil' if the main parse failed; a list containing
91 the number of errors and warnings (respectively) reported during the
92 parse; and a list consisting of the lookahead token type and value, and a
93 string containing the untokenized remaining input.
95 If BACKTRACE is nil (the default) then leave errors to the calling
96 environment to sort out (e.g., by entering the Lisp debugger); otherwise,
97 catch and report them as they happen so that you can test error recovery
100 (with-gensyms (char-scanner value winp body consumedp where nerror nwarn)
101 `(let ((,char-scanner nil) (,scanner nil))
102 (with-parser-context (token-scanner-context :scanner ,scanner)
103 (multiple-value-bind (,value ,nerror ,nwarn)
105 (setf ,char-scanner (make-string-scanner ,input)
106 ,scanner (make-instance
108 :char-scanner ,char-scanner))
109 (multiple-value-bind (,value ,winp ,consumedp)
111 (declare (ignore ,consumedp))
113 (t (syntax-error ,scanner ,value)
115 (if ,backtrace (,body)
116 (count-and-report-errors ()
117 (with-default-error-location (,scanner)
119 (let ((,where (scanner-capture-place ,char-scanner)))
121 (list ,nerror ,nwarn)
122 (and ,scanner (list (token-type ,scanner)
123 (token-value ,scanner)
124 (subseq ,input ,where)))))))))))
126 ;;;--------------------------------------------------------------------------
131 "Exercise the pieces of the metaobject protocol.
133 In some Lisps, the compiler is run the first time methods are called, to
134 do fancy just-in-time optimization things. This is great, only the
135 program doesn't actually run for very long and a lot of that work is
136 wasted because we're going to have to do it again next time the program
137 starts. Only, if we exercise the various methods, or at least a large
138 fraction of them, before we dump an image, then everything will be fast.
140 That's the theory anyway. Call this function before you dump an image and
143 (dolist (reason '(:h :c))
144 (with-output-to-string (bitbucket)
145 (output-module *builtin-module* reason bitbucket)))
149 ;;;--------------------------------------------------------------------------
150 ;;; Make sure things work after loading the system.
154 ;;;----- That's all, folks --------------------------------------------------