X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1d8cc67a3f4ded443f5efc673a616883cbae9c50..9ec578d9fe450b7e7f9030dc9d930185593aa991:/src/module-parse.lisp

diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index 2fa13f1..df4ea27 100644
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -28,8 +28,6 @@
 ;;;--------------------------------------------------------------------------
 ;;; Toplevel syntax.
 
-(export 'module)
-
 ;;; Type names.
 
 (define-pluggable-parser module typename (scanner pset)
@@ -56,26 +54,30 @@
   ;; constraint ::= id+
   (declare (ignore pset))
   (with-parser-context (token-scanner-context :scanner scanner)
-    (parse (seq ("code"
-		 (reason :id)
-		 #\:
-		 (name :id)
-		 (constraints (? (seq (#\[
-				       (constraints (list (:min 1)
-						      (list (:min 1) :id)
-						      #\,))
-				       #\])
-				   constraints)))
-		 (fragment (parse-delimited-fragment scanner #\{ #\})))
-	     (add-to-module *module* (make-instance 'code-fragment-item
-						    :fragment fragment
-						    :constraints constraints
-						    :reason reason
-						    :name name))))))
+    (flet ((kw ()
+	     (parse (seq ((kw :id)) (intern (string-upcase kw) 'keyword)))))
+      (parse (seq ("code"
+		   (reason (kw))
+		   #\:
+		   (name (kw))
+		   (constraints (? (seq (#\[
+					 (constraints (list (:min 1)
+							(list (:min 1) (kw))
+							#\,))
+					 #\])
+				     constraints)))
+		   (fragment (parse-delimited-fragment scanner #\{ #\})))
+	       (add-to-module *module*
+			      (make-instance 'code-fragment-item
+					     :fragment fragment
+					     :constraints constraints
+					     :reason reason
+					     :name name)))))))
 
 ;;; External files.
 
-(defun read-module (pathname &key (truename (truename pathname)) location)
+(export 'read-module)
+(defun read-module (pathname &key (truename nil truep) location)
   "Parse the file at PATHNAME as a module, returning it.
 
    This is the main entry point for parsing module files.  You may well know
@@ -86,6 +88,9 @@
    `file-location' object, though it might be anything other than `t' which
    can be printed in the event of circular imports."
 
+  (setf pathname (merge-pathnames pathname
+				  (make-pathname :type "SOD" :case :common)))
+  (unless truep (setf truename (truename pathname)))
   (define-module (pathname :location location :truename truename)
     (with-open-file (f-stream pathname :direction :input)
       (let* ((*readtable* (copy-readtable))
@@ -212,13 +217,46 @@
 		 ;;
 		 ;; Return (VALUE-KIND . VALUE-FORM), ready for passing to a
 		 ;; `sod-initializer' constructor.
-		 (parse (or (peek (seq (#\= (frag (parse-delimited-fragment
-						   scanner #\{ #\})))
-				    (cons :compound frag)))
-			    (seq ((frag (parse-delimited-fragment
-					 scanner #\= '(#\; #\,)
-					 :keep-end t)))
-			      (cons :simple frag)))))
+
+		 ;; This is kind of tricky because we have to juggle both
+		 ;; layers of the parsing machinery.  The character scanner
+		 ;; will already have consumed the lookahead token (which, if
+		 ;; we're going to do anything, is `=').
+		 (let ((char-scanner (token-scanner-char-scanner scanner)))
+
+		   ;; First, skip the character-scanner past any whitespace.
+		   ;; We don't record this consumption, which is a bit
+		   ;; naughty, but nobody will actually mind.
+		   (loop
+		     (when (or (scanner-at-eof-p char-scanner)
+			       (not (whitespace-char-p
+				     (scanner-current-char char-scanner))))
+		       (return))
+		     (scanner-step char-scanner))
+
+		   ;; Now maybe read an initializer.
+		   (cond ((not (eql (token-type scanner) #\=))
+			  ;; It's not an `=' after all.  There's no
+			  ;; initializer.
+			  (values '(#\=) nil nil))
+
+			 ((and (not (scanner-at-eof-p char-scanner))
+			       (char= (scanner-current-char char-scanner)
+				      #\{))
+			  ;; There's a brace after the `=', so we should
+			  ;; consume the `=' here, and read a compound
+			  ;; initializer enclosed in braces.
+			  (parse (seq (#\= (frag (parse-delimited-fragment
+						  scanner #\{ #\})))
+				   (cons :compound frag))))
+
+			 (t
+			  ;; No brace, so read from the `=' up to, but not
+			  ;; including, the trailing `,' or `;' delimiter.
+			  (parse (seq ((frag (parse-delimited-fragment
+					      scanner #\= '(#\; #\,)
+					      :keep-end t)))
+				   (cons :simple frag)))))))
 
 	       (parse-slot-item (sub-pset base-type type name)
 		 ;; slot-item ::=
@@ -297,13 +335,13 @@
 		 ;; (which might be dotted).  So we parse that here and
 		 ;; dispatch based on what we find.
 		 (parse (or (plug class-item scanner class sub-pset)
-			    (peek
+			    ;(peek
 			     (seq ((ds (parse-c-type scanner))
 				   (dc (parse-maybe-dotted-declarator ds))
 				   (nil (class-item-dispatch sub-pset
 							     ds
 							     (car dc)
-							     (cdr dc))))))
+							     (cdr dc)))));)
 			    (and "class"
 				 (parse-initializer-item
 				  sub-pset
@@ -315,10 +353,9 @@
 	(parse (seq (#\{
 		     (nil (skip-many ()
 			    (seq ((sub-pset (parse-property-set scanner))
-				  (nil (error ()
-					      (parse-raw-class-item sub-pset))))
+				  (nil (parse-raw-class-item sub-pset)))
 			      (check-unused-properties sub-pset))))
-		     #\})
+		     (nil (error () #\})))
 		 (finalize-sod-class class)
 		 (add-to-module *module* class)))))))