c-types-impl.lisp
cl:* variable function c-type
cl:array class c-type
+ bool c-type
c-array-dimensions generic
c-array-type class
c-enum-type class
c-pointer-type class
c-struct-type class
c-tagged-type-kind generic
+ c-type-bool variable
+ c-type-char variable
+ c-type-double variable
+ c-type-double-complex variable
+ c-type-double-imaginary variable
+ c-type-float variable
+ c-type-float-complex variable
+ c-type-float-imaginary variable
+ c-type-int variable
+ c-type-long variable
+ c-type-long-double variable
+ c-type-long-double-complex variable
+ c-type-long-double-imaginary variable
+ c-type-long-long variable
c-type-name generic
+ c-type-ptrdiff-t variable
+ c-type-short variable
+ c-type-signed-char variable
+ c-type-size-t variable
c-type-tag generic
+ c-type-unsigned variable
+ c-type-unsigned-char variable
+ c-type-unsigned-long variable
+ c-type-unsigned-long-long variable
+ c-type-unsigned-short variable
+ c-type-va-list variable
+ c-type-void variable
+ c-type-wchar-t variable
c-union-type class
cl:char function setf c-type parser
commentify-argument-names function
compute-chains generic
compute-cpl generic
finalize-sod-class generic
+ guess-metaclass generic
class-layout-impl.lisp
sod-class-effective-slot class
class-make-proto.lisp
check-message-type generic
check-method-type generic
- guess-metaclass generic
- define-sod-class macro
make-sod-class function
make-sod-class-initializer generic
make-sod-initializer-using-slot generic
sod-slot-type generic
codegen-impl.lisp
- call-inst class
codegen class
- do-while-inst class
- if-inst class
- inst-alt generic
- inst-ap generic
- inst-arg generic
- inst-args generic
- inst-body generic
- inst-cond generic
- inst-conseq generic
- inst-from generic
- inst-func generic
- inst-to generic
- make-call-inst function
- make-do-while-inst function
- make-if-inst function
- make-va-copy-inst function
- make-va-end-inst function
- make-va-start-inst function
- make-while-inst function
temporary-argument class
temporary-function function class
temporary-variable class
- va-copy-inst class
- va-end-inst class
- va-start-inst class
- while-inst class
codegen-proto.lisp
+ *null-pointer* variable
*sod-ap* variable
*sod-master-ap* variable
block-inst class
break-inst class
+ call-inst class
codegen-add-function generic
codegen-build-function function
codegen-functions generic setf
continue-inst class
convert-stmts function
definst macro
+ deliver-call function
deliver-expr function
+ do-while-inst class
emit-decl generic
emit-decls generic
emit-inst generic
format-compound-statement macro
format-temporary-name generic
function-inst class
+ if-inst class
inst class
+ inst-alt generic
+ inst-args generic
inst-body generic
+ inst-cond generic
+ inst-conseq generic
inst-decls generic
inst-expr generic
+ inst-func generic
inst-init generic
inst-metric generic
inst-name generic
inst-var generic
make-block-inst function
make-break-inst function
+ make-call-inst function
make-continue-inst function
+ make-do-while-inst function
make-expr-inst function
make-function-inst function
+ make-if-inst function
make-return-inst function
make-set-inst function
make-update-inst function
make-var-inst function
+ make-while-inst function
return-inst class
set-inst class
temp-tag generic
update-inst class
var-in-use-p generic setf
var-inst class
+ while-inst class
with-temporary-var macro
final.lisp
*sod-version* variable
exercise function
test-module function
+ test-parser macro
fragment-parse.lisp
parse-delimited-fragment function
banner function
declare-output-type function
guard-name function
+ one-off-output function
output-module function
output-type-pathname function
store-property function
with-pset-iterator macro
-Leaked slot names: #:func, #:class, #:expr, #:cond, #:expr, #:type, #:cond, #:expr, #:expr, #:expr, #:type, #:cond
- call-inst: #:func
- convert-to-ilayout-inst: #:class, #:expr
- do-while-inst: #:cond
- expr-inst: #:expr
- function-inst: #:type
- if-inst: #:cond
- return-inst: #:expr
- set-inst: #:expr
- update-inst: #:expr
- var-inst: #:type
- while-inst: #:cond
-
Classes:
cl:t
sb-pcl::slot-object
return-inst
set-inst
update-inst
- va-copy-inst
- va-end-inst
- va-start-inst
var-inst
while-inst
islots
(eql cl:function) t
(eql cl:nil) t
(eql cl:union) t
- (eql sod::bool) t
+ (eql bool) t
(eql double) t
(eql double-complex) t
(eql double-imaginary) t
(eql cl:float)
(eql cl:schar)
(eql cl:string)
- (eql sod::bool)
+ (eql bool)
(eql const-string)
(eql double)
(eql double-complex)
ilayout
inst-alt
if-inst
-inst-ap
- va-end-inst
- va-start-inst
-inst-arg
- va-start-inst
inst-args
call-inst
inst-body
return-inst
set-inst
update-inst
-inst-from
- va-copy-inst
inst-func
call-inst
inst-init
return-inst
set-inst
update-inst
- va-copy-inst
- va-end-inst
- va-start-inst
var-inst
while-inst
inst-name
var-inst
inst-op
update-inst
-inst-to
- va-copy-inst
inst-type
function-inst
var-inst
sod-slot t
temporary-name t
update-inst t
- va-copy-inst t
- va-end-inst t
- va-start-inst t
var-inst t
vtable t
vtable-pointer t
sb-mop:method-specializers generic
once-only macro
parse-body function
+ print-ugly-stuff function
ref function setf
symbolicate function
update-position function
Neither generic function defines a default primary method; subclasses of
@|c-type| must define their own methods in order to print correctly.
+
\subsection{The C type root class} \label{sec:clang.c-types.root}
\begin{describe}{cls}{c-type ()}
The class @|c-type| is abstract.
\end{describe}
+
\subsection{C type S-expression notation} \label{sec:clang.c-types.sexp}
The S-expression representation of a type is described syntactically as a
\end{describe}
\begin{describe}{mac}
- {defctype @{ @<name> @! (@<name> @<nickname>^*) @} @<type-spec>
- @> @<names>}
+ {defctype \=@{ @<name> @! (@<name>^+) @} @<type-spec> \+ \\
+ @[[ @|:export| @<export-flag> @]]^* \-
+ \nlret @<names>}
Defines a new symbolic type specifier @<name>; if a list of @<name>s is
given, then all are defined in the same way. The type constructed by using
any of the @<name>s is as described by the type specifier @<type-spec>.
The resulting type object is constructed once, at the time that the macro
expansion is evaluated; the same (@|eq|) value is used each time any
@<name> is used in a type specifier.
+
+ A variable named @|c-type-@<name>|, for the first @<name> only, is defined
+ and initialized to contain the C type object so constructed. Altering or
+ binding this name is discouraged.
+
+ If @<export-flag> is true, then the variable name, and all of the @<name>s,
+ are exported from the current package.
\end{describe}
\begin{describe}{mac}{c-type-alias @<original> @<alias>^* @> @<aliases>}
default method.
\end{describe}
+
\subsection{Comparing C types} \label{sec:clang.c-types.cmp}
It is necessary to compare C types for equality, for example when checking
\end{describe}
\end{describe}
+
\subsection{Outputting C types} \label{sec:clang.c-types.output}
\begin{describe}{gf}{pprint-c-type @<c-type> @<stream> @<kernel>}
within the @<form>s.
\end{describe}
+
\subsection{Type qualifiers and qualifiable types}
\label{sec:clang.ctypes.qual}
qualifiers; others keywords may be used, though this isn't recommended.
Two qualifiable types are equal only if they have \emph{matching
- qualifiers}: i.e., every qualifier attached to one is also attached to
- the other: order is not significant, and neither is multiplicity.
+ qualifiers}: i.e., every qualifier attached to one is also attached to the
+ other: order is not significant, and neither is multiplicity.
The class @|qualifiable-c-type| is abstract.
\end{describe}
type will be interned.
\end{describe}
- \begin{describe}{fun}{format-qualifiers @<qualifiers>}
+ \begin{describe}{fun}{format-qualifiers @<qualifiers> @> @<string>}
Returns a string containing the qualifiers listed in @<qualifiers> in C
syntax, with a space after each. In particular, if @<qualifiers> is
non-null then the final character of the returned string will be a space.
\end{describe}
+
\subsection{Leaf types} \label{sec:clang.c-types.leaf}
A \emph{leaf type} is a type which is not defined in terms of another type.
\end{describe}
\begin{describe}{mac}
- {define-simple-c-type @{ @<name> @! (@<name>^*) @} @<string> @> @<name>}
+ {define-simple-c-type \=@{ @<name> @! (@<name>^+) @} @<string> \+ \\
+ @[[ @|:export| @<export-flag> @]] \-
+ \nlret @<name>}
Define type specifiers for a new simple C type. Each symbol @<name> is
defined as a symbolic type specifier for the (unique interned) simple C
type whose name is the value of @<string>. Further, each @<name> is
defined to be a type operator: the type specifier @|(@<name>
@<qualifier>^*)| evaluates to the (unique interned) simple C type whose
name is @<string> and which has the @<qualifiers> (which are evaluated).
+
+ Furthermore, a variable @|c-type-@<name>| is defined, for the first @<name>
+ only, and initialized with the newly constructed C type object.
+
+ If @<export-flag> is true, then the @|c-type-@<name>| variable name, and
+ all of the @<name>s, are exported from the current package.
\end{describe}
\begin{describe}{cls}{tagged-c-type (qualifiable-c-type)
keywords).
\end{describe}
+
\subsection{Compound C types} \label{sec:code.c-types.compound}
Some C types are \emph{compound types}: they're defined in terms of existing
this means depends on the class of @<c-type>.
\end{describe}
+
\subsection{Pointer types} \label{sec:clang.c-types.pointer}
- Pointers compound types. The subtype of a pointer type is the type it points
- to.
+ 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}
interned also.
\end{describe}
+
\subsection{Array types} \label{sec:clang.c-types.array}
Arrays implement the compound-type protocol. The subtype of an array type is
Returns the dimensions of @<c-type>, an array type, as an immutable list.
\end{describe}
+
\subsection{Function types} \label{sec:clang.c-types.fun}
Function types implement the compound-type protocol. The subtype of a
\end{describe}
\begin{describe*}
- {\dhead{fun}{argument-name @<argument> @> @<name>}
- \dhead{fun}{argument-type @<argument> @> @<c-type>}}
+
{\dhead{fun}{argument-name @<argument> @> @<name>}
+
\dhead{fun}{argument-type @<argument> @> @<c-type>}}
Accessor functions for @|argument| objects. They return the name (for
@|argument-name|) or type (for @|argument-type|) from the object, as passed
to @|make-argument|.
in the same order, and either both or neither argument list ends with
@|:ellipsis|; argument names are not compared.
- The type specifier @|(fun @<return-type> @{ (@<arg-name> @<arg-type>) @}^*
- @[:ellipsis @! . @<form> @])| 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
+ \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
\begin{itemize}
\item nothing, in which case the function's argument list consists only of
the explicit arguments;
@|commentify-argument-names| to the argument list of the given type.
\end{describe}
+
\subsection{Parsing C types} \label{sec:clang.c-types.parsing}
\begin{describe}{fun}
\nlret @<result> @<success-flag> @<consumed-flag>}
\end{describe}
+
\subsection{Class types} \label{sec:clang.c-types.class}
\begin{describe}{cls}
This section deals with Sod's facilities for constructing and manipulating C
expressions, declarations, instructions and definitions.
+
\subsection{Temporary names} \label{sec:clang.codegen.temporaries}
Many C-level objects, especially ones with external linkage or inclusion in a
\thd{\textbf{Variable}} & \thd{\textbf{Name format}} \\ \hlx{vhv}
{}*sod-ap* & sod__ap \\
{}*sod-master-ap* & sod__master_ap \\
- {}*sod-tmp-ap* & sod__tmp_ap \\ \hlx*{vh}
+ {}*null-pointer* & NULL \\ \hlx*{vh}
\end{tabular}
\caption{Well-known temporary names}
\label{tab:codegen.codegen.well-known-temps}
\end{table}
+
\subsection{Instructions} \label{sec:clang.codegen.insts}
\begin{describe}{cls}{inst () \&key}
\thd{Class name} &
\thd{Arguments} &
\thd{Output format} \\ \hlx{vhv}
- @|var| & @<name> @<type> @<init> & @<type> @<name> @[= @<init>@];
+ @|var| & @<name> @<type> @|\&optional| @<init>
+ & @<type> @<name> @[= @<init>@];
\\ \hlx{v}
@|set| & @<var> @<expr> & @<var> = @<expr>; \\ \hlx{v}
@|update| & @<var> @<op> @<expr> & @<var> @<op>= @<expr>;
@|break| & --- & break; \\ \hlx{v}
@|continue| & --- & continue; \\ \hlx{v}
@|expr| & @<expr> & @<expr>; \\ \hlx{v}
- @|call| & @<func> @<args> & @<func>(@<arg>_1,
+ @|call| & @<func> @|\&rest| @<args>
+ & @<func>(@<arg>_1,
$\ldots$,
- @<arg>_n) \\ \hlx{v}
- @|va-start| & @<ap> @<arg> & va_start(@<ap>, @<arg>);
- \\ \hlx{v}
- @|va-copy| & @<to> @<from> & va_copy(@<to>, @<from>);
- \\ \hlx{v}
- @|va-end| & @<ap> & va_end(@<ap>); \\ \hlx{vhv}
+ @<arg>_n) \\ \hlx{vhv}
@|block| & @<decls> @<body> & \{ @[@<decls>@] @<body> \}
\\ \hlx{v}
- @|if| & @<cond> @<conseq> @<alt> & if (@<cond>) @<conseq>
+ @|if| & @<cond> @<conseq> @|\&optional| @<alt>
+ & if (@<cond>) @<conseq>
@[else @<alt>@] \\ \hlx{v}
@|while| & @<cond> @<body> & while (@<cond>) @<body>
\\ \hlx{v}
@|do-while| & @<body> @<cond> & do @<body> while (@<cond>);
\\ \hlx{v}
@|function| & @<name> @<type> @<body> &
- @<type>_0 @<name>(@<type>_1 @<arg>_1, $\ldots$,
- @<type>_n @<arg>_n @[, \dots@])
- @<body> \\ \hlx*{vh}
+
\vtop{\hbox{\strut @<type>_0 @<name>(@<type>_1 @<arg>_1, $\ldots$,
+ @<type>_n @<arg>_n @[, \dots@])}
+ \hbox{\strut \quad @<body>}} \\ \hlx*{vh}
\end{tabular}
\caption{Instruction classes}
\label{tab:codegen.codegen.insts}
\end{table}
+
\subsection{Code generation} \label{sec:clang.codegen.codegen}
\begin{describe}{gf}{codegen-functions @<codegen> @> @<list>}
\begin{describe}{gf}{emit-decl @<codegen> @<decl>}
\end{describe}
-\begin{describe}{gf}{emit-declss @<codegen> @<decls>}
+\begin{describe}{gf}{emit-decls @<codegen> @<decls>}
\end{describe}
\begin{describe}{gf}{codegen-push @<codegen>}
\begin{describe}{fun}{deliver-expr @<codegen> @<target> @<expr>}
\end{describe}
+\begin{describe}{fun}
+ {deliver-call @<codegen> @<target> @<func> \&rest @<args>}
+\end{describe}
+
\begin{describe}{fun}{convert-stmts @<codegen> @<target> @<type> @<func>}
\end{describe}
+ #! /bin/sh
+ ":"; CL_SOURCE_REGISTRY=$(pwd)/build/src/:; export CL_SOURCE_REGISTRY
+ ":"; exec cl-launch -X -l "sbcl cmucl" -s asdf -i "(sod-exports::main)" -- "$0" "$@" || exit 1
+
(cl:defpackage #:sod-exports
- (:use #:common-lisp))
+ (:use #:common-lisp
+ #+cmu #:mop
+ #+sbcl #:sb-mop))
(cl:in-package #:sod-exports)
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (mapc #'asdf:load-system '(:sod :sod-frontend)))
(defun symbolicate (&rest things)
(intern (apply #'concatenate 'string (mapcar #'string things))))
(and export
(list* (symbolicate code '-inst)
(symbolicate 'make- code '-inst)
- (mapcar (lambda (arg)
- (symbolicate 'inst- arg))
+ (mapcan (lambda (arg)
+ (let ((sym (if (listp arg) (car arg) arg)))
+ (cond ((char= (char (symbol-name sym) 0) #\&)
+ nil)
+ (t
+ (list (symbolicate 'inst- sym))))))
args)))))
(defmethod form-list-exports ((head (eql 'sod::define-tagged-type)) tail)
(symbolicate 'c- kind '-type)
(symbolicate 'make- kind '-type))))
+(defmethod form-list-exports ((head (eql 'sod:defctype)) tail)
+ (destructuring-bind (names value &key export) tail
+ (declare (ignore value))
+ (let ((names (if (listp names) names (list names))))
+ (and export
+ (list* (symbolicate 'c-type- (car names)) names)))))
+
+(defmethod form-list-exports ((head (eql 'sod:define-simple-c-type)) tail)
+ (destructuring-bind (names type &key export) tail
+ (declare (ignore type))
+ (let ((names (if (listp names) names (list names))))
+ (and export
+ (list* (symbolicate 'c-type- (car names)) names)))))
+
(defmethod form-list-exports ((head (eql 'cl:macrolet)) tail)
(mapcan #'form-exports (cdr tail)))
(defun specialized-on-p (func arg what)
(some (lambda (method)
- (let ((spec (nth arg (sb-mop:method-specializers method))))
- (and (typep spec 'sb-mop:eql-specializer)
- (eql (sb-mop:eql-specializer-object spec) what))))
- (sb-mop:generic-function-methods func)))
+ (let ((spec (nth arg (method-specializers method))))
+ (and (typep spec 'eql-specializer)
+ (eql (eql-specializer-object spec) what))))
+ (generic-function-methods func)))
(defun categorize (symbol)
(let ((things nil))
(let ((done (make-hash-table)))
(labels ((walk-up (class)
(unless (gethash class done)
- (dolist (super (sb-mop:class-direct-superclasses class))
+ (dolist (super (class-direct-superclasses class))
(push class (gethash super subs))
(walk-up super))
(setf (gethash class done) t))))
(pretty-symbol-name (class-name class)
package))
(remove super
- (sb-mop:class-direct-superclasses this))))
+ (class-direct-superclasses this))))
(dolist (sub (sort (copy-list (gethash this subs))
#'string< :key #'class-name))
(walk-down sub this (1+ depth)))))
(deep-compare (la lb)
(loop (typesw (null (return nil)))
(focus (car it)
- (typesw (sb-mop:eql-specializer
- (focus (sb-mop:eql-specializer-object it)
+ (typesw (eql-specializer
+ (focus (eql-specializer-object it)
(typesw (keyword
(compare (string< left right)))
(symbol
(defun analyse-generic-functions (package)
(setf package (find-package package))
(flet ((function-name-core (name)
- (etypecase name
- (symbol name)
- ((cons (eql setf) t) (cadr name)))))
+ (typecase name
+ (symbol (values name t))
+ ((cons (eql setf) t) (values (cadr name) t))
+ (t (values nil nil)))))
(let ((methods (make-hash-table))
(functions (make-hash-table))
(externs (make-hash-table)))
(flet ((dofunc (func)
(when (typep func 'generic-function)
(setf (gethash func functions) t)
- (dolist (method (sb-mop:generic-function-methods func))
+ (dolist (method (generic-function-methods func))
(setf (gethash method methods) t)))))
(dofunc (and (fboundp symbol) (fdefinition symbol)))
(dofunc (ignore-errors (fdefinition (list 'setf symbol)))))
(let ((class (find-class symbol nil)))
(when class
(dolist
- (func (sb-mop:specializer-direct-generic-functions class))
- (let ((name (function-name-core
- (sb-mop:generic-function-name func))))
- (when (or (not (eq (symbol-package name) package))
- (gethash name externs))
+ (func (specializer-direct-generic-functions class))
+ (multiple-value-bind (name knownp)
+ (function-name-core (generic-function-name func))
+ (when (and knownp
+ (or (not (eq (symbol-package name) package))
+ (gethash name externs)))
(setf (gethash func functions) t)
- (dolist (method (sb-mop:specializer-direct-methods class))
+ (dolist (method (specializer-direct-methods class))
(setf (gethash method methods) t)))))))))
(let ((funclist nil))
(maphash (lambda (func value)
(if (eq core-a core-b)
(and (atom a) (consp b))
(string< core-a core-b))))
- :key #'sb-mop:generic-function-name))
+ :key #'generic-function-name))
(dolist (function funclist)
- (let ((name (sb-mop:generic-function-name function)))
+ (let ((name (generic-function-name function)))
(etypecase name
(symbol
(format t "~A~%" (pretty-symbol-name name package)))
(format t "(setf ~A)~%"
(pretty-symbol-name (cadr name) package)))))
(dolist (method (sort (copy-list
- (sb-mop:generic-function-methods function))
+ (generic-function-methods function))
#'order-specializers
- :key #'sb-mop:method-specializers))
+ :key #'method-specializers))
(when (gethash method methods)
(format t "~2T~{~A~^ ~}~%"
(mapcar
(let ((name (class-name spec)))
(if (eq name t) "t"
(pretty-symbol-name name package))))
- (sb-mop:eql-specializer
- (let ((obj (sb-mop:eql-specializer-object spec)))
+ (eql-specializer
+ (let ((obj (eql-specializer-object spec)))
(format nil "(eql ~A)"
(if (symbolp obj)
(pretty-symbol-name obj package)
obj))))))
- (sb-mop:method-specializers method))))))))))
+ (method-specializers method))))))))))
(defun check-slot-names (package)
(setf package (find-package package))
(offenders (mapcan
(lambda (class)
(let* ((slot-names
- (mapcar #'sb-mop:slot-definition-name
- (sb-mop:class-direct-slots class)))
+ (mapcar #'slot-definition-name
+ (class-direct-slots class)))
(exported (remove-if
(lambda (sym)
- (and (not (exported-symbol-p sym))
- (eq (symbol-package sym)
- package)))
+ (or (not (symbol-package sym))
+ (and (not (exported-symbol-p
+ sym))
+ (eq (symbol-package sym)
+ package))))
slot-names)))
(and exported
(list (cons (class-name class)
(report-symbols (mapcar #'file-name (list optparse)) "OPTPARSE")
(report-symbols (mapcar #'file-name (list utilities)) "SOD-UTILITIES"))))
- #+interactive
- (with-open-file (*standard-output* #p"doc/SYMBOLS" :direction :output
- :if-exists :supersede :if-does-not-exist :create)
- (report-project-symbols))
+ (defun main ()
+ (with-open-file (*standard-output* #p"doc/SYMBOLS"
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (report-project-symbols)))
+
+ #+interactive (main)
\dhead{gf}{setf (sod-class-methods @<class>) @<list>}}
\end{describe*}
- %% layout protocol
- \begin{describe*}
- {\dhead{gf}{sod-class-ilayout <class> @> @<ilayout>}
- \dhead{gf}{sod-class-effective-methods @<class> @> @<list>}
- \dhead{gf}{sod-class-vtables @<class> @> @<list>}}
- \end{describe*}
-
- \begin{describe}{gf}{guess-metaclass @<class> @> @<metaclass>}
- \end{describe}
-
\begin{describe}{fun}
{make-sod-class @<name> @<superclasses> @<pset> \&optional @<floc>
@> @<class>}
\end{describe}
-\begin{describe}{mac}
- {define-sod-class @<name> (@<superclass>^*) \\ \ind
- @{ @<keyword> @<value> @}^* \\
- @<declaration>^* \\
- @<form>^*}
-\end{describe}
-
\begin{describe*}
{\dhead{lmac}{slot @<name> @<type> @{ @<keyword> @<value> @}^*}
\dhead{lmac}{instance-initializer @<nick> @<name>
\begin{describe}{gf}{compute-chains @<class> @> @<list>}
\end{describe}
+ \begin{describe}{gf}{guess-metaclass @<class> @> @<metaclass>}
+ \end{describe}
+
\begin{describe}{gf}{check-sod-class @<class>}
\end{describe}
\begin{describe}{fun}{l*loops-cpl @<class> @> @<list>}
\end{describe}
+
%%%----- That's all, folks --------------------------------------------------
%%% Local variables:
\chapter{Module syntax} \label{ch:syntax}
%%%--------------------------------------------------------------------------
+\section{Notation} \label{sec:syntax.notation}
Fortunately, Sod is syntactically quite simple. The notation is slightly
unusual in order to make the presentation shorter and easier to read.
\end{quote}
\end{itemize}
-\subsection{Lexical syntax}
-\label{sec:syntax.lex}
+%%%--------------------------------------------------------------------------
+\section{Lexical syntax} \label{sec:syntax.lex}
Whitespace and comments are discarded. The remaining characters are
collected into tokens according to the following syntax.
munch} rule: at each stage we take the longest sequence of characters which
could be a token.
-\subsubsection{Identifiers} \label{sec:syntax.lex.id}
+
+\subsection{Identifiers} \label{sec:syntax.lex.id}
\begin{grammar}
<identifier> ::= <id-start-char> @<id-body-char>^*
settled by distinguishing type names from other identifiers at a lexical
level.
-\subsubsection{String and character literals} \label{sec:syntax.lex.string}
+
+\subsection{String and character literals} \label{sec:syntax.lex.string}
\begin{grammar}
<string-literal> ::= "\"" @<string-literal-char>^* "\""
goes slightly beyond C in allowing a @`0o' prefix for octal and @`0b' for
binary. However, length and signedness indicators are not permitted.
-\subsubsection{Punctuation} \label{sec:syntax.lex.punct}
+
+\subsection{Punctuation} \label{sec:syntax.lex.punct}
\begin{grammar}
<punctuation> ::= any nonalphanumeric character other than "_", "\"" or "'"
\end{grammar}
-\subsubsection{Comments} \label{sec:lex-comment}
+
+\subsection{Comments} \label{sec:syntax.lex.comment}
\begin{grammar}
<comment> ::= <block-comment>
\dots\ \texttt{*/}' and \Cplusplus-style `\texttt{//} \dots' comments are
permitted and ignored.
-\subsection{Special nonterminals}
-\label{sec:special-nonterminals}
+
+\subsection{Special nonterminals} \label{sec:syntax.lex.special}
Aside from the lexical syntax presented above (\xref{sec:lexical-syntax}),
two special nonterminals occur in the module syntax.
-\subsubsection{S-expressions} \label{sec:syntax-sexp}
-
+\subsubsection{S-expressions}
\begin{grammar}
<s-expression> ::= an S-expression, as parsed by the Lisp reader
\end{grammar}
When an S-expression is expected, the Sod parser simply calls the host Lisp
-system's \textsf{read} function. Sod modules are permitted to modify the
-read table to extend the S-expression syntax.
+system's @|read| function. Sod modules are permitted to modify the read
+table to extend the S-expression syntax.
S-expressions are self-delimiting, so no end-marker is needed.
-\subsubsection{C fragments} \label{sec:syntax.lex.cfrag}
-
+\subsubsection{C fragments}
\begin{grammar}
<c-fragment> ::= a sequence of C tokens, with matching brackets
\end{grammar}
or bracket. The first such delimiter character which is not enclosed in
brackets, braces or parenthesis ends the fragment.
-\subsection{Module syntax} \label{sec:syntax-module}
+%%%--------------------------------------------------------------------------
+\section{Module syntax} \label{sec:syntax.module}
\begin{grammar}
<module> ::= @<definition>^*
\alt <class-definition>
\end{grammar}
-A module is the top-level syntactic item. A module consists of a sequence of
-definitions.
+A @<module> is the top-level syntactic item. A module consists of a sequence
+of definitions.
-\subsection{Simple definitions} \label{sec:syntax.defs}
-
-\subsubsection{Importing modules} \label{sec:syntax.defs.import}
+\subsection{Simple definitions} \label{sec:syntax.module.simple}
+\subsubsection{Importing modules}
\begin{grammar}
<import-definition> ::= "import" <string> ";"
\end{grammar}
Recursive imports, either direct or indirect, are an error.
-\subsubsection{Loading extensions} \label{sec:syntax.defs.load}
-
+\subsubsection{Loading extensions}
\begin{grammar}
<load-definition> ::= "load" <string> ";"
\end{grammar}
particular system definition facility. It's bad enough already that it
depends on Common Lisp.)
-\subsubsection{Lisp escapes} \label{sec:syntax.defs.lisp}
-
+\subsubsection{Lisp escapes}
\begin{grammar}
<lisp-definition> ::= "lisp" <s-expression> ";"
\end{grammar}
this isn't as unusually scary as it sounds. But please be careful.} %
\end{boxy}
-\subsubsection{Declaring type names} \label{sec:syntax.defs.typename}
-
+\subsubsection{Declaring type names}
\begin{grammar}
<typename-definition> ::=
- "typename" <list>@[<identifier>@] ";"
+ "typename" <list>$[\mbox{@<identifier>}]$ ";"
\end{grammar}
Each @<identifier> is declared as naming a C type. This is important because
Don't declare class names using @"typename"; use @"class" forward
declarations instead.
-\subsection{Literal code} \label{sec:syntax-code}
+
+\subsection{Literal code} \label{sec:syntax.module.literal}
\begin{grammar}
<code-definition> ::=
- "code" <identifier> ":" <identifier> @[<constraints>@]
+ "code" <identifier> ":" <item-name> @[<constraints>@]
"{" <c-fragment> "}"
-<constraints> ::= "[" <list>@[<constraint>@] "]"
+<constraints> ::= "[" <list>$[\mbox{@<constraint>}]$ "]"
+
+<constraint> ::= @<item-name>^+
-<constraint> ::= @<identifier>^+
+<item-name> ::= <identifier> @! "(" @<identifier>^+ ")"
\end{grammar}
The @<c-fragment> will be output unchanged to one of the output files.
output file names are @"c" and @"h", which are the implementation code and
header file respectively; other output files can be defined by extensions.
-The second @<identifier> provides a name for the output item. Several C
-fragments can have the same name: they will be concatenated together in the
-order in which they were encountered.
+Output items are named with a sequence of identifiers, separated by
+whitespace, and enclosed in parentheses. As an abbreviation, a name
+consisting of a single identifier may be written as just that identifier,
+without the parentheses.
The @<constraints> provide a means for specifying where in the output file
the output item should appear. (Note the two kinds of square brackets shown
in the syntax: square brackets must appear around the constraints if they are
present, but that they may be omitted.) Each comma-separated @<constraint>
-is a sequence of identifiers naming output items, and indicates that the
-output items must appear in the order given -- though the translator is free
-to insert additional items in between them. (The particular output items
-needn't be defined already -- indeed, they needn't be defined ever.)
+is a sequence of names of output items, and indicates that the output items
+must appear in the order given -- though the translator is free to insert
+additional items in between them. (The particular output items needn't be
+defined already -- indeed, they needn't be defined ever.)
There is a predefined output item @"includes" in both the @"c" and @"h"
output files which is a suitable place for inserting @"\#include"
preprocessor directives in order to declare types and functions for use
elsewhere in the generated output files.
-\subsection{Property sets} \label{sec:syntax.propset}
+\subsection{Property sets} \label{sec:syntax.module.properties}
\begin{grammar}
-<properties> ::= "[" <list>@[<property>@] "]"
+<properties> ::= "[" <list>$[\mbox{@<property>}]$ "]"
<property> ::= <identifier> "=" <expression>
\end{grammar}
evaluating an @<expression>. The value can be one of a number of types,
though the only operators currently defined act on integer values only.
-\subsubsection{The expression evaluator} \label{sec:syntax.propset.expr}
-
+\subsubsection{The expression evaluator}
\begin{grammar}
<expression> ::= <term> | <expression> "+" <term> | <expression> "-" <term>
function.
%%% FIXME crossref to extension docs
-\subsection{C types} \label{sec:syntax.c-types}
+
+\subsection{C types} \label{sec:syntax.module.types}
Sod's syntax for C types closely mirrors the standard C syntax. A C type has
two parts: a sequence of @<declaration-specifier>s and a @<declarator>. In
`implicit @"int"' is forbidden), and storage-class specifiers are not
recognized.
-\subsubsection{Declaration specifiers} \label{sec:syntax.c-types.declspec}
-
+\subsubsection{Declaration specifiers}
\begin{grammar}
<declaration-specifier> ::= <type-name>
\alt "struct" <identifier> | "union" <identifier> | "enum" <identifier>
\alt "void" | "char" | "int" | "float" | "double"
\alt "short" | "long"
\alt "signed" | "unsigned"
+\alt "bool" | "_Bool"
+\alt "imaginary" | "_Imaginary" | "complex" | "_Complex"
\alt <qualifier>
<qualifier> ::= "const" | "volatile" | "restrict"
\end{grammar}
A @<type-name> is an identifier which has been declared as being a type name,
-using the @"typename" or @"class" definitions.
+using the @"typename" or @"class" definitions. The following type names are
+defined in the built-in module.
+\begin{itemize}
+\item @"va_list"
+\item @"size_t"
+\item @"ptrdiff_t"
+\item @"wchar_t"
+\end{itemize}
Declaration specifiers may appear in any order. However, not all
combinations are permitted. A declaration specifier must consist of zero or
- more @<qualifiers>, and one of the following, up to reordering.
+ more @<qualifier>s, and one of the following, up to reordering.
\begin{itemize}
\item @<type-name>
\item @"struct" @<identifier>, @"union" @<identifier>, @"enum" @<identifier>
\item @"void"
+\item @"_Bool", @"bool"
\item @"char", @"unsigned char", @"signed char"
\item @"short", @"unsigned short", @"signed short"
\item @"short int", @"unsigned short int", @"signed short int"
\item @"long long", @"unsigned long long", @"signed long long"
\item @"long long int", @"unsigned long long int", @"signed long long int"
\item @"float", @"double", @"long double"
+\item @"float _Imaginary", @"double _Imaginary", @"long double _Imaginary"
+\item @"float imaginary", @"double imaginary", @"long double imaginary"
+\item @"float _Complex", @"double _Complex", @"long double _Complex"
+\item @"float complex", @"double complex", @"long double complex"
\end{itemize}
All of these have their usual C meanings.
-\subsubsection{Declarators} \label{sec:syntax.c-types.declarator}
-
+\subsubsection{Declarators}
\begin{grammar}
<declarator>$[k]$ ::= @<pointer>^* <primary-declarator>$[k]$
<declarator-suffix> ::= "[" <c-fragment> "]"
\alt "(" <arguments> ")"
-<arguments> ::= $\epsilon$ | "..."
-\alt <list>@[<argument>@] @["," "..."@]
+<argument-list> ::= $\epsilon$ | "..."
+\alt <list>$[\mbox{@<argument>}]$ @["," "..."@]
<argument> ::= @<declaration-specifier>^+ <argument-declarator>
-<argument-declarator> ::= <declarator>@[<identifier> @! $\epsilon$@]
+<argument-declarator> ::= <declarator>$[\mbox{@<identifier> @! $\epsilon$}]$
-<simple-declarator> ::= <declarator>@[<identifier>@]
+<simple-declarator> ::= <declarator>$[\mbox{@<identifier>}]$
<dotted-name> ::= <identifier> "." <identifier>
-
-<dotted-declarator> ::= <declarator>@[<dotted-name>@]
\end{grammar}
The declarator syntax is taken from C, but with some differences.
The remaining differences are (I hope) a matter of presentation rather than
substance.
-\subsection{Defining classes} \label{sec:syntax.class}
+
+\subsection{Class definitions} \label{sec:syntax.module.class}
\begin{grammar}
<class-definition> ::= <class-forward-declaration>
\alt <full-class-definition>
\end{grammar}
-\subsubsection{Forward declarations} \label{sec:class.class.forward}
-
+\subsubsection{Forward declarations}
\begin{grammar}
<class-forward-declaration> ::= "class" <identifier> ";"
\end{grammar}
};
\end{listing}
-\subsubsection{Full class definitions} \label{sec:class.class.full}
-
+\subsubsection{Full class definitions}
\begin{grammar}
<full-class-definition> ::=
@[<properties>@]
- "class" <identifier> ":" <list>@[<identifier>@]
- "{" @<class-item>^* "}"
+ "class" <identifier> ":" <list>$[\mbox{@<identifier>}]$
+ "{" @<properties-class-item>^* "}"
+
+<properties-class-item> ::= @[<properties>@] <class-item>
-<class-item> ::= <slot-item> ";"
-\alt <initializer-item> ";"
+<class-item> ::= <slot-item>
+\alt <initializer-item>
\alt <message-item>
\alt <method-item>
\end{grammar}
or an existing type name. It is conventional to give classes `MixedCase'
names, to distinguish them from other kinds of identifiers.
-The @<list>@[<identifier>@] names the direct superclasses for the new class. It
-is an error if any of these @<identifier>s does not name a defined class.
+The @<list>$[\mbox{@<identifier>}]$ names the direct superclasses for the new
+class. It is an error if any of these @<identifier>s does not name a defined
+class.
The @<properties> provide additional information. The standard class
properties are as follows.
The class body consists of a sequence of @<class-item>s enclosed in braces.
These items are discussed on the following sections.
-\subsubsection{Slot items} \label{sec:sntax.class.slot}
-
+\subsubsection{Slot items}
\begin{grammar}
<slot-item> ::=
- @[<properties>@]
- @<declaration-specifier>^+ <list>@[<init-declarator>@]
+ @<declaration-specifier>^+ <list>$[\mbox{@<init-declarator>}]$ ";"
<init-declarator> ::= <simple-declarator> @["=" <initializer>@]
\end{grammar}
};
\end{listing}
-\subsubsection{Initializer items} \label{sec:syntax.class.init}
-
+\subsubsection{Initializer items}
\begin{grammar}
-<initializer-item> ::= @["class"@] <list>@[<slot-initializer>@]
+<initializer-item> ::= @["class"@] <list>$[\mbox{@<slot-initializer>}]$ ";"
<slot-initializer> ::= <dotted-name> "=" <initializer>
slots, such as pointers or integers, and strings.
\end{itemize}
-\subsubsection{Message items} \label{sec:syntax.class.message}
-
+\subsubsection{Message items}
\begin{grammar}
<message-item> ::=
- @[<properties>@]
- @<declaration-specifier>^+ <declarator> @[<method-body>@]
+ @<declaration-specifier>^+
+ <keyword-declarator>$[\mbox{@<identifier>}]$
+ @[<method-body>@]
\end{grammar}
-\subsubsection{Method items} \label{sec:syntax.class.method}
-
+\subsubsection{Method items}
\begin{grammar}
<method-item> ::=
- @[<properties>@]
- @<declaration-specifier>^+ <declarator> <method-body>
+ @<declaration-specifier>^+
+ <keyword-declarator>$[\mbox{@<dotted-name>}]$
+ <method-body>
<method-body> ::= "{" <c-fragment> "}" | "extern" ";"
\end{grammar}
-
%%%----- That's all, folks --------------------------------------------------
%%% Local variables:
;; accessor functions later.
((label :type keyword :initarg :label :reader ds-label)
(name :type string :initarg :name :reader ds-name)
- (kind :type (member type sign size qualifier)
+ (kind :type (member type complexity sign size qualifier)
:initarg :kind :reader ds-kind)
(taggedp :type boolean :initarg :taggedp
:initform nil :reader ds-taggedp))
;; Turns out to be easier to do this by hand.
(let ((ds (and (eq (token-type scanner) :id)
(let ((kw (token-value scanner)))
- (or (gethash kw *module-type-map*)
+ (or (and (boundp '*module-type-map*)
+ (gethash kw *module-type-map*))
(gethash kw *declspec-map*))))))
(cond ((or (not ds) (and predicate (not (funcall predicate ds))))
(values (list indicator) nil nil))
;;;--------------------------------------------------------------------------
;;; Classes.
- (defun maximum (items order what)
- "Return a maximum item according to the non-strict partial ORDER."
- (reduce (lambda (best this)
- (cond ((funcall order best this) best)
- ((funcall order this best) this)
- (t (error "Unable to choose best ~A." what))))
- items))
-
- (defmethod guess-metaclass ((class sod-class))
- "Default metaclass-guessing function for classes.
-
- Return the most specific metaclass of any of the CLASS's direct
- superclasses."
- (maximum (mapcar #'sod-class-metaclass
- (sod-class-direct-superclasses class))
- #'sod-subclass-p
- (format nil "metaclass for `~A'" class)))
-
(defmethod shared-initialize :after ((class sod-class) slot-names &key pset)
"Specific behaviour for SOD class initialization.
(pset :nick :id)
(string-downcase (slot-value class 'name)))
- ;; If no metaclass, guess one in a (Lisp) class-specific way.
+ ;; Set the metaclass if the appropriate property has been provided;
+ ;; otherwise leave it unbound for now, and we'll sort out the mess during
+ ;; finalization.
(default-slot-from-property (class 'metaclass slot-names)
- (pset :metaclass :id meta (find-sod-class meta))
- (and (sod-class-direct-superclasses class)
- (guess-metaclass class)))
+ (pset :metaclass :id meta (find-sod-class meta)))
;; If no chain-link, then start a new chain here.
(default-slot-from-property (class 'chain-link slot-names)
:slot slot
:value-kind value-kind
:value-form value-form
- :location location
+ :location (file-location location)
:pset pset))
(defmethod shared-initialize :after
:class class
:type type
:body body
- :location location
+ :location (file-location location)
:pset pset))
(defmethod sod-message-method-class
(every (lambda (arg)
(or (eq arg :ellipsis)
(argument-name arg)
- (eq (argument-type arg) (c-type void))))
+ (c-type-equal-p (argument-type arg)
+ c-type-void)))
(c-function-arguments type)))
(error "Abstract declarators not permitted in method definitions")))
:pset pset)))
class)))
- (export 'guess-metaclass)
- (defgeneric guess-metaclass (class)
- (:documentation
- "Determine a suitable metaclass for the CLASS.
-
- The default behaviour is to choose the most specific metaclass of any of
- the direct superclasses of CLASS, or to signal an error if that failed."))
-
;;;--------------------------------------------------------------------------
;;; Slots and slot initializers.
This is separated out of `shared-initialize', where it's called, so that
it can be overridden conveniently by subclasses."))
-;;;--------------------------------------------------------------------------
-;;; Builder macros.
-
-(export 'define-sod-class)
-(defmacro define-sod-class (name (&rest superclasses) &body body)
- "Construct a new SOD class called NAME in the current module.
-
- The new class has the named direct SUPERCLASSES, which should be a list of
- strings.
-
- The BODY begins with a sequence of alternating keyword/value pairs
- defining properties for the new class. The keywords are (obviously) not
- evaluated, but the value forms are.
-
- The remainder of the BODY are a sequence of forms to be evaluated as an
- implicit `progn'. Additional macros are available to the BODY, to make
- defining the class easier.
-
- In the following, NAME is a string giving a C identifier; NICK is a string
- giving the nickname of a superclass; TYPE is a C type using S-expression
- notation.
-
- * message NAME TYPE &rest PLIST
-
- * method NICK NAME TYPE BODY &rest PLIST
-
- * slot NAME TYPE &rest PLIST
-
- * instance-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST
-
- * class-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST"
-
- (let ((plist nil)
- (classvar (gensym "CLASS-")))
- (loop
- (when (or (null body)
- (not (keywordp (car body))))
- (return))
- (push (pop body) plist)
- (push (pop body) plist))
- `(let ((,classvar (make-sod-class ,name
- (mapcar #'find-sod-class
- (list ,@superclasses))
- (make-property-set
- ,@(nreverse plist)))))
- (macrolet ((message (name type &rest plist)
- `(make-sod-message ,',classvar ,name (c-type ,type)
- (make-property-set ,@plist)))
- (method (nick name type body &rest plist)
- `(make-sod-method ,',classvar ,nick ,name (c-type ,type)
- ,body (make-property-set ,@plist)))
- (slot (name type &rest plist)
- `(make-sod-slot ,',classvar ,name (c-type ,type)
- (make-property-set ,@plist)))
- (instance-initializer
- (nick name value-kind value-form &rest plist)
- `(make-sod-instance-initializer ,',classvar ,nick ,name
- ,value-kind ,value-form
- (make-property-set
- ,@plist)))
- (class-initializer
- (nick name value-kind value-form &rest plist)
- `(make-sod-class-initializer ,',classvar ,nick ,name
- ,value-kind ,value-form
- (make-property-set
- ,@plist))))
- ,@body
- (finalize-sod-class ,classvar)
- (add-to-module *module* ,classvar)))))
-
;;;----- That's all, folks --------------------------------------------------
(effective-methods :type list :reader sod-class-effective-methods)
(vtables :type list :reader sod-class-vtables)
- (state :initform nil :type (member nil :finalized broken)
+ (state :initform nil :type (member nil :finalized :broken)
:reader sod-class-state))
(:documentation
"Classes describe the layout and behaviour of objects.
and `sod-instance-initializer'."))
(defmethod print-object ((initializer sod-initializer) stream)
- (if *print-escape*
- (print-unreadable-object (initializer stream :type t)
- (format stream "~A = ~A"
- (sod-initializer-slot initializer)
- initializer))
- (format stream "~:[{~A}~;~A~]"
- (eq (sod-initializer-value-kind initializer) :single)
- (sod-initializer-value-form initializer))))
+ (with-slots (slot value-kind value-form) initializer
+ (if *print-escape*
+ (print-unreadable-object (initializer stream :type t)
+ (format stream "~A = ~A" slot value-form))
+ (format stream "~:[{~A}~;~A~]" (eq value-kind :single) value-form))))
(export 'sod-class-initializer)
(defclass sod-class-initializer (sod-initializer)
:reader method-entry-chain-head)
(chain-tail :initarg :chain-tail :type sod-class
:reader method-entry-chain-tail)
- (role :initarg :role :type (or :keyword null) :reader method-entry-role))
+ (role :initarg :role :type (or keyword null) :reader method-entry-role))
(:documentation
"An entry point into an effective method.
(convert-stmts codegen target
(c-type-subtype (sod-method-type direct-method))
(lambda (var)
- (ensure-var codegen *sod-tmp-ap* (c-type va-list))
- (emit-inst codegen
- (make-va-copy-inst *sod-tmp-ap*
- *sod-ap*))
- (deliver-expr codegen var
- (make-call-inst function arguments))
- (emit-inst codegen
- (make-va-end-inst *sod-tmp-ap*))))
- (deliver-expr codegen target (make-call-inst function arguments)))))
+ (ensure-var codegen *sod-tmp-ap* c-type-va-list)
+ (deliver-call codegen :void "va_copy"
+ *sod-tmp-ap* *sod-ap*)
+ (apply #'deliver-call codegen var
+ function arguments)
+ (deliver-call codegen :void "va_end" *sod-tmp-ap*)))
+ (apply #'deliver-call codegen target function arguments))))
(export 'ensure-ilayout-var)
(defun ensure-ilayout-var (codegen super)
(return-type (c-type-subtype message-type))
(raw-args (sod-message-argument-tail message))
(arguments (if (varargs-message-p message)
- (cons (make-argument *sod-ap*
- (c-type va-list))
+ (cons (make-argument *sod-ap* c-type-va-list)
(butlast raw-args))
raw-args)))
(codegen-push codegen)
(make-trampoline codegen (sod-method-class method)
(lambda (target)
(invoke chain target)))
- 0))
+ *null-pointer*))
(invoke (chain target)
(if (null chain)
(funcall kernel target)
A C fragment is aware of its original location, and will bear proper #line
markers when written out."))
-(defun output-c-excursion (stream location thunk)
- "Invoke THUNK surrounding it by writing #line markers to STREAM.
+(defun output-c-excursion (stream location func)
+ "Invoke FUNC surrounding it by writing #line markers to STREAM.
The first marker describes LOCATION; the second refers to the actual
output position in STREAM. If LOCATION doesn't provide a line number then
no markers are output after all. If the output stream isn't
- position-aware then no final marker is output."
-
- (let* ((location (file-location location))
- (line (file-location-line location))
- (filename (file-location-filename location)))
- (cond (line
- (when (typep stream 'position-aware-stream)
- (format stream "~&#line ~D~@[ ~S~]~%" line filename))
- (funcall thunk)
- (when (typep stream 'position-aware-stream)
- (fresh-line stream)
- (format stream "~&#line ~D ~S~%"
- (1+ (position-aware-stream-line stream))
- (let ((path (stream-pathname stream)))
- (if path (namestring path) "<sod-output>")))))
- (t
- (funcall thunk)))))
+ position-aware then no final marker is output.
+
+ FUNC is passed the output stream as an argument. Complicated games may be
+ played with interposed streams. Try not to worry about it."
+
+ (flet ((doit (stream)
+ (let* ((location (file-location location))
+ (line (file-location-line location))
+ (filename (file-location-filename location)))
+ (cond (line
+ (when (typep stream 'position-aware-stream)
+ (format stream "~&#line ~D~@[ ~S~]~%" line filename))
+ (funcall func stream)
+ (when (typep stream 'position-aware-stream)
+ (fresh-line stream)
+ (format stream "#line ~D ~S~%"
+ (1+ (position-aware-stream-line stream))
+ (let ((path (stream-pathname stream)))
+ (if path (namestring path)
+ "<sod-output>")))))
+ (t
+ (funcall func stream))))))
+ (print-ugly-stuff stream #'doit)))
(defmethod print-object ((fragment c-fragment) stream)
(let ((text (c-fragment-text fragment))
(prin1 (subseq text 0 37) stream)
(write-string "..." stream))))
(output-c-excursion stream location
- (lambda () (write-string text stream))))))
+ (lambda (stream) (write-string text stream))))))
(defmethod make-load-form ((fragment c-fragment) &optional environment)
(make-load-form-saving-slots fragment :environment environment))
(export '(code-fragment-item code-fragment code-fragment-reason
code-fragment-name code-fragment-constraints))
(defclass code-fragment-item ()
- ((fragment :initarg :fragment :type c-fragment :reader code-fragment)
+ ((fragment :initarg :fragment :type (or string c-fragment)
+ :reader code-fragment)
(reason :initarg :reason :type keyword :reader code-fragment-reason)
(name :initarg :name :type t :reader code-fragment-name)
(constraints :initarg :constraints :type list
.B code
.I identifier
.B
-.I identifier
+.I item-name
.RI [ constraints ]
.B {
.I c-fragment
.br
.I constraint
::=
+.IR item-name \*+
+.br
+.I item-name
+::=
+.I identifier
+|
+.B (
.IR identifier \*+
+.B )
.
.SS Class definitions
.I
.IR list [ identifier ]
.<
.B {
-.IR class-item \**
+.IR properties-class-item \**
.B }
.br
+.I properties-class-item
+::=
+.RI [ properties ]
+.I class-item
+.br
.I class-item
::=
.I slot-item
.I slot-item
::=
.<
-.RI [ properties ]
.IR declaration-specifier \*+
.IR list [ init-declarator ]
.B ;
.br
.I initializer-item
::=
-.RI [ properties ]
.RB [ class ]
.IR list [ slot-initializer ]
.B ;
.br
.I message-item
::=
-.RI [ properties ]
.<
.IR declaration-specifier \*+
.I simple-declarator
-.<
.RI [ method-body ]
.br
.I method-item
-.RI [ properties ]
+::=
.<
.IR declaration-specifier \*+
-.I dotted-declarator
-.<
+.IR declarator [ dotted-name ]
.I method-body
.br
.I method-body
|
.B unsigned
.|
+.B bool
+|
+.B _Bool
+.|
+.B imaginary
+|
+.B _Imaginary
+|
+.B complex
+|
+.B _Complex
+.|
.I qualifier
.br
.I qualifier
::=
.I identifier
.PP
+The following
+.IR type-name s
+are defined in the built-in module.
+.hP \*o
+.B va_list
+.hP \*o
+.B size_t
+.hP \*o
+.B ptrdiff_t
+.hP \*o
+.B wchar_t
+.PP
Declaration specifiers may appear in any order.
However, not all combinations are permitted.
A declaration specifier must consist of
- zero or more qualifiers,
+ zero or more
+ .IR qualifier s,
and one of the following, up to reordering.
.hP \*o
.I type-name
.BR float ,
.BR double ,
.B long double
+.hP \*o
+.BR "float _Imaginary" ,
+.BR "double _Imaginary" ,
+.B "long double _Imaginary"
+.hP \*o
+.BR "float imaginary" ,
+.BR "double imaginary" ,
+.B "long double imaginary"
+.hP \*o
+.BR "float _Complex" ,
+.BR "double _Complex" ,
+.B "long double _Complex"
+.hP \*o
+.BR "float complex" ,
+.BR "double complex" ,
+.B "long double complex"
.PP
.IR declarator [ k ]
::=
.B ]
.|
.B (
-.I arguments
+.I argument-list
.B )
.br
-.I arguments
+.I argument-list
::=
\*e |
.B ...
.I identifier
.B .\&
.I identifier
-.br
-.I dotted-declarator
-::=
-.IR declarator [ dotted-name ]
-
+.
.\"--------------------------------------------------------------------------
.SH SEE ALSO
.BR sod (1),
~mdw / sod / commitdiff