Test to make sure modules cannot import themselves.

1 files changed, 80 insertions, 69 deletions

diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 0580372c1..2d005d450 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -6,6 +6,7 @@
     ["." monad (#+ Monad do)]]
    [control
     ["." try (#+ Try)]
+    ["." exception (#+ exception:)]
     [concurrency
      ["." promise (#+ Promise Resolver) ("#@." monad)]
      ["." stm (#+ Var STM)]]]
@@ -13,7 +14,7 @@
     ["." binary (#+ Binary)]
     ["." bit]
     ["." product]
-    ["." text
+    ["." text ("#@." equivalence)
      ["%" format (#+ format)]]
     [collection
      ["." dictionary (#+ Dictionary)]
@@ -362,6 +363,16 @@
           try.assume
           product.left))
 
+    (exception: #export (module-cannot-import-itself {module Module})
+      (exception.report
+       ["Module" (%.text module)]))
+
+    (def: (verify-no-self-import! module dependencies)
+      (-> Module (List Module) (Try Any))
+      (if (list.any? (text@= module) dependencies)
+        (exception.throw ..module-cannot-import-itself [module])
+        (#try.Success [])))
+
     (def: #export (compile import static expander platform compilation context)
       (All [<type-vars>]
         (-> Import Static Expander <Platform> Compilation <Context> <Return>))
@@ -371,75 +382,75 @@
                                    context}
                                   {(///.Compiler <State+> .Module Any)
                                    (:assume
-                                    ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})]
-        (do (try.with promise.monad)
-          [#let [compiler (..parallel
-                           context
-                           (function (_ import! module-id [archive state] module)
-                             (do (try.with promise.monad)
-                               [#let [state (..set-current-module module state)]
-                                input (context.read (get@ #&file-system platform)
-                                                    import
-                                                    compilation-sources
-                                                    (get@ #static.host-module-extension static)
-                                                    module)]
-                               (loop [[archive state] [archive state]
-                                      compilation (base-compiler (:coerce ///.Input input))
-                                      all-dependencies (: (List Module)
-                                                          (list))]
-                                 (do {@ (try.with promise.monad)}
-                                   [#let [new-dependencies (get@ #///.dependencies compilation)
-                                          all-dependencies (list@compose new-dependencies all-dependencies)
-                                          continue! (:share [<type-vars>]
-                                                            {<Platform>
-                                                             platform}
-                                                            {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
-                                                                 (Action [Archive <State+>]))
-                                                             (:assume
-                                                              recur)})]
-                                    [archive state] (case new-dependencies
-                                                      #.Nil
-                                                      (wrap [archive state])
+                                    ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})
+            compiler (..parallel
+                      context
+                      (function (_ import! module-id [archive state] module)
+                        (do {@ (try.with promise.monad)}
+                          [#let [state (..set-current-module module state)]
+                           input (context.read (get@ #&file-system platform)
+                                               import
+                                               compilation-sources
+                                               (get@ #static.host-module-extension static)
+                                               module)]
+                          (loop [[archive state] [archive state]
+                                 compilation (base-compiler (:coerce ///.Input input))
+                                 all-dependencies (: (List Module)
+                                                     (list))]
+                            (let [new-dependencies (get@ #///.dependencies compilation)
+                                  all-dependencies (list@compose new-dependencies all-dependencies)
+                                  continue! (:share [<type-vars>]
+                                                    {<Platform>
+                                                     platform}
+                                                    {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
+                                                         (Action [Archive <State+>]))
+                                                     (:assume
+                                                      recur)})]
+                              (do @
+                                [[archive state] (case new-dependencies
+                                                   #.Nil
+                                                   (wrap [archive state])
 
-                                                      (#.Cons _)
-                                                      (do @
-                                                        [archive,document+ (|> new-dependencies
-                                                                               (list@map import!)
-                                                                               (monad.seq ..monad))
-                                                         #let [archive (|> archive,document+
-                                                                           (list@map product.left)
-                                                                           (list@fold archive.merge archive))]]
-                                                        (wrap [archive (try.assume
-                                                                        (..updated-state archive state))])))]
-                                   (case ((get@ #///.process compilation)
-                                          ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
-                                          ## TODO: The context shouldn't need to be re-set either.
-                                          (|> (///directive.set-current-module module)
-                                              (///phase.run' state)
-                                              try.assume
-                                              product.left)
-                                          archive)
-                                     (#try.Success [state more|done])
-                                     (case more|done
-                                       (#.Left more)
-                                       (continue! [archive state] more all-dependencies)
+                                                   (#.Cons _)
+                                                   (do @
+                                                     [_ (:: promise.monad wrap (verify-no-self-import! module new-dependencies))
+                                                      archive,document+ (|> new-dependencies
+                                                                            (list@map import!)
+                                                                            (monad.seq ..monad))
+                                                      #let [archive (|> archive,document+
+                                                                        (list@map product.left)
+                                                                        (list@fold archive.merge archive))]]
+                                                     (wrap [archive (try.assume
+                                                                     (..updated-state archive state))])))]
+                                (case ((get@ #///.process compilation)
+                                       ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
+                                       ## TODO: The context shouldn't need to be re-set either.
+                                       (|> (///directive.set-current-module module)
+                                           (///phase.run' state)
+                                           try.assume
+                                           product.left)
+                                       archive)
+                                  (#try.Success [state more|done])
+                                  (case more|done
+                                    (#.Left more)
+                                    (continue! [archive state] more all-dependencies)
 
-                                       (#.Right [[descriptor document] output])
-                                       (do (try.with promise.monad)
-                                         [#let [_ (log! (..module-compilation-log state))
-                                                descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
-                                          _ (..cache-module static platform module-id [[descriptor document] output])]
-                                         (case (archive.add module [descriptor document] archive)
-                                           (#try.Success archive)
-                                           (wrap [archive
-                                                  (..with-reset-log state)])
-                                           
-                                           (#try.Failure error)
-                                           (promise@wrap (#try.Failure error)))))
+                                    (#.Right [[descriptor document] output])
+                                    (do @
+                                      [#let [_ (log! (..module-compilation-log state))
+                                             descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
+                                       _ (..cache-module static platform module-id [[descriptor document] output])]
+                                      (case (archive.add module [descriptor document] archive)
+                                        (#try.Success archive)
+                                        (wrap [archive
+                                               (..with-reset-log state)])
+                                        
+                                        (#try.Failure error)
+                                        (promise@wrap (#try.Failure error)))))
 
-                                     (#try.Failure error)
-                                     (do (try.with promise.monad)
-                                       [_ (ioW.freeze (get@ #&file-system platform) static archive)]
-                                       (promise@wrap (#try.Failure error)))))))))]]
-          (compiler compilation-module))))
+                                  (#try.Failure error)
+                                  (do @
+                                    [_ (ioW.freeze (get@ #&file-system platform) static archive)]
+                                    (promise@wrap (#try.Failure error))))))))))]
+        (compiler compilation-module)))
     ))