X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/944bf9362ff51217b1617f85126d26e821b8aa91..00d59354c311fb28730b7c9b117b0d91aac092cc:/src/module-parse.lisp

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index 8344281..eff4af7 100644
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -216,6 +216,60 @@ (define-pluggable-parser module lisp (scanner pset)
 		 (nil (must #\;)))
 	     (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.