chiark / gitweb /
src/{module-impl,utilities}.lisp: Make `#line' work when pretty-printing.
[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
8f3f42a3
MW
28;;;--------------------------------------------------------------------------
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
a9cffac1
MW
35;;;--------------------------------------------------------------------------
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
180bfa7c
MW
53;;;--------------------------------------------------------------------------
54;;; Calisthenics.
55
56(export 'exercise)
57(defun exercise ()
58 "Exercise the pieces of the metaobject protocol.
59
60 In some Lisps, the compiler is run the first time methods are called, to
61 do fancy just-in-time optimization things. This is great, only the
62 program doesn't actually run for very long and a lot of that work is
63 wasted because we're going to have to do it again next time the program
64 starts. Only, if we exercise the various methods, or at least a large
65 fraction of them, before we dump an image, then everything will be fast.
66
67 That's the theory anyway. Call this function before you dump an image and
68 see what happens."
69
70 (clear-the-decks)
71 (dolist (reason '(:h :c))
72 (with-output-to-string (bitbucket)
73 (output-module *builtin-module* reason bitbucket)))
74
75 (clear-the-decks))
76
e33ea301 77;;;----- That's all, folks --------------------------------------------------