~progn~-combination, and one for producing output, which subclasses
can override.
- + Investigate a `robust-ABI' layout using pointers rather than simple
- inclusion. Each class's islots and vtmsgs will be found by
- following a pointer rather than just magically knowing the offsets.
- If you allocate objects dynamically, using ~CLASS->cls.initsz~
- rather than ~sizeof(CLASS__ilayout)~ then this isolates you from
- added slots and messages at all superclasses. I expect this to
- require a separate root class, but it /might/ be possible to
- mix-and-match.
+ + Implement `indirect' slots and messages, which can be added (once a
+ class has declared support) /without/ breaking the class's ABI.
+ Indirect messages can be added to an indirect `vtmsgs' structure via
+ a pointer in the main vtable. Indirect slots must be added to a
+ region of the `ilayout' located via an offset stored in the vtable.
+ * Add `documentation' methods for all of the myriad kinds of things
+ that can be defined. A useful utility will find methods on a
+ generic function with an `eql'-specializer in some specified place.
+
+ * Define static initializers for class layouts which obviate the need
+ for imprinting.
* COMMENT Emacs cruft
dnl--------------------------------------------------------------------------
dnl Common Lisp things.
-AC_ARG_WITH([lisp-system],
- [AS_HELP_STRING([--with-lisp-system=SYSTEMS],
- [preference order of cl-launch Lisp systems])],
- [], [with_lisp_system="sbcl clisp"])
-
-AC_CHECK_PROGS([CL_LAUNCH], [cl-launch], [not-found])
-case "$CL_LAUNCH" in
- not-found) AC_MSG_ERROR([\`cl-launch' not found]) ;;
-esac
+WORKING_LISPS="sbcl,clisp,ecl"; AC_SUBST([WORKING_LISPS])
-AC_MSG_CHECKING([for best choice of Lisp system])
-if ! LISPSYS=$($CL_LAUNCH -l "$with_lisp_system" \
- -ip '(string-downcase (lisp-implementation-type))'); then
- AC_MSG_ERROR([cl-launch didn't like any Lisp system])
-fi
-AC_SUBST([LISPSYS])
-AC_MSG_RESULT([$LISPSYS])
+AC_CHECK_PROGS([RUNLISP], [runlisp], [not-found])
+case "$RUNLISP" in
+ not-found) AC_MSG_ERROR([\`runlisp' not found]) ;;
+esac
AC_MSG_CHECKING([FASL file extension])
-fasl=$($CL_LAUNCH -l $LISPSYS -ip \
- '(pathname-type (compile-file-pathname "foo.lisp"))')
+fasl=$($RUNLISP -L$WORKING_LISPS -e \
+ '(format t "~A~%"
+ (pathname-type (compile-file-pathname "foo.lisp")))')
AC_SUBST([fasl])
AC_MSG_RESULT([.$fasl])
CLEANFILES += *.aux *.out *.log *.toc *.ind *.idx *.ilg
EXTRA_DIST += $(TEX_FILES) $(BIB_FILES)
-TEXFLAGS = --interaction=batchmode \
- --output-directory=$(abs_builddir)
-BIBTEXFLAGS = --terse
-MAKEINDEXFLAGS = -q
+V_LATEX = $(V_LATEX_@AM_V@)
+V_LATEX_ = $(V_LATEX_@AM_DEFAULT_V@)
+V_LATEX_0 = @echo " LATEX $@";
-V_LATEX = $(V_LATEX_@AM_V@)
-V_LATEX_ = $(V_LATEX_@AM_DEFAULT_V@)
-V_LATEX_0 = @echo " LATEX $@";
+V_TEXMODE = $(V_TEXMODE_@AM_V@)
+V_TEXMODE_ = $(V_TEXMODE_@AM_DEFAULT_V@)
+V_TEXMODE_0 = batchmode
+V_TEXMODE_1 = nonstopmode
-V_BIBTEX = $(V_BIBTEX_@AM_V@)
-V_BIBTEX_ = $(V_BIBTEX_@AM_DEFAULT_V@)
-V_BIBTEX_0 = @echo " BIBTEX $@";
+V_BIBTEX = $(V_BIBTEX_@AM_V@)
+V_BIBTEX_ = $(V_BIBTEX_@AM_DEFAULT_V@)
+V_BIBTEX_0 = @echo " BIBTEX $@";
-V_MAKEINDEX = $(V_MAKEINDEX_@AM_V@)
-V_MAKEINDEX_ = $(V_MAKEINDEX_@AM_DEFAULT_V@)
-V_MAKEINDEX_0 = @echo " MAKEIDX $@";
+V_MAKEINDEX = $(V_MAKEINDEX_@AM_V@)
+V_MAKEINDEX_ = $(V_MAKEINDEX_@AM_DEFAULT_V@)
+V_MAKEINDEX_0 = @echo " MAKEIDX $@";
+
+TEXFLAGS = --interaction=$(V_TEXMODE) \
+ --output-directory=$(abs_builddir)
+BIBTEXFLAGS = --terse
+MAKEINDEXFLAGS = -q
run_pdflatex = $(V_LATEX)cd $(srcdir) && \
version=$$(echo '$(VERSION)' | sed 's/~/\\textasciitilde /g') && \
mdwalpha.bst: mdwalpha.dbj
(cd $(srcdir) && $(TEX) \
--jobname=mdwalpha \
- --interaction=batchmode \
+ --interaction=$(V_TEXMODE) \
--output-directory=$(abs_builddir) \
'\let\ifbatching\iftrue \input mdwalpha.dbj')
endif
endif
+###--------------------------------------------------------------------------
+### Maintenance rules.
+
+fixup-wordlist:
+ { IFS= read -r hdr && echo "$$hdr" && \
+ LC_COLLATE=POSIX sort -f; \
+ } <$(srcdir)/sod.words >$(srcdir)/sod.words.new && \
+ mv $(srcdir)/sod.words.new $(srcdir)/sod.words
+.PHONY: fixup-wordlist
+
+update-symbols:
+ $(ASDF_ENV) $(RUNLISP) -L$(WORKING_LISPS) $(srcdir)/list-exports \
+ >$(srcdir)/SYMBOLS.new && \
+ mv $(srcdir)/SYMBOLS.new $(srcdir)/SYMBOLS
+.PHONY: update-symbols
+
+check-manual: update-symbols sod.pdf
+ $(srcdir)/check-docs sod.aux $(srcdir)/SYMBOLS
+.PHONY: check-manual
+
###----- That's all, folks --------------------------------------------------
c-types-impl.lisp
cl:* variable function c-type-form
- alignas
+ alignas c-storage-form
alignas-storage-specifier class
cl:array class c-type-form
atomic c-type-form
c-type macro class
c-type-alias macro
c-type-equal-p generic
+ c-type-form
c-type-qualifier-keywords function
c-type-qualifiers generic
c-type-space function
if-parse macro
sod-utilities:it
label parser-form
- lisp c-type-form parser-form
+ lisp c-type-form c-storage-form parser-form
cl:list function class parser-form opthandler
many parser-form
cl:not function parser-form
die-usage function
do-options macro
do-usage function
- exit function
help-options optmacro
inc opthandler
sod-utilities:int c-type-spec c-type-form opthandler
opt-negated-tag function setf-function
opt-short-name function setf-function
opt-tag function setf-function
+ opthandler
option class
option-parse-error function class
option-parse-next function
option-parser-p function
optionp function
options macro
+ optmacro
parse-option-form function
cl:read function opthandler
sanity-check-option-list function
sb-mop:eql-specializer class
sb-mop:eql-specializer-object generic
find-duplicates function
+ find-eql-specialized-method function
frob-identifier function
sb-mop:generic-function-methods generic setf-generic
inconsistent-merge-error class
elsif ($st eq LIST) {
my @F = split;
(my $sym = shift @F) =~ s/^(.+)://;
- $labels->{"sym:$sym"} = 1 unless @F;
+ $labels->{"sym:$sym"} = $file;
for my $t (@F) {
if ($t eq 'constant') { $labels->{"const:$sym"} = $file; }
elsif ($t eq 'variable') { $labels->{"var:$sym"} = $file; }
elsif ($t eq 'class') { $labels->{"cls:$sym"} = $file; }
elsif ($t eq 'c-type-spec') { $labels->{"cty:$sym"} = $file; }
elsif ($t eq 'c-type-form') { $labels->{"cty:$sym"} = $file; }
+ elsif ($t eq 'c-storage-spec') { $labels->{"cstg:$sym"} = $file; }
+ elsif ($t eq 'c-storage-form') { $labels->{"cstg:$sym"} = $file; }
elsif ($t eq 'parser-spec') { $labels->{"parse:$sym"} = $file; }
elsif ($t eq 'parser-form') { $labels->{"parseform:$sym"} = $file; }
elsif ($t eq 'opthandler') { $labels->{"opt:$sym"} = $file; }
close $fh;
}
-my %DEF = map { $_ => 1 }
+my %DEF = map { $_ => "<magic>" }
"cls:array", "cls:class", "cls:error", "cls:float", "cls:function",
"cls:list", "cls:string",
"const:nil",
'sym', 'const', 'var', 'mac', 'fun', 'gf', 'cls', 'modvar', 'const',
'meth', 'ar-meth', 'be-meth', 'af-meth',
'msg', 'feat',
- 'rst', 'ty', 'lmac', 'parse', 'parseform', 'opt', 'optmac', 'plug';
+ 'rst', 'ty', 'lmac', 'parse', 'parseform', 'opt', 'optmac', 'plug',
+ 'cty', 'cstg';
-my $AUXDIR = "build/doc/";
+sub die_usage () { die "usage: $0 AUXFILE SYMFILE\n"; }
+die_usage unless @ARGV; my $auxfile = shift @ARGV;
+die_usage unless @ARGV; my $symfile = shift @ARGV;
+die_usage if @ARGV;
+(my $AUXDIR = $auxfile) =~ s![^/]*$!!;
+$auxfile =~ s!^.*/!!;
sub scanaux (\%$) {
my ($def, $f) = @_;
open my $fh, "<", "$AUXDIR$f";
while (<$fh>) {
chomp;
- if (/^\\\@input\{([^}]*\.aux)\}$/) { scanaux($def, $1); }
- elsif (/^\\newlabel\{([^:]+):([^}]+)\}/ && $CAT{$1})
- { $def->{"$1:$2"} = $s; }
+ if (/^\\\@input\{([^}]*\.aux)\}$/)
+ { scanaux($def, $1); }
+ elsif (/^\\newlabel\{([^:]+):([^}]+)\}/ && $CAT{$1}) {
+ my ($cat, $sym) = ($1, $2);
+ $def->{"$cat:$sym"} = $s;
+ $def->{"sym:$sym"} //= $s unless $sym =~ m!^setf/|\(.*\)$!;
+ }
}
close $fh;
}
-scansyms %LABEL, "doc/SYMBOLS";
-scanaux %DEF, "sod.aux";
+scansyms %LABEL, $symfile;
+scanaux %DEF, $auxfile;
+
+##use Data::Dumper;
+##print "LABELS = " . Dumper(\%LABEL) . "\n";
+##print "DEF = " . Dumper(\%DEF) . "\n";
my $BAD = 0;
SYM: for my $sym (sort keys %LABEL) {
if ($DEF{$sym}) { next SYM; }
my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/;
- if ($tag eq "cls" && $DEF{"ty:$name"}) { }
+ if ($name eq "nil" && $DEF{"$tag:()"}) { }
+ elsif ($tag eq "cls" && $DEF{"ty:$name"}) { }
elsif ($tag eq "gf" && $DEF{"fun:$name"}) { }
elsif ($tag eq "var" && $DEF{"const:$name"}) { }
elsif ($tag eq "sym" && $DEF{"plug:$name"}) { }
- elsif ($tag eq "sym" && $DEF{"lmac:$name"}) { }
- elsif ($sym eq "sym:alignas" && $DEF{"cls:alignas-storage-specifier"}) { }
- elsif ($sym eq "fun:main" && $DEF{"fun:sod-frontend:main"}) { }
- elsif ($sym eq "fun:augment-options" &&
- $DEF{"fun:sod-frontend:augment-options"}) { }
+ elsif ($sym =~ /^(fun|sym):(main|augment-options)$/ &&
+ $DEF{"$tag:sod-frontend:$name"}) { }
elsif ($sym eq "gf:setf/generic-function-methods") { }
- elsif ($tag eq "cty") { }
else { bad "missing $tag:$name (defined in $LABEL{$sym})"; }
}
SYM: for my $sym (sort keys %DEF) {
if ($LABEL{$sym}) { next SYM; }
my ($tag, $name) = $sym =~ /^([^:]+):(.*)$/;
- if ($tag eq "ty" && $LABEL{"cls:$name"}) { }
+ if ($name eq "()" && $LABEL{"$tag:nil"}) { }
+ elsif ($tag eq "ty" && $LABEL{"cls:$name"}) { }
elsif ($tag eq "const" && $LABEL{"var:$name"}) { }
elsif ($tag eq "fun" && $LABEL{"gf:$name"}) { }
+ elsif ($tag eq "sym" && $name =~ /^:/) { }
elsif ($DEF{$sym} eq "runtime.tex") { }
elsif ($DEF{$sym} eq "structures.tex") { }
elsif ($sym eq "lmac:parse") { }
$sym eq "parse:t" || $sym eq "parseform:t" ||
$sym eq "parseform:when") { }
elsif ($sym eq "plug:class-item" || $sym eq "plug:module") { }
- elsif ($sym eq "sym:int") { }
+ elsif ($sym eq "sym:int" || $sym eq "sym:atom" || $sym eq "sym:t" ||
+ $sym eq "sym:when") { }
elsif ($name =~ /^sod-frontend:(.*)$/ && $LABEL{"$tag:$1"}) { }
else { bad "unexpected $tag:$name (described in $DEF{$sym})"; }
}
@|c-keyword-function-type| \-
\end{tabbing}}
\caption{Classes representing C types}
-\label{fig:codegen.c-types.classes}
+ \label{fig:codegen.c-types.classes}
\end{figure}
C type objects are immutable unless otherwise specified.
into.
\end{describe}
+\begin{describe}{cty}{lisp @<form>^*}
+ Evaluates the @<form>s as an implicit @|progn|, and returns the value(s) of
+ the final @<form> as a C type.
+\end{describe}
+
\begin{describe}{gf}
{print-c-type @<stream> @<type> \&optional @<colon> @<atsign>}
Print the C type object @<type> to @<stream> in S-expression form. The
default method.
\end{describe}
+\begin{describe*}
+ {\dhead{sym}{c-type}
+ \dhead{meth}{symbol,(eql 'c-type)}
+ {documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'c-type))}
+ \dhead{meth}{symbol,(eql 'c-type)}
+ {setf \=(documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'c-type))) \\
+ \>@<string>}}
+\end{describe*}
+
+\begin{describe*}
+ {\dhead{sym}{c-type-form}
+ \dhead{meth}{symbol,(eql 'c-type-form)}
+ {documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'c-type-form))}
+ \dhead{meth}{symbol,(eql 'c-type-form)}
+ {setf \=(documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'c-type-form))) \\
+ \>@<string>}}
+\end{describe*}
+
\subsection{Comparing C types} \label{sec:clang.c-types.cmp}
its lower-case print name in C; but other storage specifiers may be more
complicated objects.
-\begin{describe}{cls}
- {c-storage-specifiers-type (c-type) \&key :subtype :specifiers}
+\begin{describe*}
+ {\dhead{cls}{c-storage-specifiers-type (c-type)
+ \&key :subtype :specifiers}
+ \dhead{cty}{specs @<subtype> @<specifier>^*}}
A type which carries storage specifiers. The @<subtype> is the actual
type, and may be any C type; the @<specifiers> are a list of
storage-specifier objects.
- The type specifier @|(specs @<subtype> @<specifier>^*)| wraps the
- @<subtype> in a @|c-storage-specifiers-type|, carrying the @<specifier>s,
- which are a list of storage specifiers in S-expression notation.
-\end{describe}
+ The type specifier @|specs| wraps the @<subtype> in a
+ @|c-storage-specifiers-type|, carrying the @<specifier>s, which are a list
+ of storage specifiers in S-expression notation.
+\end{describe*}
\begin{describe}{fun}{c-type-specifiers @<type> @> @<list>}
Returns the list of type specifiers attached to the @<type> object, which
@|(c-type (specs @<subtype> (@<head> . @<tail>)))|.
\end{describe}
+\begin{describe}{cstg}{lisp @<form>^*}
+ Evaluates the @<form>s as an implicit @|progn|, and returns the value(s) of
+ the final @<form> as a storage-specifier.
+\end{describe}
+
\begin{describe}{gf}{pprint-c-storage-specifier @<spec> @<stream>}
+ Prints the storage-specifier @<spec> to @<stream>, in C syntax.
\end{describe}
\begin{describe}{gf}
@<base-type>.
\end{describe}
-\begin{describe}{cls}{alignas-storage-specifier () \&key :alignment}
- The class of @|_Alignas| storage specifiers; an instance denotes the
- specifier @|_Alignas(@<alignment>)|. The @<alignment> parameter may be any
- printable object, but is usually a string or C fragment.
-
- The storage specifier form @|(alignas @<alignment>)| returns a storage
- specifier @|_Alignas(@<alignment>)|, where @<alignment> is evaluated.
-\end{describe}
+\begin{describe*}
+ {\dhead{cls}{alignas-storage-specifier () \&key :alignment}
+ \dhead{cstg}{alignas @<alignment>}}
+ The class of \mbox{@|_Alignas|} storage specifiers; an instance denotes the
+ specifier \mbox{@|_Alignas(@<alignment>)|}. The @<alignment> parameter may
+ be any printable object, but is usually a string or C fragment.
+
+ The storage specifier form @|alignas| returns a storage specifier
+ \mbox{@|_Alignas(@<alignment>)|}, where @<alignment> is evaluated.
+\end{describe*}
\subsection{Leaf types} \label{sec:clang.c-types.leaf}
Two simple type objects are equal if and only if they have @|string=| names
and matching qualifiers.
- \def\x#1{\desclabel{const}{c-type-#1}}
- \x{bool} \x{char} \x{wchar-t} \x{signed-char} \x{unsigned-char} \x{short}
- \x{unsigned-short} \x{int} \x{unsigned} \x{long} \x{unsigned-long}
- \x{long-long} \x{unsigned-long-long} \x{size-t} \x{ptrdiff-t} \x{float}
- \x{double} \x{long-double} \x{float-imaginary} \x{double-imaginary}
- \x{long-double-imaginary} \x{float-complex} \x{double-complex}
- \x{long-double-complex} \x{va-list} \x{void}
- \crossproduct\x{{{int}{uint}}{{}{-least}{-fast}}{{8}{16}{32}{64}}{{-t}}}
- \crossproduct\x{{{int}{uint}}{{ptr}{max}}{{-t}}}
+ \def\x#1{\desclabel{cty}{#1}}
+ \def\y#1{\desclabel{const}{c-type-#1}\x{#1}}
+ \y{bool} \y{wchar-t}
+ \y{int} \x{signed} \y{unsigned} \y{signed-char}
+ \crossproduct\y{{{}{unsigned-}}{{char}{short}{long}{long-long}}}
+ \crossproduct\x{{{}{signed-}{unsigned-}}{{short}{long}{long-long}}{{-int}}}
+ \crossproduct\x{{{signed-}{unsigned-}}{{int}}}
+ \crossproduct\x{{{signed-}}{{short}{int}{long}{long-long}}}
+ \crossproduct\x{{{s}{u}}{{char}{short}{int}{long}{llong}}} \x{llong}
+ \y{size-t} \y{ptrdiff-t} \y{float}
+ \y{double} \y{long-double} \y{float-imaginary} \y{double-imaginary}
+ \y{long-double-imaginary} \y{float-complex} \y{double-complex}
+ \y{long-double-complex} \y{va-list} \y{void}
+ \crossproduct\y{{{int}{uint}}{{}{-least}{-fast}}{{8}{16}{32}{64}}{{-t}}}
+ \crossproduct\y{{{int}{uint}}{{ptr}{max}}{{-t}}}
A number of symbolic type specifiers for builtin types are predefined as
shown in \xref{tab:codegen.c-types.simple}. These are all defined as if by
type class as a symbol.
\end{describe}
-\begin{describe}{cls}{c-enum-type (tagged-c-type) \&key :qualifiers :tag}
+\begin{describe*}
+ {\dhead{cls}{c-enum-type (tagged-c-type) \&key :qualifiers :tag}
+ \dhead{cty}{enum @<tag> @<qualifier>^*}}
Represents a C enumerated type. An instance denotes the C type @|enum|
@<tag>. See the direct superclass @|tagged-c-type| for details.
- The type specifier @|(enum @<tag> @<qualifier>^*)| returns the (unique
- interned) enumerated type with the given @<tag> and @<qualifier>s (all
- evaluated).
-\end{describe}
+ The type specifier @|enum| returns the (unique interned) enumerated type
+ with the given @<tag> and @<qualifier>s (all evaluated).
+\end{describe*}
\begin{describe}{fun}
{make-enum-type @<tag> \&optional @<qualifiers> @> @<c-enum-type>}
keywords).
\end{describe}
-\begin{describe}{cls}{c-struct-type (tagged-c-type) \&key :qualifiers :tag}
+\begin{describe*}
+ {\dhead{cls}{c-struct-type (tagged-c-type) \&key :qualifiers :tag}
+ \dhead{cty}{struct @<tag> @<qualifier>^*}}
Represents a C structured type. An instance denotes the C type @|struct|
@<tag>. See the direct superclass @|tagged-c-type| for details.
- The type specifier @|(struct @<tag> @<qualifier>^*)| returns the (unique
- interned) structured type with the given @<tag> and @<qualifier>s (all
- evaluated).
-\end{describe}
+ The type specifier @|struct| returns the (unique interned) structured type
+ with the given @<tag> and @<qualifier>s (all evaluated).
+\end{describe*}
\begin{describe}{fun}
{make-struct-type @<tag> \&optional @<qualifiers> @> @<c-struct-type>}
keywords).
\end{describe}
-\begin{describe}{cls}{c-union-type (tagged-c-type) \&key :qualifiers :tag}
+\begin{describe*}
+ {\dhead{cls}{c-union-type (tagged-c-type) \&key :qualifiers :tag}
+ \dhead{cty}{union @<tag> @<qualifier>^*}}
Represents a C union type. An instance denotes the C type @|union|
@<tag>. See the direct superclass @|tagged-c-type|
for details.
- The type specifier @|(union @<tag> @<qualifier>^*)| returns the (unique
- interned) union type with the given @<tag> and @<qualifier>s (all
- evaluated).
-\end{describe}
+ The type specifier @|union| returns the (unique interned) union type with
+ the given @<tag> and @<qualifier>s (all evaluated).
+\end{describe*}
+
\begin{describe}{fun}
{make-union-type @<tag> \&optional @<qualifiers> @> @<c-union-type>}
Return the (unique interned) C type object for the union C type whose tag
types are not the same as atomic-qualified types: you must be consistent
about which you use.
-\begin{describe}{cls}
- {c-atomic-type (qualifiable-c-type) \&key :qualifiers :subtype}
+\begin{describe*}
+ {\dhead{cls}{c-atomic-type (qualifiable-c-type)
+ \&key :qualifiers :subtype}
+ \dhead{cty}{atomic @<type-spec> @<qualifier>^*}}
Represents an atomic type. An instance denotes the C type
@|_Atomic(@<subtype>)|.
have matching qualifiers. It is possible, though probably not useful, to
have an atomic-qualified atomic type.
- The type specifier @|(atomic @<type-spec> @<qualifier>^*)| returns a type
- qualified atomic @<subtype>, where @<subtype> is the type specified by
- @<type-spec> and the @<qualifier>s are qualifier keywords (which are
- evaluated).
-\end{describe}
+ The type specifier @|atomic| returns a type qualified atomic @<subtype>,
+ where @<subtype> is the type specified by @<type-spec> and the
+ @<qualifier>s are qualifier keywords (which are evaluated).
+\end{describe*}
\begin{describe}{fun}
{make-atomic-type @<c-type> \&optional @<qualifiers> @> @<c-atomic-type>}
Pointers are compound types. The subtype of a pointer type is the type it
points to.
-\begin{describe}{cls}
- {c-pointer-type (qualifiable-c-type) \&key :qualifiers :subtype}
+\begin{describe*}
+ {\dhead{cls}{c-pointer-type (qualifiable-c-type)
+ \&key :qualifiers :subtype}
+ \dhead{cty}{* @<type-spec> @<qualifier>^*}
+ \dhead{cty}{string}
+ \dhead{cty}{const-string}}
Represents a C pointer type. An instance denotes the C type @<subtype>
@|*|@<qualifiers>.
The @<subtype> may be any C type. Two pointer types are equal if and only
if their subtypes are equal and they have matching qualifiers.
- The type specifier @|(* @<type-spec> @<qualifier>^*)| returns a type
- qualified pointer-to-@<subtype>, where @<subtype> is the type specified by
- @<type-spec> and the @<qualifier>s are qualifier keywords (which are
- evaluated). The synonyms @|ptr| and @|pointer| may be used in place of the
- star @`*'.
+ \desclabel{cty}{ptr}
+ \desclabel{cty}{pointer}
+ The type specifier @|*| returns a type qualified pointer-to-@<subtype>,
+ where @<subtype> is the type specified by @<type-spec> and the
+ @<qualifier>s are qualifier keywords (which are evaluated). The synonyms
+ @|ptr| and @|pointer| may be used in place of the star @`*'.
The symbol @|string| is a type specifier for the type pointer to
characters; the symbol @|const-string| is a type specifier for the type
pointer to constant characters.
-\end{describe}
+\end{describe*}
\begin{describe}{fun}
{make-pointer-type @<c-type> \&optional @<qualifiers>
Arrays implement the compound-type protocol. The subtype of an array type is
the array element type.
-\begin{describe}{cls}{c-array-type (c-type) \&key :subtype :dimensions}
+\begin{describe*}
+ {\dhead{cls}{c-array-type (c-type) \&key :subtype :dimensions}
+ \dhead{cty}{[] @<type-spec> @<dimension>^*}}
+ \desclabel{cty}{array}[|(]
+ \desclabel{cty}{vec}[|(]
Represents a multidimensional C array type. The @<dimensions> are a list
of dimension specifiers $d_0$, $d_1$, \ldots, $d_{n-1}$; an instance then
denotes the C type @<subtype> @|[$d_0$][$d_1$]$\ldots$[$d_{n-1}$]|. An
$d_1$ of \ldots\ arrays of $d_{n-1}$ elements of type @<subtype>. We shall
continue to abuse terminology and refer to multidimensional arrays.
- The type specifier @|([] @<type-spec> @<dimension>^*)| constructs a
- multidimensional array with the given @<dimension>s whose elements have the
- type specified by @<type-spec>. If no dimensions are given then a
- single-dimensional array with unspecified extent. The synonyms @|array|
- and @|vector| may be used in place of the brackets @`[]'.
-\end{describe}
+ The type specifier @|[]| constructs a multidimensional array with the given
+ @<dimension>s whose elements have the type specified by @<type-spec>. If
+ no dimensions are given then a single-dimensional array with unspecified
+ extent. The synonyms @|array| and @|vec| may be used in place of the
+ brackets @`[]'.
+
+ \desclabel{cty}{array}[|)]
+ \desclabel{cty}{vec}[|)]
+\end{describe*}
\begin{describe}{fun}
{make-array-type @<subtype> @<dimensions> @> @<c-array-type>}
unchanged.
\end{describe}
-\begin{describe}{cls}{c-function-type (c-type) \&key :subtype :arguments}
+\begin{describe*}
+ {\dhead{cls}{c-function-type (c-type) \&key :subtype :arguments}
+ \dhead*{cty}{fun @<return-type>
+ @{ (@<arg-name> @<arg-type>) @}^*
+ @[:ellipsis @! . @<form>@]}}
+ \desclabel{cty}{()}[|(]
+ \desclabel{cty}{fn}[|(]
+ \desclabel{cty}{func}[|(]
+ \desclabel{cty}{function}[|(]
+ \descindex{cty}{fun}[|(]
Represents C function types. An instance denotes the type of a C
function which accepts the @<arguments> and returns @<subtype>.
in the same order, and either both or neither argument list ends with
@|:ellipsis|; argument names are not compared.
- The type specifier
- \begin{prog}
- (fun @<return-type>
- @{ (@<arg-name> @<arg-type>) @}^*
- @[:ellipsis @! . @<form>@])
- \end{prog}
- constructs a function type. The function has the subtype @<return-type>.
- The remaining items in the type-specifier list are used to construct the
- argument list. The argument items are a possibly improper list, beginning
- with zero or more \emph{explicit arguments}: two-item
- @<arg-name>/@<arg-type> lists. For each such list, an @|argument| object
- is constructed with the given name (evaluated) and type. Following the
- explicit arguments, there may be
+ The type specifier @|fun| constructs a function type. The function has the
+ subtype @<return-type>. The remaining items in the type-specifier list are
+ used to construct the argument list. The argument items are a possibly
+ improper list, beginning with zero or more \emph{explicit arguments}:
+ two-item @<arg-name>/@<arg-type> lists. For each such list, an @|argument|
+ object is constructed with the given name (evaluated) and type. Following
+ the explicit arguments, there may be
\begin{itemize}
\item nothing, in which case the function's argument list consists only of
the explicit arguments;
(ret (c-type-subtype other-func))) \-\\ \ind
(c-type (fun \=(lisp ret) ("first" int) . args)
\end{prog}
-\end{describe}
+ \descindex{cty}{fun}[|)]
+\end{describe*}
-\begin{describe}{cls}
- {c-keyword-function-type (c-function-type)
- \&key :subtype :arguments :keywords}
+\begin{describe*}
+ {\dhead{cls}{c-keyword-function-type (c-function-type)
+ \&key :subtype :arguments :keywords}
+ \dhead{cty}{fun \=@<return-type>
+ @{ (@<arg-name> @<arg-type>) @}^* \+\\
+ @{ \=:keys @{ (@<kw-name> @<kw-type>
+ @[@<kw-default>@]) @}^*
+ @[. @<form>@] @! \+\\
+ . @<form> @}}}
Represents `functions' which accept keyword arguments. Of course, actual C
functions can't accept keyword arguments directly, but this type is useful
for describing messages and methods which deal with keyword arguments.
arguments accepted by the functions is not significant.
Keyword functions are constructed using an extended version of the @|fun|
- specifier used for ordinary C function types. The extended syntax is as
- follows.
- \begin{prog}
- (fun \=@<return-type>
- @{ (@<arg-name> @<arg-type>) @}^* \+\\
- @{ \=:keys @{ (@<kw-name> @<kw-type> @[@<kw-default>@]) @}^*
- @[. @<form>@] @! \+\\
- . @<form> @}
- \end{prog}
- where either the symbol @|:keys| appears literally in the specifier, or the
- @<form> evaluates to a list containing the symbol @|:keys|. (If neither of
- these circumstances obtains, then the specifier constructs an ordinary
- function type.)
+ specifier (or any of its synonyms) used for ordinary C function types.
+ Either the symbol @|:keys| must appear literally in the specifier, or the
+ @<form> must evaluate to a list containing the symbol @|:keys|. (If
+ neither of these circumstances obtains, then the specifier constructs an
+ ordinary function type.)
See the description of \descref{cls}{c-function-type} for how a trailing
@<form> is handled.
The list of @<arg-name>s and @<arg-type>s describes the positional
arguments. The list of @<kw-name>s, @<kw-type>s and @<kw-defaults>s
describes the keyword arguments.
-\end{describe}
+
+ \descindex{cty}{()}[|)]
+ \descindex{cty}{fn}[|)]
+ \descindex{cty}{func}[|)]
+ \descindex{cty}{function}[|)]
+\end{describe*}
\begin{describe}{fun}
{make-function-type @<subtype> @<arguments> @> @<c-function-type>}
\subsection{Class types} \label{sec:clang.c-types.class}
-\begin{describe}{cls}
- {c-class-type (simple-c-type) \&key :class :tag :qualifiers :name}
-\end{describe}
+\begin{describe*}
+ {\dhead{cls}{c-class-type (simple-c-type)
+ \&key :class :tag :qualifiers :name}
+ \dhead{cty}{class @<name> @<qualifier>^*}}
+\end{describe*}
\begin{describe*}
{\dhead{gf}{c-type-class @<class-type> @> @<class>}
-#! /bin/sh
-":"; ### -*-lisp-*-
-":"; CL_SOURCE_REGISTRY=$(pwd)/build/src/:
-":"; ASDF_OUTPUT_TRANSLATIONS=$(pwd)/src:$(pwd)/build/src
-":"; export CL_SOURCE_REGISTRY ASDF_OUTPUT_TRANSLATIONS
-":"; exec cl-launch -X -l "sbcl cmucl" -s asdf -i "(sod-exports::main)" -- "$0" "$@" || exit 1
+#! /usr/bin/runlisp -Lsbcl,cmucl
+;;; -*-lisp-*-
(cl:defpackage #:sod-exports
(:use #:common-lisp
;; Load the target system so that we can poke about in it.
(cl:in-package #:sod-exports)
(eval-when (:compile-toplevel :load-toplevel :execute)
- (mapc #'asdf:load-system '(:sod :sod-frontend)))
+ (asdf:clear-configuration)
+ (mapc #'asdf:load-system '(:sod :sod/frontend)))
;;;--------------------------------------------------------------------------
;;; Miscelleneous utilities.
(push :c-type-spec things))
(when (specialized-on-p #'sod:expand-c-type-form 0 symbol)
(push :c-type-form things))
+ (when (specialized-on-p #'sod:expand-c-storage-specifier 0 symbol)
+ (push :c-storage-spec things))
+ (when (specialized-on-p #'sod:expand-c-storage-specifier-form 0 symbol)
+ (push :c-storage-form things))
(when (specialized-on-p #'sod-parser:expand-parser-spec 1 symbol)
(push :parser-spec things))
(when (specialized-on-p #'sod-parser:expand-parser-form 1 symbol)
(push :parser-form things))
- (when (get symbol 'optparse::opthandler)
+ (when (get symbol 'optparse::opthandler-function)
(push :opthandler things))
- (when (get symbol 'optparse::optmacro)
+ (when (get symbol 'optparse::optmacro-function)
(push :optmacro things))
(nreverse things)))
(let* ((sod (asdf:find-system "sod"))
(parser-files (files (by-name sod "parser")))
(utilities (by-name sod "utilities"))
- (sod-frontend (asdf:find-system "sod-frontend"))
+ (sod-frontend (asdf:find-system "sod/frontend"))
(optparse (by-name sod "optparse"))
(frontend (by-name sod-frontend "frontend"))
(sod-files (set-difference (files sod) (list optparse utilities))))
;;; Command-line use.
(defun main ()
- "Write a report to `doc/SYMBOLS'."
- (with-open-file (*standard-output* #p"doc/SYMBOLS"
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create)
- (report-project-symbols)))
-
-#+interactive (main)
+ "Write a report to *standard-output*."
+ (report-project-symbols))
+
+#+runlisp-script (main)
;;;----- That's all, folks --------------------------------------------------
\end{describe}
\end{describe*}
+\begin{describe}{fun}
+ {find-eql-specialized-method @<function> @<arg> @<objcet>}
+ Find and return a method defined on a generic @<function> whose @<arg>th
+ argument (counting from zero) is @|eql|-specialized on the givan
+ @<object>. If there is no such method on @<function> then return @|nil|.
+ If there are multiple such methods, return one of them arbitrarily.
+\end{describe}
+
\begin{describe*}
{\dhead{gf}{generic-function-methods @<generic-function> @> @<list>}
\dhead{gf}{method-specializers @<method> @> @<list>}
Most of these symbols are defined in the @|optparse| package.
-\begin{describe}{fun}{exit \&optional (@<code> 0) \&key :abrupt}
-\end{describe}
-
\begin{describe}{var}{*program-name*}
\end{describe}
@<form>^*}
\end{describe}
+\begin{describe*}
+ {\dhead{sym}{opthandler}
+ \dhead{meth}{symbol,(eql 'opthandler)}
+ {documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'opthandler))}
+ \dhead{meth}{symbol,(eql 'opthandler)}
+ {setf \=(documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'opthandler))) \\
+ \>@<string>}}
+\end{describe*}
+
\begin{describe}{fun}
{invoke-option-handler @<handler> @<locative> @<arg> @<arguments>}
\end{describe}
@<form>^*}
\end{describe}
+\begin{describe*}
+ {\dhead{sym}{optmacro}
+ \dhead{meth}{symbol,(eql 'optmacro)}
+ {documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'optmacro))}
+ \dhead{meth}{symbol,(eql 'optmacro)}
+ {setf \=(documentation (@<symbol> symbol)
+ (@<doc-type> (eql 'optmacro))) \\
+ \>@<string>}}
+\end{describe*}
+
\begin{describe}{fun}{parse-option-form @<form>}
\end{describe}
\else\def\next@{#1{plain}{#2}{#3}{#5}{#4}}\fi\fi\fi%
\next@%
}
-\def\parse@dhd@csetf#1#2#3#4(#5 #6\q@{%
+\def\parse@dhd@csetf#1#2#3#4#5(#6 #7\q@{%
% {NEXT}{CAT}{{...}...}{SYNOPSIS}(NAME [ARGS...])\q@
- #1{setf}{#2}{#3}{#5}{#4}}
+ #1{setf}{#2}{#3}{#6}{#4}}
+
%% \dhead[MOD]{CAT}{...}...[NAME]{SYNOPSIS}
%% \dhead*[MOD]{CAT}{...}...[NAME]{SYNOPSIS}
\protected@edef\@tempa##1{%
\noexpand\index{\@desc@dispatch{descindex}{#2}{#1}{#2}#3{#4}##1}}%
\toks@\expandafter{\@tempa{|)}}%
- \toks\tw@\expandafter{\after@desc}%
- \xdef\after@desc{\the\toks\tw@\the\toks@}%
- \@tempa{|(}}%
+ \toks\tw@\expandafter{\after@desc}%
+ \xdef\after@desc{\the\toks\tw@\the\toks@}%
+ \@tempa{|(}}%
\fi%
\rlap{\hb@xt@\linewidth{\hfil\normalfont\bfseries
- [\describecategoryname[#1]{#2}]}}%
+ [\describecategoryname[#1]{#2}]}}%
#5%
}
%%
%% The MOD is the modifier to apply, similar (but subtly different from) to
%% the `describe' environment. If omitted, it will usually default to
-%% `plain', but in the absence of a NAME, some kinds of synopses are
-%% recognized specially:
+%% `plain', but in the absence of a NAME, some kinds of labels are recognized
+%% specially:
%%
%% * `*NAME*': defaults MOD to `muffs'.
%%
\definedescribecategory{opt}{option handler}
\definedescribecategory{optmac}{option macro}
\definedescribecategory{plug}{pluggable parser}
+\definedescribecategory{cty}{C type form}
+\definedescribecategory{cstg}{C storage specifier}
%%%----- That's all, folks --------------------------------------------------
\endinput
-personal_ws-1.1 en 290
-structs
+personal_ws-1.1 en 292
+aand
+ABI
+ABIs
+abstractp
+acase
+accessor
+accessors
+ACM
+acond
+acyclic
+aecase
+aetypecase
+afterness
+aif
+alice
+alignas
+allocators
+anaphoric
+anaphorics
+ansi
+aor
+ap
+api
+ar
+arg
+args
argumentp
-SIG
-prog
-goto
-uchar
-dylan
-valist
-paren
-MyClass
-rprec
-toset
-CLASSOF
-llong
-kwparse
-KWPARSE
+asdf
asetf
-cls
-lbuild
-uint
-ecase
-anaphorics
+atsign
+atypecase
+awhen
+barrett
+binop
+bool
buf
-qualifiable
-unspecialized
-dir
-lvalue
-aand
+canonfied
+canonifies
+canonify
+Cassels
+cdr
+cerror
+charbuf
+chead
+circularities
+CLASSOF
+clos
+cls
+cmu
+coercions
+commentified
+commentify
+commitp
+cond
+const
+constantp
+constp
+consumedp
+continuable
+continuep
+CONV
+cplusplus
+ctype
+cv
Cygwin
-rst
-initarg's
-initargs
-kwtab
-asdf
-ASDF
-linearization
+dec
+decl
declarator
-ABIs
-args
-Haahr
-iostream
-atypecase
-KWSET
-dosequence
-PARSEFN
-initarg
+declarators
declp
-Habib
-constp
decls
-psetp
-decl
-plist
-fputs
-eof
-fil
-ichainsz
-initializer
-setf
-continuable
-ptrs
-env
-ptrdiff
-postop
-lmac
-notational
+defctype
defn
-eql
-vhv
-perl
-insts
-sym
-alignas
-Accessor
-accessor
-wchar
defs
-initsz
-nref
-optionp
-kwval
-cerror
-url
-initializers
-acyclic
-slong
-allocators
-gensym
-dæmon
-Mugnier
-aecase
-specializers
-IEC
-there'd
-enum
-numericp
-undef
-progn
-unix
-parsers
-parser's
-inher
-bool
-unary
-incf
-awhen
-vtmsgs
-XCHAIN
-unescaped
-rôles
-locf
-vtu
-dflt
-typedefs
-lprec
-unkhook
-floc
-specializer
-sint
-rôle
-seenp
-radix
-multip
-nreverse
-vtable
-equalp
-instsz
-accessors
-init
-resignalling
-acond
-ifdef
defun
-printf
-vtables
-varargsp
-CLOS
-clos
-chead
-KWCALL
-unkhookfn
-ish
-onwards
-ulong
-jmp
-canonfied
-iso
-fixnum
-commentify
-ap
-ar
-lex
+designator
+destructuring
+dflt
+dir
+dirs
disambiguated
-offsetof
-peekp
-charbuf
-eval
+docp
+donep
+dosequence
+ducournau
+dylan
+dæmon
+ecase
eg
-mLib
-oldunk
+endif
+enum
+enums
+env
+eof
+eq
+eql
+equalp
+errno
+etypecase
EuLisp
-const
-ichains
-cv
+eval
+expr
+extern
+externp
+externs
+fil
+fixme
+fixnum
+fixnums
+floc
+fp
+fputs
+frob
+func
gc
-kwfirst
-ichainu
+gensym
+gensyms
gf
-cplusplus
-eq
-initv
-monot
gh
-consumedp
-fp
-propertyp
-cond
-vmsgs
-coercions
-acase
-lparen
+goto
+Haahr
+Habib
+Huchard
hv
-dirs
-yacc
-defctype
-abstractp
-canonify
-endif
-CONV
+ichain
+ichains
+ichainsz
+ichainu
+IEC
+ifdef
+ifndef
+ilayout
+incf
+inher
+init
+initarg
+initarg's
+initargs
+initializer
+initializers
+initsz
+initv
+insts
+instsz
+invariance
+invariants
+iostream
isbn
-methty
-upcast
-subclassp
-Cassels
-extern
-barrett
+ish
+islots
+islotsz
+iso
+issn
+jmp
+kwargs
+KWCALL
+KWDECL
+kwfirst
+kwparse
+KWSET
+kwtab
+KWTAIL
+kwval
+lbuild
+lex
+linearization
+linearizations
linearize
-Shalit
-upcasts
-commentified
-oct
-signedness
-morep
-continuep
-Invariance
-invariance
-ifndef
-Huchard
-nitty
-locative
-externp
-tc
-gensyms
-msg
-designator
-anaphoric
-externs
-th
-ABI
-va
linearizes
+llong
+lmac
+locative
+locativep
+locatives
+locf
+lparen
+lprec
+lvalue
makev
-frob
-vh
-destructuring
-preop
-ACM
-ty
-schar
-scrutinee
-vt
malloc
-ilayout
-islotsz
-docp
-alice
-stmts
-rparen
-enums
-aif
-linearizations
-declarators
-etypecase
-ichain
+methty
+mLib
+monot
+morep
+msg
+Mugnier
+multip
+MyClass
nestedp
+nitty
+notational
+nref
+nreverse
+numericp
+oct
+offsetof
+oldunk
+onwards
+optionp
+paren
+PARSEFN
+parser's
+parsers
+peekp
+perl
+plist
+postop
+pre
prec
-aetypecase
+preop
+prin
+princ
+printf
+prog
+progn
+propertyp
+pset
+psetp
+ptr
+ptrdiff
+ptrs
+qualifiable
+radix
+resignalling
+ret
+rparen
+rprec
+rst
+rôle
+rôles
+schar
+scrutinee
+seenp
+setf
+Shalit
+SIG
+signedness
+sint
+sizeof
sllong
-kwargs
-KWARGS
-issn
-expr
-islots
-strcmp
-KWTAIL
+slong
spacep
-constantp
-fixnums
-pre
-ret
-atsign
+specializer
+specializers
sshort
-sizeof
-suppliedp
-commitp
+stmts
+strcmp
struct
-cdr
-api
-KWDECL
+structs
+subclassp
+suppliedp
+sym
+sys
+tc
+th
+there'd
+toset
+ty
+typedefs
+uchar
+uint
+uiop
ullong
-prin
-canonifies
-aor
-afterness
-locativep
-func
-arg
-invariants
-locatives
-ducournau
-pset
-dec
-binop
-ptr
-ansi
-donep
-circularities
-fixme
+ulong
+unary
+undef
+unescaped
+unix
+unkhook
+unkhookfn
+unspecialized
+upcast
+upcasts
+url
ushort
-princ
+va
+valist
+varargsp
+vh
+vhv
+vmsgs
+vt
+vtable
+vtables
+vtmsgs
+vtu
+wchar
+XCHAIN
+yacc
LISP_SOURCES =
SYSDEFS =
-ASDF_ENV = \
- CL_SOURCE_REGISTRY=$$(pwd): \
- ASDF_OUTPUT_TRANSLATIONS=$$(cd $(srcdir); pwd):$(abs_builddir):
-
###--------------------------------------------------------------------------
### The source files.
$(SUBST) $(srcdir)/sod.asd.in >$@.new $(SUBSTITUTIONS) && \
mv $@.new $@
-EXTRA_DIST += sod-frontend.asd.in
-CLEANFILES += sod-frontend.asd
-sod-frontend.asd: sod-frontend.asd.in Makefile
- $(SUBST) $(srcdir)/sod-frontend.asd.in >$@.new $(SUBSTITUTIONS) && \
- mv $@.new $@
-
## Building the executable image.
bin_PROGRAMS += sod
sod_SOURCES =
-sod$(EXEEXT): $(LISP_SOURCES) sod.asd sod-frontend.asd auto.lisp
- $(V_DUMP)$(ASDF_ENV) $(CL_LAUNCH) -o $@ -d ! -l $(LISPSYS) +I \
- -s sod-frontend -r sod-frontend:main
+sod$(EXEEXT): $(LISP_SOURCES) sod.asd auto.lisp
+ $(V_DUMP)$(ASDF_ENV) $(RUNLISP) -L$(WORKING_LISPS) \
+ -e "(asdf:clear-configuration)" \
+ -e "(asdf:operate 'asdf:program-op \"sod/frontend\")"
## The executable is needed if we're just distributing.
dist-hook: sod$(EXEEXT)
###--------------------------------------------------------------------------
### Unit testing.
-## The system definition.
-EXTRA_DIST += sod-test.asd.in
-
## Basic utilities.
EXTRA_DIST += test-base.lisp
EXTRA_DIST += codegen-test.lisp
EXTRA_DIST += lexer-test.lisp
-## The system definition.
-EXTRA_DIST += sod-test.asd.in
-CLEANFILES += sod-test.asd
-sod-test.asd: sod-test.asd.in Makefile
- $(SUBST) $(srcdir)/sod-test.asd.in >$@.new $(SUBSTITUTIONS) && \
- mv $@.new $@
-
## Running the Lisp tests.
-check-local: sod sod-test.asd
- $(V_TEST)$(ASDF_ENV) $(CL_LAUNCH) -l $(LISPSYS) \
- -s sod-frontend +I \
- -i '(handler-case ;\
- (progn ;\
- (asdf:load-system "sod-test") ;\
- (asdf:test-system "sod")) ;\
- (error (cond) ;\
- (format *error-output* "ERR: ~A~%" cond) ;\
- (optparse:exit 1)))'
+check-local: sod sod.asd
+ $(V_TEST)$(ASDF_ENV) $(RUNLISP) -L$(WORKING_LISPS) -e \
+ '(asdf:clear-configuration) ;\
+ (handler-case (asdf:test-system "sod") ;\
+ (error (cond) ;\
+ (format *error-output* "ERR: ~A~%" cond) ;\
+ (uiop:quit 1)))'
###--------------------------------------------------------------------------
### Manual pages.
done; \
dots=$$(echo $$fwd | sed 's/[^ ][^ ]*/../g'); \
rel=$$(echo $$dots $$twd | tr " " "/"); \
- for i in sod.asd sod-frontend.asd; do \
+ for i in sod.asd; do \
echo >&2 "CREATE $$to/$$i"; \
sed -e '/#|@-auto-@|#/ { r auto.lisp' -e ' d; }' \
+ -e '/#|@-del-@|#/ d' \
-e '/#|@-path-@|#/ d' \
$(srcdir)/$$i.in >$(DESTDIR)$(pkglispsrcdir)/$$i.new; \
mv $(DESTDIR)$(pkglispsrcdir)/$$i.new \
(declaim (optimize debug))
(asdf:initialize-source-registry
- `(:source-registry (:directory ,*load-pathname*)
+ `(:source-registry (:directory ,*load-truename*)
:inherit-configuration))
list))
(definst suppliedp-struct (stream) (flags var)
+ "Declare a `suppliedp' structure VAR containing a bit for each named FLAG.
+
+ The output looks like this:
+
+ struct {
+ unsigned FLAG: 1;
+ /* ... */
+ } VAR;
+
+ Note that this will not be valid C unless there is at least one flag."
(format stream
"~@<struct { ~2I~_~{unsigned ~A: 1;~^ ~_~} ~I~_} ~A;~:>"
flags var))
(setf (gethash ,name *simple-type-map*) ,(car types)))
(defctype ,names ,(car types) :export ,export)
(define-c-type-syntax ,(car names) (&rest quals)
+ ,(format nil "Return a possibly-qualified `~A' type." (car types))
`(make-simple-type ,',(car types) (list ,@quals)))))))
(export 'find-simple-c-type)
"Expands to code to construct a C type, using `expand-c-type-spec'."
(expand-c-type-spec spec))
+(defmethod documentation ((symbol symbol) (doc-type (eql 'c-type)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-spec 0 symbol)))
+ (and method (documentation method t))))
+(defmethod (setf documentation)
+ (string (symbol symbol) (doc-type (eql 'c-type)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-spec 0 symbol)))
+ (unless method (error "No C type spec found with name `~S'." symbol))
+ (setf (documentation method t) string)))
+
(export 'define-c-type-syntax)
(defmacro define-c-type-syntax (name bvl &body body)
"Define a C-type syntax function.
(block ,name ,@body)))
',name))))
+(export 'c-type-form)
+(defmethod documentation ((symbol symbol) (doc-type (eql 'c-type-form)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-form 0 symbol)))
+ (and method (documentation method t))))
+(defmethod (setf documentation)
+ (string (symbol symbol) (doc-type (eql 'c-type-form)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-form 0 symbol)))
+ (unless method (error "No C type spec found with name `~S'." symbol))
+ (setf (documentation method t) string)))
+
(export 'c-type-alias)
(defmacro c-type-alias (original &rest aliases)
"Make ALIASES behave the same way as the ORIGINAL type."
,@(mapcar (lambda (alias)
`(defmethod expand-c-type-form
((,head (eql ',alias)) ,tail)
+ ,(format nil "Alias for `~(~S~)'." original)
(expand-c-type-form ',original ,tail)))
aliases)
',aliases)))
The VALUE is a C type S-expression, acceptable to `expand-c-type-spec'.
It will be expanded once at run-time."
(let* ((names (if (listp names) names (list names)))
- (namevar (gensym "NAME"))
+ (namevar (gensym "NAME-"))
+ (avar (gensym "A"))
+ (tvar (gensym "T"))
+ (svar (gensym "S"))
(typevar (symbolicate 'c-type- (car names))))
`(progn
,@(and export
`(defmethod expand-c-type-spec ((,namevar (eql ',name)))
',typevar))
names))
+ (dolist (,avar '(,@names))
+ (let ((,tvar (format nil "Return a C `~A' type."
+ (with-output-to-string (,svar)
+ (pprint-c-type ,typevar ,svar nil)))))
+ (setf (documentation ,avar 'c-type) ,tvar)))
'names)))
(export 'c-name-case)
(constructor-name (symbolicate 'make- code '-inst))
(keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
public)))
-
- ;; We have many jobs to do in the expansion.
- `(progn
-
- ;; A class to hold the data.
- (defclass ,class-name (inst)
- ,(mapcar (lambda (public-slot private-slot key)
- `(,private-slot :initarg ,key
- :reader ,(symbolicate 'inst- public-slot)))
- public private keys))
-
- ;; A constructor to make an instance of the class.
- (defun ,constructor-name (,@bvl)
- (make-instance ',class-name ,@(mappend #'list keys public)))
-
- ;; A method on `inst-metric', to feed into inlining heuristics.
- (defmethod inst-metric ((,inst-var ,class-name))
- (with-slots (,@private) ,inst-var
- (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot)) private))))
-
- ;; A method to actually produce the necessary output.
- (defmethod print-object ((,inst-var ,class-name) ,streamvar)
- (with-slots ,(mapcar #'list public private) ,inst-var
- (if *print-escape*
- (print-unreadable-object (,inst-var ,streamvar :type t)
- (format ,streamvar "~@<~@{~S ~@_~S~^ ~_~}~:>"
- ,@(mappend #'list keys public)))
- (block ,code ,@body))))
-
- ;; Maybe export all of this stuff.
- ,@(and export `((export '(,class-name ,constructor-name
- ,@(mapcar (lambda (slot)
- (symbolicate 'inst- slot))
- public)))))
-
- ;; And try not to spam a REPL.
- ',code))))
+ (multiple-value-bind (docs decls body) (parse-body body)
+
+ ;; We have many jobs to do in the expansion.
+ `(progn
+
+ ;; A class to hold the data.
+ (defclass ,class-name (inst)
+ ,(mapcar (lambda (public-slot private-slot key)
+ `(,private-slot :initarg ,key
+ :reader
+ ,(symbolicate 'inst- public-slot)))
+ public private keys))
+
+ ;; A constructor to make an instance of the class.
+ (defun ,constructor-name (,@bvl)
+ (make-instance ',class-name ,@(mappend #'list keys public)))
+
+ ;; A method on `inst-metric', to feed into inlining heuristics.
+ (defmethod inst-metric ((,inst-var ,class-name))
+ (with-slots (,@private) ,inst-var
+ (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot))
+ private))))
+
+ ;; A method to actually produce the necessary output.
+ (defmethod print-object ((,inst-var ,class-name) ,streamvar)
+ (with-slots ,(mapcar #'list public private) ,inst-var
+ (if *print-escape*
+ (print-unreadable-object (,inst-var ,streamvar :type t)
+ (format ,streamvar "~@<~@{~S ~@_~S~^ ~_~}~:>"
+ ,@(mappend #'list keys public)))
+ (block ,code
+ ,@(if (null decls) body
+ `((locally ,@decls ,@body)))))))
+
+ ;; Maybe export all of this stuff.
+ ,@(and export `((export '(,class-name ,constructor-name
+ ,@(mapcar (lambda (slot)
+ (symbolicate 'inst- slot))
+ public)))))
+
+ ;; Remember the documentation.
+ ,@(and docs `((setf (get ',class-name 'inst-documentation)
+ ,@docs)))
+
+ ;; And try not to spam a REPL.
+ ',code)))))
+
+(defmethod documentation ((symbol symbol) (doc-type (eql 'inst)))
+ (get symbol 'inst-documentation))
+(defmethod (setf documentation) (doc (symbol symbol) (doc-type (eql 'inst)))
+ (setf (get symbol 'inst-documentation) doc))
;; Formatting utilities.
(export 'format-banner-comment)
(defun format-banner-comment (stream control &rest args)
+ "Format a comment, built from a `format' CONTROL string and ARGS.
+
+ The comment is wrapped in the usual `/* ... */' C comment delimiters, and
+ word-wrapped if necessary. If multiple lines are needed, then a column of
+ `*'s is left down the left hand side, and the final `*/' ends up properly
+ aligned on a line by itself."
(format stream "~@</~@<* ~@;~?~:>~_ */~:>" control args))
;; Important instruction classes.
(definst var (stream :export t) (name %type &optional init)
+ "Declare a variable: TYPE NAME [= INIT].
+
+ This usually belongs in the DECLS of a `block'."
(pprint-logical-block (stream nil)
(pprint-c-type type stream name)
(when init
(definst function (stream :export t)
(name %type body &optional %banner &rest banner-args)
+ "Define a function.
+
+ The TYPE must be a function type. The BANNER and BANNER-ARGS are a
+ `format' control string and its argument list. Output looks like:
+
+ /* BANNER */
+ TYPE NAME(ARGS-FROM-TYPE)
+ {
+ BODY
+ }"
(pprint-logical-block (stream nil)
(when banner
(apply #'format-banner-comment stream banner banner-args)
;; Expression statements.
(definst expr (stream :export t) (%expr)
+ "An expression statement: EXPR;"
(format stream "~A;" expr))
(definst set (stream :export t) (var %expr)
+ "An assignment statement: VAR = EXPR;"
(format stream "~@<~A = ~2I~_~A;~:>" var expr))
(definst update (stream :export t) (var op %expr)
+ "An update statement: VAR OP= EXPR;"
(format stream "~@<~A ~A= ~2I~_~A;~:>" var op expr))
;; Special kinds of expressions.
(definst call (stream :export t) (%func &rest args)
+ "A function-call expression: FUNC(ARGS)"
(format stream "~@<~A~4I~_(~@<~{~A~^, ~_~}~:>)~:>" func args))
(definst cond (stream :export t) (%cond conseq alt)
+ "A conditional expression: COND ? CONSEQ : ALT"
(format stream "~@<~A ~2I~@_~@<? ~A ~_: ~A~:>~:>" cond conseq alt))
;; Simple statements.
(definst return (stream :export t) (%expr)
+ "A `return' statement: return [(EXPR)];"
(format stream "return~@[ (~A)~];" expr))
(definst break (stream :export t) ()
+ "A `break' statement: break;"
(format stream "break;"))
(definst continue (stream :export t) ()
+ "A `continue' statement: continue;"
(format stream "continue;"))
;; Compound statements.
they get the formatting right between them.")
(definst banner (stream :export t) (control &rest args)
+ "A banner comment, built from a `format' CONTROL string and ARGS.
+
+ See `format-banner-comment' for more details."
(pprint-logical-block (stream nil)
(unless *first-statement-p* (pprint-newline :mandatory stream))
(apply #'format-banner-comment stream control args)))
(export 'emit-banner)
(defun emit-banner (codegen control &rest args)
+ "Emit a `banner-inst' to CODEGEN, with the given CONTROL and ARGS."
(emit-inst codegen (apply #'make-banner-inst control args)))
(definst block (stream :export t) (decls body)
+ "A compound statement.
+
+ The output looks like
+
+ {
+ DECLS
+
+ BODY
+ }
+
+ If controlled by `if', `while', etc., then the leading brace ends up on
+ the same line, following K&R conventions."
(write-char #\{ stream)
(pprint-newline :mandatory stream)
(pprint-logical-block (stream nil)
(write-char #\} stream))
(definst if (stream :export t) (%cond conseq &optional alt)
+ "An `if' statement: if (COND) CONSEQ [else ALT]"
(let ((stmt "if"))
(loop (format-compound-statement (stream conseq (if alt t nil))
(format stream "~A (~A)" stmt cond))
(return))))))
(definst while (stream :export t) (%cond body)
+ "A `while' statement: while (COND) BODY"
(format-compound-statement (stream body)
(format stream "while (~A)" cond)))
(definst do-while (stream :export t) (body %cond)
+ "A `do'/`while' statement: do BODY while (COND);"
(format-compound-statement (stream body :space)
(write-string "do" stream))
(format stream "while (~A);" cond))
(definst for (stream :export t) (init %cond update body)
+ "A `for' statement: for (INIT; COND; UPDATE) BODY"
(format-compound-statement (stream body)
(format stream "for (~@<~@[~A~];~@[ ~_~A~];~@[ ~_~A~]~:>)"
init cond update)))
(cl:in-package #:sod-frontend)
;;;--------------------------------------------------------------------------
-;;; Preparation for dumping.
-
-(clear-the-decks)
-(exercise)
-
-;;;--------------------------------------------------------------------------
;;; The main program.
(defvar-unbound *option-parser*
~[~:; ~:*~D error~:P~[~:; and~]~:*~]~
~[~:; ~:*~D warning~:P~]~%"
*program-name* nerror nwarn))
- (exit (if (plusp nerror) 2 0)))))))
+ (uiop:quit (if (plusp nerror) 2 0)))))))
;;;----- That's all, folks --------------------------------------------------
(definst convert-to-ilayout (stream :export t)
(%class chain-head %expr)
+ "Expression to convert EXPR to point to its enclosing `ilayout'.
+
+ Given a pointer EXPR which points into a direct instance of CLASS,
+ specifically to the `ichain' whose head class is CHAIN-HEAD, evaluate the
+ base address of the enclosing `ilayout' structure.
+
+ The output looks like:
+
+ SOD_ILAYOUT(CLASS, NICK, EXPR)"
(format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"
class (sod-class-nickname chain-head) expr))
;;;--------------------------------------------------------------------------
;;; Program environment things.
-(export 'exit)
-(locally (declare #+sbcl (sb-ext:muffle-conditions style-warning
- sb-ext:compiler-note))
- (defun exit (&optional (code 0) &key abrupt)
- "End program, returning CODE to the caller."
- (declare (type (unsigned-byte 32) code)
- )
- #.(car '(#+sbcl (sb-ext:exit :code code :abort abrupt)
- #+cmu (if abrupt
- (unix::void-syscall ("_exit" c-call:int) code)
- (ext:quit code))
- #+clisp (funcall (if abrupt #'ext:quit #'ext:exit) code)
- #+ecl (ext:quit code)
- (unless (zerop code)
- (format *error-output*
- "~&Exiting unsuccessfully with code ~D.~%" code))))
- (abort)))
-
(export '(*program-name* *command-line*))
(defvar *program-name* "<unknown>"
"Program name, as retrieved from the command line.")
"Retrieve command-line arguments.
Set `*command-line*' and `*program-name*'."
-
- (setf *command-line*
- (let ((uiop-package (find-package :uiop))
- (cll-package (find-package :cl-launch)))
- (cons (or (and uiop-package
- (funcall (intern "ARGV0" uiop-package)))
- (and cll-package
- (some (intern "GETENV" cll-package)
- (list "__CL_ARGV0" "CL_LAUNCH_FILE")))
- #+sbcl (car sb-ext:*posix-argv*)
- #+cmu (car ext:*command-line-strings*)
- #+clisp (aref (ext:argv) 0)
- #+ecl (ext:argv 0)
- "sod")
- (cond (uiop-package
- (funcall (intern "COMMAND-LINE-ARGUMENTS"
- uiop-package)))
- (cll-package
- (symbol-value (intern "*ARGUMENTS*" cll-package)))
- (t #.(or (car '(#+sbcl (cdr sb-ext:*posix-argv*)
- #+cmu (cdr ext:*command-line-strings*)
- #+clisp (coerce (subseq (ext:argv) 8)
- 'list)
- #+ecl (loop for i from 1
- below (ext:argc)
- collect (ext:argv i))))
- (error "Unsupported Lisp"))))))
-
+ (setf *command-line* (cons (uiop:argv0) uiop:*command-line-arguments*)
*program-name* (pathname-name (car *command-line*))))
;;;--------------------------------------------------------------------------
(defun die (&rest args)
"Report an error message and exit."
(apply #'moan args)
- (exit 1))
+ (uiop:quit 1))
;;;--------------------------------------------------------------------------
;;; The main option parser.
(lambda (o s k)
(declare (ignore k))
(print-unreadable-object (o s :type t)
- (format s "~@[-~C, ~]~@[--~A~]~
- ~*~@[~2:*~:[=~A~;[=~A]~]~]~
- ~@[ ~S~]"
+ (format s "~*~:[~2:*~:[~3*~@[~S~]~
+ ~;~
+ ~:*-~C~
+ ~2*~@[~:*~:[ ~A~;[~A]~]~]~
+ ~@[ ~S~]~]~
+ ~;~
+ ~2:*~@[-~C, ~]--~A~
+ ~*~@[~:*~:[=~A~;[=~A]~]~]~
+ ~@[ ~S~]~]"
(opt-short-name o)
(opt-long-name o)
(opt-arg-optional-p o)
(let ((func (intern (format nil "OPTHANDLER/~:@(~A~)" name))))
(multiple-value-bind (docs decls body) (parse-body body)
`(progn
- (setf (get ',name 'opthandler) ',func)
+ (setf (get ',name 'opthandler-function) ',func)
(defun ,func (,var ,arg ,@args)
,@docs ,@decls
(declare (ignorable ,arg))
(block ,name ,@body)))
',name))))
+(export 'opthandler)
+(defmethod documentation ((symbol symbol) (doc-type (eql 'opthandler)))
+ (let ((func (get symbol 'opthandler-function)))
+ (and func (documentation func 'function))))
+(defmethod (setf documentation)
+ (string (symbol symbol) (doc-type (eql 'opthandler)))
+ (let ((func (get symbol 'optmacro-function)))
+ (unless func (error "No option handler defined with name `~S'." symbol))
+ (setf (documentation func 'function) string)))
+
(defun parse-c-integer (string &key radix (start 0) end)
"Parse (a substring of) STRING according to the standard C rules.
(export 'invoke-option-handler)
(defun invoke-option-handler (handler loc arg args)
- "Call HANDLER, giving it LOC to update, the option-argument ARG, and the
- remaining ARGS."
+ "Call an option HANDLER.
+
+ The handler is invoked to update the locative LOC, given an
+ option-argument ARG, and the remaining ARGS."
(apply (if (functionp handler) handler
- (fdefinition (get handler 'opthandler)))
+ (fdefinition (get handler 'opthandler-function)))
loc arg args))
;;;--------------------------------------------------------------------------
(export 'set)
(defopthandler set (var) (&optional (value t))
- "Sets VAR to VALUE; defaults to t."
+ "Sets VAR to VALUE; defaults to `t'."
(setf var value))
(export 'clear)
(defopthandler clear (var) (&optional (value nil))
- "Sets VAR to VALUE; defaults to nil."
+ "Sets VAR to VALUE; defaults to `'nil'."
(setf var value))
(export 'inc)
(defopthandler inc (var) (&optional max (step 1))
- "Increments VAR by STEP (defaults to 1), but not greater than MAX (default
- nil for no maximum). No errors are signalled."
+ "Increments VAR by STEP (defaults to 1).
+
+ If MAX is not nil then VAR will not be made larger than MAX. No errors
+ are signalled."
(incf var step)
(when (and max (>= var max))
(setf var max)))
(export 'dec)
(defopthandler dec (var) (&optional min (step 1))
- "Decrements VAR by STEP (defaults to 1), but not less than MIN (default nil
- for no maximum). No errors are signalled."
+ "Decrements VAR by STEP (defaults to 1).
+
+ If MIN is not nil, then VAR will not be made smaller than MIN. No errors
+ are signalled."
(decf var step)
(when (and min (<= var min))
(setf var min)))
structure each."
(multiple-value-bind (docs decls body) (parse-body body)
`(progn
- (setf (get ',name 'optmacro) (lambda ,args
- ,@docs ,@decls
- (block ,name ,@body)))
+ (setf (get ',name 'optmacro-function)
+ (lambda ,args
+ ,@docs ,@decls
+ (block ,name ,@body)))
',name)))
+(export 'optmacro)
+(defmethod documentation ((symbol symbol) (doc-type (eql 'optmacro)))
+ (let ((func (get symbol 'optmacro-function)))
+ (and func (documentation func t))))
+(defmethod (setf documentation)
+ (string (symbol symbol) (doc-type (eql 'optmacro)))
+ (let ((func (get symbol 'optmacro-function)))
+ (unless func (error "No option macro defined with name `~S'." symbol))
+ (setf (documentation func t) string)))
+
(export 'parse-option-form)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun parse-option-form (form)
(:opt-arg (setf arg-name (cadr f))
(setf arg-optional-p t))
(:doc (setf doc (doc (cdr f))))
- (t (let ((handler (get (car f) 'opthandler)))
+ (t (let ((handler (get (car f)
+ 'opthandler-function)))
(unless handler
(error "No handler `~S' defined." (car f)))
(let* ((var (cadr f))
((and (consp form) (symbolp (car form)))
(values (car form) (cdr form)))
(t (values nil nil)))
- (let ((macro (and sym (get sym 'optmacro))))
+ (let ((macro (and sym (get sym 'optmacro-function))))
(if macro
(apply macro args)
(list (parse-option-form form))))))
(defun print-text (string
&optional (stream *standard-output*)
&key (start 0) (end nil))
- "Prints STRING to a pretty-printed STREAM, breaking it at whitespace and
- newlines in the obvious way. Stuff between square brackets is not broken:
- this makes usage messages work better."
+ "Prints and line-breaks STRING to a pretty-printed STREAM.
+
+ The string is broken at whitespace and newlines in the obvious way.
+ Stuff between square brackets is not broken: this makes usage messages
+ work better."
(let ((i start)
(nest 0)
(splitp nil))
(export 'simple-usage)
(defun simple-usage (opts &optional mandatory-args)
- "Build a simple usage list from a list of options, and (optionally)
- mandatory argument names."
+ "Build a simple usage list.
+
+ The usage list is constructed from a list OPTS of `option' values, and
+ a list MANDATORY-ARGS of mandatory argument names; the latter defaults to
+ nil if omitted."
(let (short-simple long-simple short-arg long-arg)
(dolist (o opts)
(cond ((not (and (opt-documentation o)
(export 'sanity-check-option-list)
(defun sanity-check-option-list (opts)
- "Check the option list OPTS for basic sanity. Reused short and long option
- names are diagnosed. Maybe other problems will be reported later.
- Returns a list of warning strings."
+ "Check the option list OPTS for basic sanity.
+
+ Reused short and long option names are diagnosed. Maybe other problems
+ will be reported later. Returns a list of warning strings."
(let ((problems nil)
(longs (make-hash-table :test #'equal))
(shorts (make-hash-table)))
(export 'die-usage)
(defun die-usage ()
(do-usage *error-output*)
- (exit 1))
+ (uiop:quit 1))
(defun opt-help (arg)
(declare (ignore arg))
(null nil)
((or function symbol) (terpri) (funcall *help*)))
(format t "~&")
- (exit 0))
+ (uiop:quit 0))
(defun opt-version (arg)
(declare (ignore arg))
(format t "~A, version ~A~%" *program-name* *version*)
- (exit 0))
+ (uiop:quit 0))
(defun opt-usage (arg)
(declare (ignore arg))
(do-usage)
- (exit 0))
+ (uiop:quit 0))
(export 'help-options)
(defoptmacro help-options (&key (short-help #\h)
(cl:in-package #:sod-frontend-sysdef)
-#|@-auto-@|# (load (merge-pathnames "auto.lisp" *load-pathname*))
+#|@-auto-@|# (load (make-pathname :name "AUTO" :type "LISP" :version :newest
+ :case :common :defaults *load-pathname*))
;;;--------------------------------------------------------------------------
;;; Definition.
-(defsystem sod-frontend
- ;; Boring copyright stuff.
- :version #.*sysdef-version*
- :author "Mark Wooding"
- :license "GNU General Public License, version 2 or later"
- #|@-path-@|# :pathname "@srcdir@"
-
- ;; Documentation.
- :description "A Sensible Object Design for C, command-line frontend."
-
- :long-description
- "The Sensible Object Design (SOD) is a fairly simple, yet powerful object
- system for plain old C.
-
- This system provides a command-line interface to the SOD translator. It's
- a separate system because it has additional dependencies and
- Lisp-system-specific code."
-
- :depends-on ("cl-launch" "sod")
-
- :components
- ((:file "frontend")))
;;;----- That's all, folks --------------------------------------------------
(cl:in-package #:sod-test-sysdef)
-#|@-auto-@|# (load (merge-pathnames "auto.lisp" *load-pathname*))
+#|@-auto-@|# (load (make-pathname :name "AUTO" :type "LISP" :version :newest
+ :case :common :defaults *load-pathname*))
;;;--------------------------------------------------------------------------
;;; Definition.
-(defsystem sod-test
- ;; Boring copyright stuff.
- :version #.*sysdef-version*
- :author "Mark Wooding"
- :license "GNU General Public License, version 2 or later"
- #|@-path-@|# :pathname "@srcdir@"
-
- ;; Documentation.
- :description "Tests for the Sensible Object Design translator."
-
- :long-description
- "This system provides unit tests for the Sod translator."
-
- :depends-on ("sod" "xlunit")
-
- :components
- ((:file "test-base")
-
- ;; Test the parser edifice.
- (:module "parser" :depends-on ("test-base") :components
- ((:file "parser-test")
- (:file "scanner-charbuf-test")))
-
- ;; The actual tests.
- (:file "c-types-test" :depends-on ("test-base"))
- (:file "codegen-test" :depends-on ("test-base"))
- (:file "lexer-test" :depends-on ("test-base"))))
;;;--------------------------------------------------------------------------
;;; Testing.
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(cl:defpackage #:sod-sysdef
- (:use #:common-lisp #:asdf)
+ (:use #:common-lisp #:asdf #:uiop)
(:export #:*version*))
(cl:in-package #:sod-sysdef)
#|@-auto-@|# (load (make-pathname :name "AUTO" :type "LISP" :version :newest
- :case :common :defaults *load-pathname*))
+#|@-del-@|# :case :common :defaults *load-pathname*))
#+cmu (require :gray-streams)
statically predicting which superclass's method to delegate to.
Multiple inheritance makes this approach (taken by C++) fail: the
right next method might be an unknown sibling, and two siblings might
- be in either order depending on descendents.
+ be in either order depending on descendants.
* Minimal runtime support requirements, so that it's suitable for use
wherever C is -- e.g., interfacing to other languages."
+ :depends-on ("uiop")
+ :in-order-to ((test-op (load-op "sod/test")))
+ :perform (test-op (op comp)
+ (let ((result (symbol-call :sod-test :run-tests)))
+ (unless (symbol-call :xlunit :was-successful result)
+ (error "Failed test"))))
+
:components
- ((:file "utilities")
- (:file "optparse")
-
- ;; Parser equipment. This is way more elaborate than it needs to be, but
- ;; it was interesting, and it may well get split off into a separate
- ;; library.
- (:module "parser" :depends-on ("utilities") :components
- ((:file "package")
-
- ;; File location protocol (including error reporting).
- (:file "floc-proto" :depends-on ("package"))
- (:file "floc-impl" :depends-on ("floc-proto"))
-
- ;; Position-aware streams.
- (:file "streams-proto" :depends-on ("package"))
- (:file "streams-impl" :depends-on ("streams-proto" "floc-proto"))
-
- ;; Scanner protocol, and various scanner implementations.
- (:file "scanner-proto" :depends-on ("package"))
- (:file "scanner-impl" :depends-on ("scanner-proto"))
- (:file "scanner-charbuf-impl" :depends-on
- ("scanner-proto" "floc-proto" "streams-proto"))
- (:file "scanner-token-impl" :depends-on ("scanner-proto"))
-
- ;; Parser notation macro support.
- (:file "parser-proto" :depends-on ("package"))
- (:file "parser-impl" :depends-on ("parser-proto"))
-
- ;; Expression parser support.
- (:file "parser-expr-proto" :depends-on ("parser-proto"))
- (:file "parser-expr-impl" :depends-on ("parser-expr-proto"))
-
- ;; Stitching parsers to scanners.
- (:file "scanner-context-impl" :depends-on
- ("parser-proto" "scanner-proto"))))
-
- (:file "package" :depends-on ("utilities" "parser"))
-
- ;; Lexical analysis.
- (:file "lexer-proto" :depends-on ("package" "parser"))
- (:file "lexer-impl" :depends-on ("lexer-proto"))
- (:file "fragment-parse" :depends-on ("lexer-proto"))
-
- ;; C type representation protocol.
- (:file "c-types-proto" :depends-on ("package"))
- (:file "c-types-impl" :depends-on ("c-types-proto" "codegen-proto"))
- (:file "c-types-parse" :depends-on
- ("c-types-proto" "c-types-class-impl" "fragment-parse"))
-
- ;; Property set protocol.
- (:file "pset-proto" :depends-on ("package" "c-types-proto"))
- (:file "pset-impl" :depends-on ("pset-proto" "module-proto"))
- (:file "pset-parse" :depends-on ("pset-proto" "lexer-proto"))
-
- ;; Code generation protocol.
- (:file "codegen-proto" :depends-on ("module-proto"))
- (:file "codegen-impl" :depends-on ("codegen-proto"))
-
- ;; Modules.
- (:file "module-proto" :depends-on ("pset-proto" "package"))
- (:file "module-impl" :depends-on
- ("module-proto" "pset-proto" "c-types-class-impl" "builtin"))
- (:file "builtin" :depends-on
- ("module-proto" "pset-proto" "c-types-impl" "c-types-class-impl"
- "classes" "class-layout-proto" "method-proto"))
- (:file "module-parse" :depends-on
- ("class-make-proto" "class-finalize-proto"
- "fragment-parse" "lexer-proto" "module-impl"))
- (:file "module-output" :depends-on ("module-impl" "output-proto"))
-
- ;; Output.
- (:file "output-proto" :depends-on ("package"))
- (:file "output-impl" :depends-on ("output-proto"))
-
- ;; Class representation.
- (:file "classes" :depends-on ("package" "c-types-proto"))
- (:file "c-types-class-impl" :depends-on ("classes" "module-proto"))
- (:file "class-utilities" :depends-on
- ("classes" "codegen-impl" "pset-impl"
- "c-types-impl" "c-types-class-impl"))
-
- ;; Class construction.
- (:file "class-make-proto" :depends-on ("class-utilities"))
- (:file "class-make-impl" :depends-on ("class-make-proto"))
-
- ;; Class layout.
- (:file "class-layout-proto" :depends-on ("class-utilities"))
- (:file "class-layout-impl" :depends-on
- ("class-layout-proto" "method-proto"))
-
- ;; Class finalization.
- (:file "class-finalize-proto" :depends-on ("class-utilities"))
- (:file "class-finalize-impl" :depends-on ("class-finalize-proto"))
-
- ;; Method generation.
- (:file "method-proto" :depends-on ("class-make-proto"))
- (:file "method-impl" :depends-on ("method-proto"))
- (:file "method-aggregate" :depends-on ("method-impl"))
-
- ;; Class output.
- (:file "class-output" :depends-on
- ("classes" "class-layout-impl" "method-impl" "output-proto"))
-
- ;; Finishing touches of various kinds.
- (:file "final" :depends-on ("builtin" "module-output" "class-output"))))
+ ((:file "utilities")
+ (:file "optparse")
+
+ ;; Parser equipment. This is way more elaborate than it needs to be,
+ ;; but it was interesting, and it may well get split off into a separate
+ ;; library.
+ (:module "parser"
+ :depends-on ("utilities")
+ :components
+ ((:file "package")
+
+ ;; File location protocol (including error reporting).
+ (:file "floc-proto" :depends-on ("package"))
+ (:file "floc-impl" :depends-on ("floc-proto"))
+
+ ;; Position-aware streams.
+ (:file "streams-proto" :depends-on ("package"))
+ (:file "streams-impl"
+ :depends-on ("streams-proto" "floc-proto"))
+
+ ;; Scanner protocol, and various scanner implementations.
+ (:file "scanner-proto" :depends-on ("package"))
+ (:file "scanner-impl" :depends-on ("scanner-proto"))
+ (:file "scanner-charbuf-impl"
+ :depends-on
+ ("scanner-proto" "floc-proto" "streams-proto"))
+ (:file "scanner-token-impl" :depends-on ("scanner-proto"))
+
+ ;; Parser notation macro support.
+ (:file "parser-proto" :depends-on ("package"))
+ (:file "parser-impl" :depends-on ("parser-proto"))
+
+ ;; Expression parser support.
+ (:file "parser-expr-proto" :depends-on ("parser-proto"))
+ (:file "parser-expr-impl" :depends-on ("parser-expr-proto"))
+
+ ;; Stitching parsers to scanners.
+ (:file "scanner-context-impl"
+ :depends-on ("parser-proto" "scanner-proto"))))
+
+ (:file "package" :depends-on ("utilities" "parser"))
+
+ ;; Lexical analysis.
+ (:file "lexer-proto" :depends-on ("package" "parser"))
+ (:file "lexer-impl" :depends-on ("lexer-proto"))
+ (:file "fragment-parse" :depends-on ("lexer-proto"))
+
+ ;; C type representation protocol.
+ (:file "c-types-proto" :depends-on ("package"))
+ (:file "c-types-impl" :depends-on ("c-types-proto" "codegen-proto"))
+ (:file "c-types-parse"
+ :depends-on
+ ("c-types-proto" "c-types-class-impl" "fragment-parse"))
+
+ ;; Property set protocol.
+ (:file "pset-proto" :depends-on ("package" "c-types-proto"))
+ (:file "pset-impl" :depends-on ("pset-proto" "module-proto"))
+ (:file "pset-parse" :depends-on ("pset-proto" "lexer-proto"))
+
+ ;; Code generation protocol.
+ (:file "codegen-proto" :depends-on ("module-proto"))
+ (:file "codegen-impl" :depends-on ("codegen-proto"))
+
+ ;; Modules.
+ (:file "module-proto" :depends-on ("pset-proto" "package"))
+ (:file "module-impl"
+ :depends-on
+ ("module-proto" "pset-proto" "c-types-class-impl" "builtin"))
+ (:file "builtin"
+ :depends-on
+ ("module-proto" "pset-proto"
+ "c-types-impl" "c-types-class-impl"
+ "classes" "class-layout-proto" "method-proto"))
+ (:file "module-parse"
+ :depends-on
+ ("class-make-proto" "class-finalize-proto"
+ "fragment-parse" "lexer-proto" "module-impl"))
+ (:file "module-output" :depends-on ("module-impl" "output-proto"))
+
+ ;; Output.
+ (:file "output-proto" :depends-on ("package"))
+ (:file "output-impl" :depends-on ("output-proto"))
+
+ ;; Class representation.
+ (:file "classes" :depends-on ("package" "c-types-proto"))
+ (:file "c-types-class-impl" :depends-on ("classes" "module-proto"))
+ (:file "class-utilities"
+ :depends-on
+ ("classes" "codegen-impl" "pset-impl"
+ "c-types-impl" "c-types-class-impl"))
+
+ ;; Class construction.
+ (:file "class-make-proto" :depends-on ("class-utilities"))
+ (:file "class-make-impl" :depends-on ("class-make-proto"))
+
+ ;; Class layout.
+ (:file "class-layout-proto" :depends-on ("class-utilities"))
+ (:file "class-layout-impl"
+ :depends-on ("class-layout-proto" "method-proto"))
+
+ ;; Class finalization.
+ (:file "class-finalize-proto" :depends-on ("class-utilities"))
+ (:file "class-finalize-impl" :depends-on ("class-finalize-proto"))
+
+ ;; Method generation.
+ (:file "method-proto" :depends-on ("class-make-proto"))
+ (:file "method-impl" :depends-on ("method-proto"))
+ (:file "method-aggregate" :depends-on ("method-impl"))
+
+ ;; Class output.
+ (:file "class-output"
+ :depends-on
+ ("classes" "class-layout-impl" "method-impl" "output-proto"))
+
+ ;; Finishing touches of various kinds.
+ (:file "final" :depends-on ("builtin" "module-output" "class-output"))))
+
+(defsystem sod/frontend
+
+ ;; Boring copyright stuff.
+ :version #.*sysdef-version*
+ :author "Mark Wooding"
+ :license "GNU General Public License, version 2 or later"
+ #|@-path-@|# :pathname "@srcdir@"
+
+ ;; Documentation.
+ :description "A Sensible Object Design for C, command-line frontend."
+
+ :long-description
+ "The Sensible Object Design (SOD) is a fairly simple, yet powerful object
+ system for plain old C.
+
+ This system provides a command-line interface to the SOD translator. It's
+ a separate system because it has additional dependencies and
+ Lisp-system-specific code."
+
+ :entry-point "sod-frontend:main"
+ :build-pathname "sod"
+ :depends-on ("uiop" "sod")
+ :components ((:file "frontend")))
;;;--------------------------------------------------------------------------
;;; Testing.
-(defmethod perform ((op test-op) (component (eql (find-system "sod"))))
- (declare (ignore op component))
- (handler-bind (((or warning style-warning) #'muffle-warning))
- (operate 'test-op "sod-test")))
+(defsystem sod/test
+
+ ;; Boring copyright stuff.
+ :version #.*sysdef-version*
+ :author "Mark Wooding"
+ :license "GNU General Public License, version 2 or later"
+ #|@-path-@|# :pathname "@srcdir@"
+
+ ;; Documentation.
+ :description "Tests for the Sensible Object Design translator."
+
+ :long-description
+ "This system provides unit tests for the Sod translator."
+
+ :depends-on ("sod" "xlunit")
+
+ :components
+ ((:file "test-base")
+
+ ;; Test the parser edifice.
+ (:module "parser"
+ :depends-on ("test-base")
+ :components ((:file "parser-test")
+ (:file "scanner-charbuf-test")))
+
+ ;; The actual tests.
+ (:file "c-types-test" :depends-on ("test-base"))
+ (:file "codegen-test" :depends-on ("test-base"))
+ (:file "lexer-test" :depends-on ("test-base"))))
;;;----- That's all, folks --------------------------------------------------
except where overridden by INITARGS."
(apply #'copy-instance-using-class (class-of object) object initargs))
+(export 'find-eql-specialized-method)
+(defun find-eql-specialized-method (function arg object)
+ "Return a method defined on FUNCTION whose ARGth argument is
+ `eql'-specialized on OBJECT."
+ (find-if (lambda (method)
+ (let ((spec (nth arg (method-specializers method))))
+ (and spec
+ (typep spec 'eql-specializer)
+ (eq (eql-specializer-object spec) object))))
+ (generic-function-methods function)))
+
(export '(generic-function-methods method-specializers
eql-specializer eql-specializer-object))
SUBST = $(V_SUBST)$(confsubst)
###--------------------------------------------------------------------------
+### Wrangling ASDF.
+
+ASDF_ENV = \
+ CL_SOURCE_REGISTRY=$$(cd $(top_builddir)/src && pwd): \
+ ASDF_OUTPUT_TRANSLATIONS=$$(cd $(top_srcdir)/src && pwd):$$(cd $(top_builddir)/src && pwd):
+
+###--------------------------------------------------------------------------
### Translating SOD input files.
## The tool location.
~mdw / sod / commitdiff