Lots more has happened.

[sod] / module.lisp

diff --git a/module.lisp b/module.lisp
index 36b2c85..5d05365 100644 (file)
--- a/module.lisp
+++ b/module.lisp
@@ -131,6 +131,30 @@
 ;;;--------------------------------------------------------------------------
 ;;; Module importing.
 
+(defun build-module
+    (name body-func &key (truename (probe-file name)) location)
+  (let ((*module* (make-instance 'module
+                                :name (pathname name)
+                                :state (file-location location)))
+       (*type-map* (make-hash-table :test #'equal)))
+    (module-import *builtin-module*)
+    (when truename
+      (setf (gethash truename *module-map*) *module*))
+    (unwind-protect
+        (progn
+          (funcall body-func)
+          (finalize-module *module*))
+      (when (and truename (not (eq (module-state *module*) t)))
+       (remhash truename *module-map*)))))
+
+(defmacro define-module
+    ((name &key (truename nil truenamep) (location nil locationp))
+     &body body)
+  `(build-module ,name
+                (lambda () ,@body)
+                ,@(and truenamep `(:truename ,truename))
+                ,@(and locationp `(:location ,location))))
+
 (defun read-module (pathname &key (truename (truename pathname)) location)
   "Reads a module.
 
@@ -152,26 +176,17 @@
 
   ;; Make a new module.  Be careful to remove the module from the map if we
   ;; didn't succeed in constructing it.
-  (let ((*module* (make-instance 'module
-                                :name pathname
-                                :state (file-location location)))
-       (*type-map* (make-hash-table :test #'equal)))
-    (module-import *builtin-module*)
-    (setf (gethash truename *module-map*) *module*)
-    (unwind-protect
-        (with-open-file (f-stream pathname :direction :input)
-          (let* ((*module* (make-instance 'module :name pathname))
-                 (pai-stream (make-instance 'position-aware-input-stream
-                                            :stream f-stream
-                                            :file pathname))
-                 (lexer (make-instance 'sod-lexer :stream pai-stream)))
-            (with-default-error-location (lexer)
-              (next-char lexer)
-              (next-token lexer)
-              (parse-module lexer *module*)
-              (finalize-module *module*))))
-      (unless (eq (module-state *module*) t)
-       (remhash truename *module-map*)))))
+  (define-module (pathname :location location :truename truename)
+    (let ((*readtable* (copy-readtable)))
+      (with-open-file (f-stream pathname :direction :input)
+       (let* ((pai-stream (make-instance 'position-aware-input-stream
+                                         :stream f-stream
+                                         :file pathname))
+              (lexer (make-instance 'sod-lexer :stream pai-stream)))
+         (with-default-error-location (lexer)
+           (next-char lexer)
+           (next-token lexer)
+           (parse-module lexer *module*)))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Module parsing protocol.