chiark - git - mdw - sod/blob - module.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Modules and module parser
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Simple Object Definition system.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Module basics.
  30
  31 (defclass module ()
  32   ((name :initarg :name :type pathname :reader module-name)
  33    (pset :initarg :pset :initform (make-pset) :type pset :reader module-pset)
  34    (items :initarg :items :initform nil :type list :accessor module-items)
  35    (dependencies :initarg :dependencies :initform nil
  36                  :type list :accessor module-dependencies)
  37    (state :initarg :state :initform nil :accessor module-state))
  38   (:documentation
  39    "A module is a container for the definitions made in a source file.
  40
  41    Modules are the fundamental units of translation.  The main job of a
  42    module is to remember which definitions it contains, so that they can be
  43    translated and written to output files.  The module contains the following
  44    handy bits of information:
  45
  46      * A (path) name, which is the filename we used to find it.  The default
  47        output filenames are derived from this.  (We use the file's truename
  48        as the hash key to prevent multiple inclusion, and that's a different
  49        thing.)
  50
  51      * A property list containing other useful things.
  52
  53      * A list of the classes defined in the source file.
  54
  55      * Lists of C fragments to be included in the output header and C source
  56        files.
  57
  58      * A list of other modules that this one depends on.
  59
  60    Modules are usually constructed by the PARSE-MODULE function, which is in
  61    turn usually invoked by IMPORT-MODULE, though there's nothing to stop
  62    fancy extensions building modules programmatically."))
  63
  64 (defparameter *module* nil
  65   "The current module under construction.
  66
  67    This is always an instance of MODULE.  Once we've finished constructing
  68    it, we'll call CHANGE-CLASS to turn it into an instance of whatever type
  69    is requested in the module's :LISP-CLASS property.")
  70
  71 (defgeneric module-import (object)
  72   (:documentation
  73    "Import definitions into the current environment.
  74
  75    Instructs the OBJECT to import its definitions into the current
  76    environment.  Modules pass the request on to their constituents.  There's
  77    a default method which does nothing at all.
  78
  79    It's not usual to modify the current module.  Inserting things into the
  80    *TYPE-MAP* is a good plan.")
  81   (:method (object) nil))
  82
  83 (defgeneric add-to-module (module item)
  84   (:documentation
  85    "Add ITEM to the MODULE's list of accumulated items.
  86
  87    The module items participate in the MODULE-IMPORT and ADD-OUTPUT-HOOKS
  88    protocols."))
  89
  90 (defgeneric finalize-module (module)
  91   (:documentation
  92    "Finalizes a module, setting everything which needs setting.
  93
  94    This isn't necessary if you made the module by hand.  If you've
  95    constructed it incrementally, then it might be a good plan.  In
  96    particular, it will change the class (using CHANGE-CLASS) of the module
  97    according to the class choice set in the module's :LISP-CLASS property.
  98    This has the side effects of calling SHARED-INITIALIZE, setting the
  99    module's state to T, and checking for unrecognized properties.  (Therefore
 100    subclasses should add a method to SHARED-INITIALIZE should take care of
 101    looking at interesting properties, just to make sure they're ticked
 102    off.)"))
 103
 104 (defmethod module-import ((module module))
 105   (dolist (item (module-items module))
 106     (module-import item)))
 107
 108 (defmethod add-to-module ((module module) item)
 109   (setf (module-items module)
 110         (nconc (module-items module) (list item)))
 111   (module-import item))
 112
 113 (defmethod shared-initialize :after ((module module) slot-names &key pset)
 114   "Tick off known properties on the property set."
 115   (declare (ignore slot-names))
 116   (when pset
 117     (dolist (prop '(:guard))
 118       (get-property pset prop nil))))
 119
 120 (defmethod finalize-module ((module module))
 121   (let* ((pset (module-pset module))
 122          (class (get-property pset :lisp-class :symbol 'module)))
 123
 124     ;; Always call CHANGE-CLASS, even if it's the same one; this will
 125     ;; exercise the property-set fiddling in SHARED-INITIALIZE and we can
 126     ;; catch unknown-property errors.
 127     (change-class module class :state t :pset pset)
 128     (check-unused-properties pset)
 129     module))
 130
 131 ;;;--------------------------------------------------------------------------
 132 ;;; Module importing.
 133
 134 (defun build-module
 135     (name body-func &key (truename (probe-file name)) location)
 136   (let ((*module* (make-instance 'module
 137                                  :name (pathname name)
 138                                  :state (file-location location)))
 139         (*type-map* (make-hash-table :test #'equal)))
 140     (module-import *builtin-module*)
 141     (when truename
 142       (setf (gethash truename *module-map*) *module*))
 143     (unwind-protect
 144          (progn
 145            (funcall body-func)
 146            (finalize-module *module*))
 147       (when (and truename (not (eq (module-state *module*) t)))
 148         (remhash truename *module-map*)))))
 149
 150 (defmacro define-module
 151     ((name &key (truename nil truenamep) (location nil locationp))
 152      &body body)
 153   `(build-module ,name
 154                  (lambda () ,@body)
 155                  ,@(and truenamep `(:truename ,truename))
 156                  ,@(and locationp `(:location ,location))))
 157
 158 (defun read-module (pathname &key (truename (truename pathname)) location)
 159   "Reads a module.
 160
 161    The module is returned if all went well; NIL is returned if an error
 162    occurred.
 163
 164    The PATHNAME argument is the file to read.  TRUENAME should be the file's
 165    truename, if known: often, the file will have been searched for using
 166    PROBE-FILE or similar, which drops the truename into your lap."
 167
 168   ;; Deal with a module which is already in the map.  If its state is a
 169   ;; FILE-LOCATION then it's in progress and we have a cyclic dependency.
 170   (let ((module (gethash truename *module-map*)))
 171     (cond ((null module))
 172           ((typep (module-state module) 'file-location)
 173            (error "Module ~A already being imported at ~A"
 174                   pathname (module-state module)))
 175           (module
 176            (return-from read-module module))))
 177
 178   ;; Make a new module.  Be careful to remove the module from the map if we
 179   ;; didn't succeed in constructing it.
 180   (define-module (pathname :location location :truename truename)
 181     (let ((*readtable* (copy-readtable)))
 182       (with-open-file (f-stream pathname :direction :input)
 183         (let* ((pai-stream (make-instance 'position-aware-input-stream
 184                                           :stream f-stream
 185                                           :file pathname))
 186                (lexer (make-instance 'sod-lexer :stream pai-stream)))
 187           (with-default-error-location (lexer)
 188             (next-char lexer)
 189             (next-token lexer)
 190             (parse-module lexer)))))))
 191
 192 ;;;--------------------------------------------------------------------------
 193 ;;; Module parsing protocol.
 194
 195 (defgeneric parse-module-declaration (tag lexer pset)
 196   (:method (tag lexer pset)
 197     (error "Unexpected module declaration ~(~A~)" tag))
 198   (:method :before (tag lexer pset)
 199     (next-token lexer)))
 200
 201 (defun parse-module (lexer)
 202   "Main dispatching for module parser.
 203
 204    Calls PARSE-MODULE-DECLARATION for the identifiable declarations."
 205
 206   (loop
 207     (restart-case
 208         (case (token-type lexer)
 209           (:eof (return))
 210           (#\; (next-token lexer))
 211           (t (let ((pset (parse-property-set lexer)))
 212                (case (token-type lexer)
 213                  (:id (let ((tag (intern (frob-case (token-value lexer))
 214                                          :keyword)))
 215                         (parse-module-declaration tag lexer pset)
 216                         (check-unused-properties pset)))
 217                  (t (error "Unexpected token ~A: ignoring"
 218                            (format-token lexer)))))))
 219       (continue ()
 220         :report "Ignore the error and continue parsing."
 221         nil))))
 222
 223 ;;;--------------------------------------------------------------------------
 224 ;;; Type definitions.
 225
 226 (defclass type-item ()
 227   ((name :initarg :name :type string :reader type-name))
 228   (:documentation
 229    "A note that a module exports a type.
 230
 231    We can only export simple types, so we only need to remember the name.
 232    The magic simple-type cache will ensure that we get the same type object
 233    when we do the import."))
 234
 235 (defmethod module-import ((item type-item))
 236   (let* ((name (type-name item))
 237          (def (gethash name *type-map*))
 238          (type (make-simple-type name)))
 239     (cond ((not def)
 240            (setf (gethash name *type-map*) type))
 241           ((not (eq def type))
 242            (error "Conflicting types `~A'" name)))))
 243
 244 (defmethod module-import ((class sod-class))
 245   (record-sod-class class))
 246
 247 (defmethod parse-module-declaration ((tag (eql :typename)) lexer pset)
 248   "module-decl ::= `typename' id-list `;'"
 249   (loop (let ((name (require-token lexer :id)))
 250           (unless name (return))
 251           (if (gethash name *type-map*)
 252               (cerror* "Type `~A' already defined" name)
 253               (add-to-module *module* (make-instance 'type-item :name name)))
 254           (unless (require-token lexer #\, :errorp nil) (return))))
 255   (require-token lexer #\;))
 256
 257 ;;;--------------------------------------------------------------------------
 258 ;;; Fragments.
 259
 260 (defclass code-fragment-item ()
 261   ((fragment :initarg :fragment :type c-fragment :reader code-fragment)
 262    (reason :initarg :reason :type keyword :reader code-fragment-reason)
 263    (name :initarg :name :type t :reader code-fragment-name)
 264    (constraints :initarg :constraints :type list
 265                 :reader code-fragment-constraints))
 266   (:documentation
 267    "A plain fragment of C to be dropped in at top-level."))
 268
 269 (defmacro define-fragment ((reason name) &body things)
 270   (categorize (thing things)
 271       ((constraints (listp thing))
 272        (frags (typep thing '(or string c-fragment))))
 273     (when (null frags)
 274       (error "Missing code fragment"))
 275     (when (cdr frags)
 276       (error "Multiple code fragments"))
 277     `(add-to-module
 278       *module*
 279       (make-instance 'code-fragment-item
 280                      :fragment ',(car frags)
 281                      :name ,name
 282                      :reason ,reason
 283                      :constraints (list ,@(mapcar (lambda (constraint)
 284                                                     (cons 'list constraint))
 285                                                   constraints))))))
 286
 287 (defmethod parse-module-declaration ((tag (eql :code)) lexer pset)
 288   "module-decl ::= `code' id `:' id [constraint-list] `{' c-fragment `}'
 289    constraint ::= id*"
 290   (labels ((parse-constraint ()
 291              (let ((list nil))
 292                (loop (let ((id (require-token lexer :id
 293                                               :errorp (null list))))
 294                        (unless id (return))
 295                        (push id list)))
 296                (nreverse list)))
 297            (parse-constraints ()
 298              (let ((list nil))
 299                (when (require-token lexer #\[ :errorp nil)
 300                  (loop (let ((constraint (parse-constraint)))
 301                          (push constraint list)
 302                          (unless (require-token lexer #\, :errorp nil)
 303                            (return))))
 304                  (require-token lexer #\]))
 305                (nreverse list)))
 306            (keywordify (id)
 307              (and id (intern (substitute #\- #\_ (frob-case id)) :keyword))))
 308     (let* ((reason (prog1 (keywordify (require-token lexer :id))
 309                    (require-token lexer #\:)))
 310            (name (keywordify (require-token lexer :id)))
 311            (constraints (parse-constraints)))
 312       (when (require-token lexer #\{ :consumep nil)
 313         (let ((frag (scan-c-fragment lexer '(#\}))))
 314           (next-token lexer)
 315           (require-token lexer #\})
 316           (add-to-module *module*
 317                          (make-instance 'code-fragment-item
 318                                         :name name
 319                                         :reason reason
 320                                         :constraints constraints
 321                                         :fragment frag)))))))
 322
 323 ;;;--------------------------------------------------------------------------
 324 ;;; File searching.
 325
 326 (defparameter *module-dirs* nil
 327   "A list of directories (as pathname designators) to search for files.
 328
 329    Both SOD module files and Lisp extension files are searched for in this
 330    list.  The search works by merging the requested pathname with each
 331    element of this list in turn.  The list is prefixed by the pathname of the
 332    requesting file, so that it can refer to other files relative to wherever
 333    it was found.
 334
 335    See FIND-FILE for the grubby details.")
 336
 337 (defun find-file (lexer name what thunk)
 338   "Find a file called NAME on the module search path, and call THUNK on it.
 339
 340    The file is searched for relative to the LEXER's current file, and also in
 341    the directories mentioned in the *MODULE-DIRS* list.  If the file is
 342    found, then THUNK is invoked with two arguments: the name we used to find
 343    it (which might be relative to the starting directory) and the truename
 344    found by PROBE-FILE.
 345
 346    If the file wasn't found, or there was some kind of error, then an error
 347    is signalled; WHAT should be a noun phrase describing the kind of thing we
 348    were looking for, suitable for inclusion in the error message.
 349
 350    While FIND-FILE establishes condition handlers for its own purposes, THUNK
 351    is not invoked with any additional handlers defined."
 352
 353   (handler-case
 354       (dolist (dir (cons (stream-pathname (lexer-stream lexer))
 355                          *module-dirs*)
 356                (values nil nil))
 357         (let* ((path (merge-pathnames name dir))
 358                (probe (probe-file path)))
 359           (when probe
 360             (return (values path probe)))))
 361     (file-error (error)
 362       (error "Error searching for ~A ~S: ~A" what (namestring name) error))
 363     (:no-error (path probe)
 364       (cond ((null path)
 365              (error "Failed to find ~A ~S" what (namestring name)))
 366             (t
 367              (funcall thunk path probe))))))
 368
 369 (defmethod parse-module-declaration ((tag (eql :import)) lexer pset)
 370   "module-decl ::= `import' string `;'"
 371   (let ((name (require-token lexer :string)))
 372     (when name
 373       (find-file lexer
 374                  (merge-pathnames name
 375                                   (make-pathname :type "SOD" :case :common))
 376                  "module"
 377                  (lambda (path true)
 378                    (handler-case
 379                        (let ((module (read-module path :truename true)))
 380                          (when module
 381                            (module-import module)
 382                            (pushnew module (module-dependencies *module*))))
 383                      (file-error (error)
 384                        (cerror* "Error reading module ~S: ~A"
 385                                 path error)))))
 386       (require-token lexer #\;))))
 387
 388 (defmethod parse-module-declaration ((tag (eql :load)) lexer pset)
 389   "module-decl ::= `load' string `;'"
 390   (let ((name (require-token lexer :string)))
 391     (when name
 392       (find-file lexer
 393                  (merge-pathnames name
 394                                   (make-pathname :type "LISP" :case :common))
 395                  "Lisp file"
 396                  (lambda (path true)
 397                    (handler-case (load true :verbose nil :print nil)
 398                      (error (error)
 399                        (cerror* "Error loading Lisp file ~S: ~A"
 400                                 path error)))))
 401       (require-token lexer #\;))))
 402
 403 ;;;--------------------------------------------------------------------------
 404 ;;; Lisp escapes.
 405
 406 (defmethod parse-module-declaration :around ((tag (eql :lisp)) lexer pset)
 407   "module-decl ::= `lisp' s-expression `;'"
 408   (let ((form (with-lexer-stream (stream lexer) (read stream t))))
 409     (eval form))
 410   (next-token lexer)
 411   (require-token lexer #\;))
 412
 413 ;;;--------------------------------------------------------------------------
 414 ;;; Class declarations.
 415
 416 (defmethod parse-module-declaration ((tag (eql :class)) lexer pset)
 417   "module-decl ::= `class' id [`:' id-list] `{' class-item* `}'"
 418   (let* ((location (file-location lexer))
 419          (name (let ((name (require-token lexer :id)))
 420                  (make-class-type name location)
 421                  (when (require-token lexer #\; :errorp nil)
 422                    (return-from parse-module-declaration))
 423                  name))
 424          (supers (when (require-token lexer #\: :errorp nil)
 425                    (let ((list nil))
 426                      (loop (let ((id (require-token lexer :id)))
 427                              (unless id (return))
 428                              (push id list)
 429                              (unless (require-token lexer #\, :errorp nil)
 430                                (return))))
 431                      (nreverse list))))
 432          (class (make-sod-class name (mapcar #'find-sod-class supers)
 433                                 pset location))
 434          (nick (sod-class-nickname class)))
 435     (require-token lexer #\{)
 436
 437     (labels ((parse-item ()
 438                "Try to work out what kind of item this is.  Messy."
 439                (let* ((pset (parse-property-set lexer))
 440                       (location (file-location lexer)))
 441                  (cond ((declaration-specifier-p lexer)
 442                         (let ((declspec (parse-c-type lexer)))
 443                           (multiple-value-bind (type name)
 444                               (parse-c-declarator lexer declspec :dottedp t)
 445                             (cond ((null type)
 446                                    nil)
 447                                   ((consp name)
 448                                    (parse-method type (car name) (cdr name)
 449                                                  pset location))
 450                                   ((typep type 'c-function-type)
 451                                    (parse-message type name pset location))
 452                                   (t
 453                                    (parse-slots declspec type name
 454                                                 pset location))))))
 455                        ((not (eq (token-type lexer) :id))
 456                         (cerror* "Expected <class-item>; found ~A (skipped)"
 457                                  (format-token lexer))
 458                         (next-token lexer))
 459                        ((string= (token-value lexer) "class")
 460                         (next-token lexer)
 461                         (parse-initializers #'make-sod-class-initializer
 462                                             pset location))
 463                        (t
 464                         (parse-initializers #'make-sod-instance-initializer
 465                                             pset location)))))
 466
 467              (parse-method (type nick name pset location)
 468                "class-item ::= declspec+ dotted-declarator -!- method-body
 469
 470                 method-body ::= `{' c-fragment `}' | `extern' `;'
 471
 472                 The dotted-declarator must describe a function type."
 473                (let ((body (cond ((eq (token-type lexer) #\{)
 474                                   (prog1 (scan-c-fragment lexer '(#\}))
 475                                     (next-token lexer)
 476                                     (require-token lexer #\})))
 477                                  ((and (eq (token-type lexer) :id)
 478                                        (string= (token-value lexer)
 479                                                 "extern"))
 480                                   (next-token lexer)
 481                                   (require-token lexer #\;)
 482                                   nil)
 483                                  (t
 484                                   (cerror* "Expected <method-body>; ~
 485                                             found ~A"
 486                                            (format-token lexer))))))
 487                  (make-sod-method class nick name type body pset location)))
 488
 489              (parse-message (type name pset location)
 490                "class-item ::= declspec+ declarator -!- (method-body | `;')
 491
 492                 The declarator must describe a function type."
 493                (make-sod-message class name type pset location)
 494                (unless (require-token lexer #\; :errorp nil)
 495                  (parse-method type nick name nil location)))
 496
 497              (parse-initializer-body ()
 498                "initializer ::= `=' `{' c-fragment `}' | `=' c-fragment"
 499                (let ((char (lexer-char lexer)))
 500                  (loop
 501                    (when (or (null char) (not (whitespace-char-p char)))
 502                      (return))
 503                    (setf char (next-char lexer)))
 504                  (cond ((eql char #\{)
 505                         (next-char lexer)
 506                         (let ((frag (scan-c-fragment lexer '(#\}))))
 507                           (next-token lexer)
 508                           (require-token lexer #\})
 509                           (values :compound frag)))
 510                        (t
 511                         (let ((frag (scan-c-fragment lexer '(#\, #\;))))
 512                           (next-token lexer)
 513                           (values :simple frag))))))
 514
 515              (parse-slots (declspec type name pset location)
 516                "class-item ::=
 517                   declspec+ init-declarator [`,' init-declarator-list] `;'
 518
 519                 init-declarator ::= declarator -!- [initializer]"
 520                (loop
 521                  (make-sod-slot class name type pset location)
 522                  (when (eql (token-type lexer) #\=)
 523                    (multiple-value-bind (kind form) (parse-initializer-body)
 524                      (make-sod-instance-initializer class nick name
 525                                                     kind form nil
 526                                                     location)))
 527                  (unless (require-token lexer #\, :errorp nil)
 528                    (return))
 529                  (setf (values type name)
 530                        (parse-c-declarator lexer declspec)
 531                        location (file-location lexer)))
 532                (require-token lexer #\;))
 533
 534              (parse-initializers (constructor pset location)
 535                "class-item ::= [`class'] -!- slot-initializer-list `;'
 536
 537                 slot-initializer ::= id `.' id initializer"
 538                (loop
 539                  (let ((nick (prog1 (require-token lexer :id)
 540                                (require-token lexer #\.)))
 541                        (name (require-token lexer :id)))
 542                    (require-token lexer #\=)
 543                    (multiple-value-bind (kind form)
 544                        (parse-initializer-body)
 545                      (funcall constructor class nick name kind form
 546                               pset location)))
 547                  (unless (require-token lexer #\, :errorp nil)
 548                    (return))
 549                  (setf location (file-location lexer)))
 550                (require-token lexer #\;)))
 551
 552       (loop
 553         (when (require-token lexer #\} :errorp nil)
 554           (return))
 555         (parse-item)))
 556
 557     (finalize-sod-class class)
 558     (add-to-module *module* class)))
 559
 560 ;;;--------------------------------------------------------------------------
 561 ;;; Modules.
 562
 563 #+(or)
 564 (defun parse-module (lexer)
 565   "Parse a module from the given LEXER.
 566
 567    The newly constructed module is returned.  This is the top-level parsing
 568    function."
 569
 570   (let ((hfrags nil)
 571         (cfrags nil)
 572         (classes nil)
 573         (plist nil)
 574         (deps nil))
 575
 576     (labels ((fragment (func)
 577                (next-token lexer)
 578                (when (require-token lexer #\{ :consumep nil)
 579                  (let ((frag (scan-c-fragment lexer '(#\}))))
 580                    (next-token lexer)
 581                    (require-token lexer #\})
 582                    (funcall func frag)))))
 583
 584       (tagbody
 585
 586        top
 587          ;; module : empty | module-def module
 588          ;;
 589          ;; Just read module-defs until we reach the end of the file.
 590          (case (token-type lexer)
 591
 592            (:eof
 593             (go done))
 594            (#\;
 595             (next-token lexer)
 596             (go top))
 597
 598            ;; module-def : `lisp' sexp
 599            ;;
 600            ;; Process an in-line Lisp form immediately.
 601            (:lisp
 602
 603             (next-token lexer)
 604             (go top))
 605
 606            ;; module-def : `typename' ids `;'
 607            ;; ids : id | ids `,' id
 608            ;;
 609            ;; Add ids as registered type names.  We don't need to know what
 610            ;; they mean at this level.
 611            (:typename
 612             (next-token lexer)
 613             (loop
 614               (let ((id (require-token lexer :id)))
 615                 (cond ((null id)
 616                        (return))
 617                       ((gethash id *type-map*)
 618                        (cerror* "Type ~A is already defined" id))
 619                       (t
 620                        (setf (gethash id *type-map*)
 621                              (make-instance 'simple-c-type :name id))))
 622                 (unless (eql (token-type lexer) #\,)
 623                   (return))
 624                 (next-token lexer)))
 625             (go semicolon))
 626
 627            ;; module-def : `source' `{' c-stuff `}'
 628            ;; module-def : `header' `{' c-stuff `}'
 629            (:source
 630             (fragment (lambda (frag) (push frag cfrags)))
 631             (go top))
 632            (:header
 633             (fragment (lambda (frag) (push frag hfrags)))
 634             (go top))
 635
 636            ;; Anything else is an error.
 637            (t
 638             (cerror* "Unexpected token ~A ignored" (format-token lexer))
 639             (next-token lexer)
 640             (go top)))
 641
 642        semicolon
 643          ;; Scan a terminating semicolon.
 644          (require-token lexer #\;)
 645          (go top)
 646
 647        done)
 648
 649       ;; Assemble the module and we're done.
 650       (make-instance 'module
 651                      :name (stream-pathname (lexer-stream lexer))
 652                      :plist plist
 653                      :classes classes
 654                      :header-fragments hfrags
 655                      :source-fragments cfrags
 656                      :dependencies deps))))
 657
 658 ;;;----- That's all, folks --------------------------------------------------