From ea578bb4b9eb4a03b2eb4ed151e058d699c216ea Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Wed, 24 Jul 2013 00:49:14 +0100 Subject: [PATCH] Today's wip. --- doc/sod.tex | 28 ++++++------- doc/standard-method-combination.svg | 28 ++++++------- src/builtin.lisp | 81 ++++++++++++++++++++++++------------- src/c-types-parse.lisp | 16 ++++---- src/c-types-test.lisp | 2 +- src/class-layout-impl.lisp | 4 +- src/module-output.lisp | 3 +- src/module-parse.lisp | 2 +- src/output-impl.lisp | 3 +- src/parser/streams-proto.lisp | 2 +- src/pset-proto.lisp | 8 +++- src/sod.asd | 8 ++-- 12 files changed, 105 insertions(+), 80 deletions(-) diff --git a/doc/sod.tex b/doc/sod.tex index ba2aaa5..8a46735 100644 --- a/doc/sod.tex +++ b/doc/sod.tex @@ -169,11 +169,11 @@ unusual notation in order to make the presentation easier to read. \end{quote} \item @[@@] means an optional @: \begin{quote} - \syntax{@[@] ::= $\epsilon$ | } + \syntax{@[@] ::= $\epsilon$ @! } \end{quote} \item @^* means a sequence of zero or more @s: \begin{quote} - \syntax{@^* ::= $\epsilon$ | @^* } + \syntax{@^* ::= $\epsilon$ @! @^* } \end{quote} \item @^+ means a sequence of one or more @s: \begin{quote} @@ -182,7 +182,7 @@ unusual notation in order to make the presentation easier to read. \item @ means a sequence of one or more @s separated by commas: \begin{quote} - \syntax{ ::= | "," } + \syntax{ ::= @! "," } \end{quote} \end{itemize} @@ -611,31 +611,29 @@ All of these have their usual C meanings. \subsubsection{Declarators} \label{sec:syntax.c-types.declarator} \begin{grammar} - ::= - @^* @^* +$[k]$ ::= @^* $[k]$ - ::= | -\alt "(" ")" - - ::= "." +$[k]$ ::= $k$ +\alt "(" $[k]$ ")" +\alt $[k]$ @^* ::= "*" @^* ::= "[" "]" \alt "(" ")" - ::= | "..." + ::= $\epsilon$ | "..." \alt @["," "..."@] ::= @^+ - ::= | @[@] + ::= @[ @! $\epsilon$@] + + ::= @[@] - ::= - @^+ | @^* + ::= "." - ::= "(" ")" -\alt @[@] @^+ + ::= @[@] \end{grammar} The declarator syntax is taken from C, but with some differences. diff --git a/doc/standard-method-combination.svg b/doc/standard-method-combination.svg index c54f546..f2ca2f3 100644 --- a/doc/standard-method-combination.svg +++ b/doc/standard-method-combination.svg @@ -182,7 +182,7 @@ id="text7219" y="743.74951" x="137.82718" - style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;font-family:Palladio Uralic;-inkscape-font-specification:Palladio Uralic" + style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;font-family:URW Palladio L;-inkscape-font-specification:URW Palladio L" xml:space="preserve"> ~A.~A._vt = &~A;~:^~% ~} return (p); }~2%" class @@ -113,15 +113,13 @@ static void *~A__imprint(void *p) (format nil "~A__init" class) ;; FIXME this needs a metaobject protocol - (let ((ilayout (sod-class-ilayout class))) + (let ((ilayout (sod-class-ilayout class)) + (used nil)) (format stream "~&~: -static void *~A__init(void *p) -{ - struct ~A *sod__obj = ~0@*~A__imprint(p);~2%" - class - (ilayout-struct-tag class)) +/* Provide initial values for an instance's slots. */ +static void *~A__init(void *p)~%{~%" class) (dolist (ichain (ilayout-ichains ilayout)) - (let ((ich (format nil "sod__obj.~A.~A" + (let ((ich (format nil "sod__obj->~A.~A" (sod-class-nickname (ichain-head ichain)) (sod-class-nickname (ichain-tail ichain))))) (dolist (item (ichain-body ichain)) @@ -136,6 +134,13 @@ static void *~A__init(void *p) (let ((dslot (effective-slot-direct-slot slot)) (init (effective-slot-initializer slot))) (when init + (unless used + (format stream + " struct ~A *sod__obj = ~ + ~0@*~A__imprint(p);~2%" + class + (ilayout-struct-tag class)) + (setf used t)) (format stream " ~A.~A =" isl (sod-slot-name dslot)) (ecase (sod-initializer-value-kind init) @@ -149,6 +154,8 @@ static void *~A__init(void *p) :stream stream :pretty nil :escape nil) (format stream "};~%")))))))))))) + (unless used + (format stream " ~A__imprint(p);~%" class)) (format stream "~&~: return (p); }~2%"))) @@ -246,6 +253,11 @@ static const SodClass *const ~A__cpl[] = { ;;; Bootstrapping the class graph. (defun bootstrap-classes (module) + "Bootstrap the braid in MODULE. + + This builds the fundamental recursive braid, where `SodObject' is an + instance of `SodClass', and `SodClass' is a subclass of `SodObject' (and + an instance of itself)." (let* ((sod-object (make-sod-class "SodObject" nil (make-property-set :nick 'obj))) (sod-class (make-sod-class "SodClass" (list sod-object) @@ -277,30 +289,41 @@ static const SodClass *const ~A__cpl[] = { (finalize-sod-class class) (add-to-module module class)))) +(defvar *builtin-module* nil + "The builtin module.") + (defun make-builtin-module () + "Construct the builtin module. + + This involves constructing the braid (which is done in `bootstrap-classes' + and defining a few obvious type names which users will find handy. + + Returns the newly constructed module, and stores it in the variable + `*builtin-module*'." (let ((module (make-instance 'module :name (make-pathname :name "SOD-BASE" :type "SOD" :case :common) - :state nil)) - (include (format nil "#include \"~A\"~%" - (make-pathname :name "SOD" :type "H" - :case :common)))) + :state nil))) (call-with-module-environment (lambda () (dolist (name '("va_list" "size_t" "ptrdiff_t")) (add-to-module module (make-instance 'type-item :name name))) - (add-to-module module (make-instance 'code-fragment-item - :reason :c - :constraints nil - :name :includes - :fragment include)) + (flet ((header-name (name) + (concatenate 'string "\"" (string-downcase name) ".h\"")) + (add-includes (reason &rest names) + (let ((text (with-output-to-string (out) + (dolist (name names) + (format out "#include ~A~%" name))))) + (add-to-module module + (make-instance 'code-fragment-item + :reason reason + :constraints nil + :name :includes + :fragment text))))) + (add-includes :c (header-name "sod")) + (add-includes :h "")) (bootstrap-classes module))) - module)) - -(defvar *builtin-module* nil) - -(define-clear-the-decks reset-builtin-module - (setf *builtin-module* (make-builtin-module))) + (setf *builtin-module* module))) ;;;----- That's all, folks -------------------------------------------------- diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp index e3ac625..5f2e438 100644 --- a/src/c-types-parse.lisp +++ b/src/c-types-parse.lisp @@ -290,7 +290,7 @@ ;;; `parse-declarator' will be of this form. (export 'parse-declarator) -(defun parse-declarator (scanner base-type &key centre abstractp) +(defun parse-declarator (scanner base-type &key kernel abstractp) "Parse a C declarator, returning a pair (C-TYPE . NAME). The SCANNER is a token scanner to read from. The BASE-TYPE is the type @@ -299,16 +299,16 @@ The result contains both the resulting constructed C-TYPE (with any qualifiers etc. as necessary), and the name from the middle of the - declarator. The name is parsed using the CENTRE parser provided, and + declarator. The name is parsed using the KERNEL parser provided, and defaults to matching a simple identifier `:id'. This might, e.g., be (? :id) to parse an `abstract declarator' which has optional names. - There's an annoying ambiguity in the syntax, if an empty CENTRE is + There's an annoying ambiguity in the syntax, if an empty KERNEL is permitted. In this case, you must ensure that ABSTRACTP is true so that the appropriate heuristic can be applied. As a convenience, if ABSTRACTP - is true then `(? :id)' is used as the default CENTRE." + is true then `(? :id)' is used as the default KERNEL." (with-parser-context (token-scanner-context :scanner scanner) - (let ((centre-parser (cond (centre centre) + (let ((kernel-parser (cond (kernel kernel) (abstractp (parser () (? :id))) (t (parser () :id))))) @@ -362,8 +362,8 @@ (values t t nil)))) (lparen #\)))))) - (centre () - (parse (seq ((name (funcall centre-parser))) + (kernel () + (parse (seq ((name (funcall kernel-parser))) (cons #'identity name)))) (argument-list () @@ -408,7 +408,7 @@ (parse (seq ((value (expr (:nestedp nestedp) ;; An actual operand. - (centre) + (kernel) ;; Binary operators. There aren't any. nil diff --git a/src/c-types-test.lisp b/src/c-types-test.lisp index 0eadfe6..a1095db 100644 --- a/src/c-types-test.lisp +++ b/src/c-types-test.lisp @@ -294,6 +294,6 @@ int ftw(const char */*dirpath*/, (c-type (func (* (func void (nil int))) (nil int) (nil (* (func void (nil int)))))) - "signal"))) + "signal")) ;;;----- That's all, folks -------------------------------------------------- diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp index 2e66fa1..68c989b 100644 --- a/src/class-layout-impl.lisp +++ b/src/class-layout-impl.lisp @@ -68,9 +68,9 @@ ((slot sod-class-slot) slot-names &key pset) (declare (ignore slot-names)) (default-slot (slot 'initializer-function) - (get-property pset :initializer-function t nil)) + (get-property pset :initializer-function :func nil)) (default-slot (slot 'prepare-function) - (get-property pset :prepare-function t nil))) + (get-property pset :prepare-function :func nil))) (export 'sod-class-effective-slot) (defclass sod-class-effective-slot (effective-slot) diff --git a/src/module-output.lisp b/src/module-output.lisp index b093b82..f04bdd6 100644 --- a/src/module-output.lisp +++ b/src/module-output.lisp @@ -78,8 +78,7 @@ stream (make-instance 'position-aware-output-stream :stream stream - :file (or (stream-pathname stream) - #p""))))) + :file (stream-pathname stream))))) (hook-output module reason sequencer) (invoke-sequencer-items sequencer stream))) diff --git a/src/module-parse.lisp b/src/module-parse.lisp index 5d26760..2fa13f1 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -183,7 +183,7 @@ ;; names. (parse-declarator scanner base-type - :centre (parser () + :kernel (parser () (seq ((name-a :id) (name-b (? (seq (#\. (id :id)) id)))) (if name-b (cons name-a name-b) diff --git a/src/output-impl.lisp b/src/output-impl.lisp index 30d0c80..df42115 100644 --- a/src/output-impl.lisp +++ b/src/output-impl.lisp @@ -35,8 +35,7 @@ (defmethod ensure-sequencer-item ((sequencer sequencer) name) (with-slots (table) sequencer (or (gethash name table) - (setf (gethash name table) - (make-instance 'sequencer-item :name name))))) + (setf (gethash name table) (make-sequencer-item name))))) (defmethod add-sequencer-constraint ((sequencer sequencer) (constraint list)) (let ((converted-constraint diff --git a/src/parser/streams-proto.lisp b/src/parser/streams-proto.lisp index 141d0bc..d21b109 100644 --- a/src/parser/streams-proto.lisp +++ b/src/parser/streams-proto.lisp @@ -38,7 +38,7 @@ ;; Provide some default methods. Most streams don't have a pathname. ;; File-based streams provide a pathname, but it's usually been merged with - ;; *DEFAULT-PATHNAME-DEFAULTS* or some such, which has made it absolute, + ;; `*default-pathname-defaults*' or some such, which has made it absolute, ;; which isn't ideal. We'll hack around this in more useful classes later. (:method ((stream stream)) nil) (:method ((stream file-stream)) (pathname stream))) diff --git a/src/pset-proto.lisp b/src/pset-proto.lisp index 91668ed..e98c908 100644 --- a/src/pset-proto.lisp +++ b/src/pset-proto.lisp @@ -70,7 +70,8 @@ (:method ((raw string)) (values :string raw)) (:method ((raw character)) (values :char raw)) (:method ((raw property)) (values (p-type raw) (p-value raw))) - (:method ((raw cons)) (values (car raw) (cdr raw)))) + (:method ((raw cons)) (values (car raw) (cdr raw))) + (:method ((raw function)) (values :func raw))) (export 'make-property) (defun make-property (name raw-value &key type location seenp) @@ -224,7 +225,10 @@ Otherwise the value is coerced to the right kind of thing (where possible) and returned. - If PSET is nil, then return DEFAULT." + The file location at which the property was defined is returned as a + second value. + + If PSET is nil, then return DEFAULT and nil." (let ((prop (and pset (pset-get pset (property-key name))))) (with-default-error-location ((and prop (p-location prop))) diff --git a/src/sod.asd b/src/sod.asd index 0b7f6a7..d295c08 100644 --- a/src/sod.asd +++ b/src/sod.asd @@ -122,10 +122,12 @@ (:file "module-proto" :depends-on ("package")) (:file "module-impl" :depends-on ("module-proto" "pset-proto" "c-types-class-impl" "builtin")) - (:file "builtin" :depends-on ("module-proto" "pset-proto" "classes" - "c-types-impl" "c-types-class-impl")) + (:file "builtin" :depends-on + ("module-proto" "pset-proto" "c-types-impl" "c-types-class-impl" + "classes" "class-layout-proto")) (:file "module-parse" :depends-on - ("module-impl" "lexer-proto" "fragment-parse")) + ("class-make-proto" "class-finalize-proto" + "fragment-parse" "lexer-proto" "module-impl")) (:file "module-output" :depends-on ("module-impl" "output-proto")) ;; Output. -- 2.11.0