Static instance support.

[sod] / src / module-parse.lisp

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index 8344281..eff4af7 100644 (file)
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -217,6 +217,60 @@
             (eval sexp)))))
 
 ;;;--------------------------------------------------------------------------
+;;; Static instances.
+
+(define-pluggable-parser module instance (scanner pset)
+  ;; `instance' id id list[slot-initializer] `;'
+  (with-parser-context (token-scanner-context :scanner scanner)
+    (let ((duff nil)
+         (floc nil)
+         (empty-pset (make-property-set)))
+      (parse (seq ("instance"
+                  (class (seq ((class-name (must :id)))
+                           (setf floc (file-location scanner))
+                           (restart-case (find-sod-class class-name)
+                             (continue ()
+                               (setf duff t)
+                               nil))))
+                  (name (must :id))
+                  (inits (? (seq (#\:
+                                  (inits (list (:min 0)
+                                           (seq ((nick (must :id))
+                                                 #\.
+                                                 (name (must :id))
+                                                 (value
+                                                  (parse-delimited-fragment
+                                                   scanner #\= '(#\, #\;)
+                                                   :keep-end t)))
+                                             (make-sod-instance-initializer
+                                              class nick name value
+                                              empty-pset
+                                              :add-to-class nil
+                                              :location scanner))
+                                           #\,)))
+                              inits)))
+                  #\;)
+              (unless duff
+                (acond ((find-if (lambda (item)
+                                   (and (typep item 'static-instance)
+                                        (string= (static-instance-name item)
+                                                 name)))
+                                 (module-items *module*))
+                        (cerror*-with-location floc
+                                               "Instance with name `~A' ~
+                                                already defined."
+                                               name)
+                        (info-with-location (file-location it)
+                                            "Previous definition was ~
+                                             here."))
+                       (t
+                        (add-to-module *module*
+                                       (make-static-instance class name
+                                                             inits
+                                                             pset
+                                                             floc))))))))))
+
+;;;--------------------------------------------------------------------------
 ;;; Class declarations.
 
 (export 'class-item)