src/sod.asd.in: Make sure `final.lisp' is processed last.
[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
MW
41(export 'test-module)
42(defun test-module (path reason)
43 "Reset the translator's state, read a module from PATH and output it with
44 REASON, returning the result as a string."
e33ea301
MW
45 (clear-the-decks)
46 (setf *module-map* (make-hash-table :test #'equal))
76618d28
MW
47 (with-open-file (out *debugout-pathname*
48 :direction :output
49 :if-exists :supersede
50 :if-does-not-exist :create)
e33ea301
MW
51 (output-module (read-module path) reason out)))
52
4fd69126
MW
53(export 'test-parse-c-type)
54(defun test-parse-c-type (string)
55 "Parse STRING as a C type, with optional kernel, and show the results."
56 (with-input-from-string (in string)
57 (let* ((*module-type-map* (make-hash-table))
58 (charscan (make-instance 'charbuf-scanner
59 :stream in
60 :filename "<string>"))
61 (tokscan (make-instance 'sod-token-scanner
62 :char-scanner charscan
63 :filename "<string>")))
64 (with-parser-context (token-scanner-context :scanner tokscan)
65 (multiple-value-bind (value winp consumedp)
66 (parse (seq ((decls (parse-c-type tokscan))
67 (type (parse-declarator tokscan decls :abstractp t))
68 :eof)
69 type))
70 (declare (ignore consumedp))
71 (if winp
72 (values t (car value) (cdr value)
73 (princ-to-string (car value)))
74 (values nil value)))))))
75
3e21ae3f 76(export 'test-parser)
2b7ce7a5 77(defmacro test-parser ((scanner &key backtrace) parser input)
3e21ae3f
MW
78 "Convenient macro for testing parsers at the REPL.
79
80 This is a macro so that the parser can use the fancy syntax. The name
81 SCANNER is bound to a `sod-token-scanner' reading tokens from the INPUT
2b7ce7a5
MW
82 string. Then the PARSER is invoked and three values are returned: the
83 result of the parse, or `nil' if the main parse failed; a list containing
84 the number of errors and warnings (respectively) reported during the
85 parse; and a list consisting of the lookahead token type and value, and a
86 string containing the untokenized remaining input.
87
88 If BACKTRACE is nil (the default) then leave errors to the calling
89 environment to sort out (e.g., by entering the Lisp debugger); otherwise,
90 catch and report them as they happen so that you can test error recovery
91 strategies."
3e21ae3f 92 (once-only (input)
2b7ce7a5
MW
93 (with-gensyms (char-scanner value winp body consumedp where nerror nwarn)
94 `(let ((,char-scanner nil) (,scanner nil))
3e21ae3f 95 (with-parser-context (token-scanner-context :scanner ,scanner)
2b7ce7a5
MW
96 (multiple-value-bind (,value ,nerror ,nwarn)
97 (flet ((,body ()
98 (setf ,char-scanner (make-string-scanner ,input)
99 ,scanner (make-instance
100 'sod-token-scanner
101 :char-scanner ,char-scanner))
102 (multiple-value-bind (,value ,winp ,consumedp)
103 (parse ,parser)
104 (declare (ignore ,consumedp))
105 (cond (,winp ,value)
106 (t (syntax-error ,scanner ,value)
107 nil)))))
108 (if ,backtrace (,body)
109 (count-and-report-errors ()
110 (with-default-error-location (,scanner)
111 (,body)))))
3e21ae3f 112 (let ((,where (scanner-capture-place ,char-scanner)))
2b7ce7a5
MW
113 (values ,value
114 (list ,nerror ,nwarn)
115 (and ,scanner (list (token-type ,scanner)
116 (token-value ,scanner)
117 (subseq ,input ,where)))))))))))
3e21ae3f 118
180bfa7c
MW
119;;;--------------------------------------------------------------------------
120;;; Calisthenics.
121
122(export 'exercise)
123(defun exercise ()
124 "Exercise the pieces of the metaobject protocol.
125
126 In some Lisps, the compiler is run the first time methods are called, to
127 do fancy just-in-time optimization things. This is great, only the
128 program doesn't actually run for very long and a lot of that work is
129 wasted because we're going to have to do it again next time the program
130 starts. Only, if we exercise the various methods, or at least a large
131 fraction of them, before we dump an image, then everything will be fast.
132
133 That's the theory anyway. Call this function before you dump an image and
134 see what happens."
135
136 (clear-the-decks)
137 (dolist (reason '(:h :c))
138 (with-output-to-string (bitbucket)
139 (output-module *builtin-module* reason bitbucket)))
140
141 (clear-the-decks))
142
e33ea301 143;;;----- That's all, folks --------------------------------------------------