Relative imports can now alter the start of a path.

6 files changed, 162 insertions, 106 deletions

diff --git a/stdlib/project.clj b/stdlib/project.clj
index feebb80a5..e9ed11d34 100644
--- a/stdlib/project.clj
+++ b/stdlib/project.clj
@@ -20,5 +20,5 @@
   
   :source-paths ["source"]
   :test-paths ["test"]
-  :lux {:tests {:jvm "tests"}}
+  :lux {:tests {:jvm "test"}}
   )
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index a9bc53018..c22036ef2 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -3643,7 +3643,7 @@
     _
     (#Left "Wrong syntax for default")))
 
-(def: (text/split splitter input)
+(def: (text/split-all-with splitter input)
   (-> Text Text (List Text))
   (case (index-of splitter input)
     #None
@@ -3651,8 +3651,8 @@
 
     (#Some idx)
     (list& ("lux text clip" input 0 idx)
-           (text/split splitter
-                       ("lux text clip" input (n/+ 1 idx) ("lux text size" input))))))
+           (text/split-all-with splitter
+                                ("lux text clip" input (n/+ 1 idx) ("lux text size" input))))))
 
 (def: (nth idx xs)
   (All [a]
@@ -3894,9 +3894,17 @@
                         (list/join tokens'))]
     (wrap (list (record$ members)))))
 
-(def: (text/join parts)
-  (-> (List Text) Text)
-  (|> parts list/reverse (list/fold text/compose "")))
+(def: (text/join-with separator parts)
+  (-> Text (List Text) Text)
+  (case parts
+    #Nil
+    ""
+    
+    (#Cons head tail)
+    (list/fold (function (_ right left)
+                 ($_ text/compose left separator right))
+               head
+               tail)))
 
 (macro: #export (structure: tokens)
   {#.doc (text$ ($_ "lux text concat"
@@ -3947,7 +3955,7 @@
                                         #None))
                                     sig-args))
                   (^ (#Some params))
-                  (#Some (identifier$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")]))
+                  (#Some (identifier$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") (text/join-with "")) ">")]))
 
                   _
                   #None)
@@ -4064,6 +4072,17 @@
       (fail "Wrong syntax for type:"))
     ))
 
+(do-template [<name> <to>]
+  [(def: #export (<name> value)
+     (-> (I64 Any) <to>)
+     (:coerce <to> value))]
+
+  [i64 I64]
+  [nat Nat]
+  [int Int]
+  [rev Rev]
+  )
+
 (type: Referrals
   #All
   (#Only (List Text))
@@ -4168,9 +4187,11 @@
   (-> Text Text Text)
   (replace-all "."))
 
+(def: #export module-separator "/")
+
 (def: (count-ups ups input)
   (-> Nat Text Nat)
-  (case ("lux text index" input "/" ups)
+  (case ("lux text index" input ..module-separator ups)
     #None
     ups
 
@@ -4179,42 +4200,72 @@
       (count-ups (n/+ 1 ups) input)
       ups)))
 
-(def: (list/drop amount a+)
+(def: (list/take amount list)
   (All [a] (-> Nat (List a) (List a)))
-  (case [amount a+]
+  (case [amount list]
     (^or [0 _] [_ #Nil])
-    a+
+    #Nil
 
-    [_ (#Cons _ a+')]
-    (list/drop (n/- 1 amount) a+')))
+    [_ (#Cons head tail)]
+    (#Cons head (list/take (n/- 1 amount) tail))))
+
+(def: (list/drop amount list)
+  (All [a] (-> Nat (List a) (List a)))
+  (case [amount list]
+    (^or [0 _] [_ #Nil])
+    list
+
+    [_ (#Cons _ tail)]
+    (list/drop (n/- 1 amount) tail)))
 
 (def: (clean-module nested? relative-root module)
   (-> Bit Text Text (Meta Text))
   (case (count-ups 0 module)
     0
     (return (if nested?
-              ($_ "lux text concat" relative-root "/" module)
+              ($_ "lux text concat" relative-root ..module-separator module)
               module))
     
     ups
-    (let [parts (text/split "/" relative-root)]
+    (let [parts (text/split-all-with ..module-separator relative-root)]
       (if (n/< (list/size parts) (n/- 1 ups))
         (let [prefix (|> parts
                          list/reverse
                          (list/drop (n/- 1 ups))
                          list/reverse
-                         (interpose "/")
-                         text/join)
+                         (interpose ..module-separator)
+                         (text/join-with ""))
               clean ("lux text clip" module ups ("lux text size" module))
               output (case ("lux text size" clean)
                        0 prefix
-                       _ ($_ text/compose prefix "/" clean))]
+                       _ ($_ text/compose prefix ..module-separator clean))]
           (return output))
         (fail ($_ "lux text concat"
                   "Cannot climb the module hierarchy..." ..new-line
                   "Importing module: " module ..new-line
                   "   Relative Root: " relative-root ..new-line))))))
 
+(def: (alter-domain alteration domain import)
+  (-> Int Text Importation Importation)
+  (let [[import-name import-alias import-refer] import
+        original (text/split-all-with ..module-separator import-name)
+        [pre post] (if (i/< +0 alteration)
+                     [(list) (list/drop (.nat (i/* -1 alteration)) original)]
+                     [(list/take (.nat alteration) original)
+                      (list/drop (.nat alteration) original)])
+        altered ($_ list/compose
+                    pre
+                    (case domain
+                      ""
+                      (list)
+
+                      _
+                      (list domain))
+                    post)]
+    {#import-name (text/join-with ..module-separator altered)
+     #import-alias import-alias
+     #import-refer import-refer}))
+
 (def: (parse-imports nested? relative-root imports)
   (-> Bit Text (List Code) (Meta (List Importation)))
   (do Monad<Meta>
@@ -4260,6 +4311,12 @@
                                                                #refer-open openings}}
                                                sub-imports)))
 
+                                (^ [_ (#Record (list [[_ (#Tuple (list [_ (#Int alteration)] [_ (#Text domain)]))]
+                                                      parallel-tree]))])
+                                (do Monad<Meta>
+                                  [parallel-imports (parse-imports nested? relative-root (list parallel-tree))]
+                                  (wrap (list/map (alter-domain alteration domain) parallel-imports)))
+
                                 _
                                 (do Monad<Meta>
                                   [current-module current-module-name]
@@ -5175,17 +5232,6 @@
   (-> Name Text)
   (|>> name/encode (text/compose "#")))
 
-(do-template [<name> <to>]
-  [(def: #export <name>
-     (-> (I64 Any) <to>)
-     (|>> (:coerce <to>)))]
-
-  [i64 I64]
-  [nat Nat]
-  [int Int]
-  [rev Rev]
-  )
-
 (def: (repeat n x)
   (All [a] (-> Int a (List a)))
   (if (i/> +0 n)
@@ -5195,9 +5241,9 @@
 (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column])
   (-> Nat Cursor Cursor Text)
   (if (n/= old-line new-line)
-    (text/join (repeat (.int (n/- old-column new-column)) " "))
-    (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) ..new-line))
-          space-padding (text/join (repeat (.int (n/- baseline new-column)) " "))]
+    (text/join-with "" (repeat (.int (n/- old-column new-column)) " "))
+    (let [extra-lines (text/join-with "" (repeat (.int (n/- old-line new-line)) ..new-line))
+          space-padding (text/join-with "" (repeat (.int (n/- baseline new-column)) " "))]
       (text/compose extra-lines space-padding))))
 
 (def: (text/size x)
@@ -5262,9 +5308,9 @@
   (case fragment
     (#Doc-Comment comment)
     (|> comment
-        (text/split ..new-line)
+        (text/split-all-with ..new-line)
         (list/map (function (_ line) ($_ text/compose "## " line ..new-line)))
-        text/join)
+        (text/join-with ""))
 
     (#Doc-Example example)
     (let [baseline (find-baseline-column example)
@@ -5287,7 +5333,7 @@
   (return (list (` [(~ cursor-code)
                     (#.Text (~ (|> tokens
                                    (list/map (|>> identify-doc-fragment doc-fragment->Text))
-                                   text/join
+                                   (text/join-with "")
                                    text$)))]))))
 
 (def: (interleave xs ys)
diff --git a/stdlib/test/tests.lux b/stdlib/test/test.lux
index 5c7838634..53efb1c05 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/test.lux
@@ -81,7 +81,7 @@
    ##  ["._interpreter" type]]
    ]
   ## TODO: Must have 100% coverage on tests.
-  [test
+  [/
    ["/." lux
     ## [io (#+)]
     ## [time
diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux
index bf7bc72a7..7c50a679b 100644
--- a/stdlib/test/test/lux/cli.lux
+++ b/stdlib/test/test/lux/cli.lux
@@ -13,8 +13,9 @@
      ["." list]]]
    [math
     ["r" random]]
-   ["/" cli]
-   ["_" test (#+ Test)]])
+   ["_" test (#+ Test)]]
+  {[-1 ""]
+   ["." /]})
 
 (def: #export test
   Test
diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux
index c3dcf6791..f1151f010 100644
--- a/stdlib/test/test/lux/host.jvm.lux
+++ b/stdlib/test/test/lux/host.jvm.lux
@@ -5,10 +5,11 @@
     pipe]
    [data
     [text ("text/." Equivalence<Text>)]]
-   ["&" host (#+ import: class: interface: object)]
    [math
     ["r" random]]
-   ["_" test (#+ Test)]])
+   ["_" test (#+ Test)]]
+  {[-1 ""]
+   ["." / (#+ import: class: interface: object)]})
 
 (import: (java/util/concurrent/Callable a))
 
@@ -58,7 +59,8 @@
 (interface: TestInterface
   ([] foo [boolean String] void #throws [Exception]))
 
-(def: conversions Test
+(def: conversions
+  Test
   (do r.Monad<Random>
     [sample r.int]
     (`` ($_ _.and
@@ -68,55 +70,59 @@
                                (let [capped-sample (|> sample <to> <from>)]
                                  (|> capped-sample <to> <from> (i/= capped-sample)))))]
 
-                  [&.long-to-byte &.byte-to-long "Can succesfully convert to/from byte."]
-                  [&.long-to-short &.short-to-long "Can succesfully convert to/from short."]
-                  [&.long-to-int &.int-to-long "Can succesfully convert to/from int."]
-                  [&.long-to-float &.float-to-long "Can succesfully convert to/from float."]
-                  [&.long-to-double &.double-to-long "Can succesfully convert to/from double."]
-                  [(<| &.int-to-char &.long-to-int) (<| &.int-to-long &.char-to-int) "Can succesfully convert to/from char."]
+                  [/.long-to-byte /.byte-to-long "Can succesfully convert to/from byte."]
+                  [/.long-to-short /.short-to-long "Can succesfully convert to/from short."]
+                  [/.long-to-int /.int-to-long "Can succesfully convert to/from int."]
+                  [/.long-to-float /.float-to-long "Can succesfully convert to/from float."]
+                  [/.long-to-double /.double-to-long "Can succesfully convert to/from double."]
+                  [(<| /.int-to-char /.long-to-int) (<| /.int-to-long /.char-to-int) "Can succesfully convert to/from char."]
                   ))
             ))))
 
-(def: miscellaneous Test
-  ($_ _.and
-      (_.test "Can check if an object is of a certain class."
-              (and (case (&.check String "") (#.Some _) true #.None false)
-                   (case (&.check Long "") (#.Some _) false #.None true)
-                   (case (&.check Object "") (#.Some _) true #.None false)
-                   (case (&.check Object (&.null)) (#.Some _) false #.None true)))
-
-      (_.test "Can run code in a 'synchronized' block."
-              (&.synchronized "" #1))
-
-      (_.test "Can access Class instances."
-              (text/= "java.lang.Class" (Class::getName (&.class-for java/lang/Class))))
-
-      (_.test "Can check if a value is null."
-              (and (&.null? (&.null))
-                   (not (&.null? ""))))
-
-      (_.test "Can safely convert nullable references into Maybe values."
-              (and (|> (: (Maybe Object) (&.??? (&.null)))
-                       (case> #.None #1
-                              _ #0))
-                   (|> (: (Maybe Object) (&.??? ""))
-                       (case> (#.Some _) #1
-                              _ #0))))
-      ))
-
-(def: arrays Test
+(def: miscellaneous
+  Test
+  (do r.Monad<Random>
+    [sample (r.ascii 1)]
+    ($_ _.and
+        (_.test "Can check if an object is of a certain class."
+                (and (case (/.check String sample) (#.Some _) true #.None false)
+                     (case (/.check Long sample) (#.Some _) false #.None true)
+                     (case (/.check Object sample) (#.Some _) true #.None false)
+                     (case (/.check Object (/.null)) (#.Some _) false #.None true)))
+
+        (_.test "Can run code in a 'synchronized' block."
+                (/.synchronized sample #1))
+
+        (_.test "Can access Class instances."
+                (text/= "java.lang.Class" (Class::getName (/.class-for java/lang/Class))))
+
+        (_.test "Can check if a value is null."
+                (and (/.null? (/.null))
+                     (not (/.null? sample))))
+
+        (_.test "Can safely convert nullable references into Maybe values."
+                (and (|> (: (Maybe Object) (/.??? (/.null)))
+                         (case> #.None #1
+                                _ #0))
+                     (|> (: (Maybe Object) (/.??? sample))
+                         (case> (#.Some _) #1
+                                _ #0))))
+        )))
+
+(def: arrays
+  Test
   (do r.Monad<Random>
     [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
      idx (|> r.nat (:: @ map (n/% size)))
      value r.int]
     ($_ _.and
         (_.test "Can create arrays of some length."
-                (n/= size (&.array-length (&.array Long size))))
+                (n/= size (/.array-length (/.array Long size))))
 
         (_.test "Can set and get array values."
-                (let [arr (&.array Long size)]
-                  (exec (&.array-write idx value arr)
-                    (i/= value (&.array-read idx arr))))))))
+                (let [arr (/.array Long size)]
+                  (exec (/.array-write idx value arr)
+                    (i/= value (/.array-read idx arr))))))))
 
 (def: #export test
   ($_ _.and
diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux
index caa3efd1f..bacfd480b 100644
--- a/stdlib/test/test/lux/host/jvm.jvm.lux
+++ b/stdlib/test/test/lux/host/jvm.jvm.lux
@@ -17,19 +17,19 @@
    [world
     ["." file (#+ File)]
     [binary (#+ Binary)]]
-   [host
-    [jvm
-     ["/." loader (#+ Library)]
-     ["/." version]
-     ["/." name]
-     ["/." descriptor]
-     ["/." field]
-     ["/." class]
-     [modifier
-      ["/.M" inner]]]]
    [math
     ["r" random]]
-   ["_" test (#+ Test)]])
+   ["_" test (#+ Test)]]
+  {[-1 ""]
+   [/
+    ["/." loader (#+ Library)]
+    ["/." version]
+    ["/." name]
+    ["/." descriptor]
+    ["/." field]
+    ["/." class]
+    [modifier
+     ["/.M" inner]]]})
 
 (def: (write-class! name bytecode)
   (-> Text Binary (IO Text))
@@ -46,21 +46,24 @@
               (#error.Failure error)
               error)))))
 
-(def: class Test
-  (let [package "my.package"
-        name "MyClass"
-        full-name (format package "." name)
-        input (/class.class /version.v6_0 /class.public
-                            (/name.internal "java.lang.Object")
-                            (/name.internal full-name)
-                            (list (/name.internal "java.io.Serializable")
-                                  (/name.internal "java.lang.Runnable"))
-                            (list (/field.field /field.public "foo" /descriptor.long (row.row))
-                                  (/field.field /field.public "bar" /descriptor.double (row.row)))
-                            (row.row)
-                            (row.row))
-        bytecode (binary.write /class.format input)
-        loader (/loader.memory (/loader.new-library []))]
+(def: class
+  Test
+  (do r.Monad<Random>
+    [_ (wrap [])
+     #let [package "my.package"
+           name "MyClass"
+           full-name (format package "." name)
+           input (/class.class /version.v6_0 /class.public
+                               (/name.internal "java.lang.Object")
+                               (/name.internal full-name)
+                               (list (/name.internal "java.io.Serializable")
+                                     (/name.internal "java.lang.Runnable"))
+                               (list (/field.field /field.public "foo" /descriptor.long (row.row))
+                                     (/field.field /field.public "bar" /descriptor.double (row.row)))
+                               (row.row)
+                               (row.row))
+           bytecode (binary.write /class.format input)
+           loader (/loader.memory (/loader.new-library []))]]
     ($_ _.and
         (_.test "Can read a generated class."
                 (case (binary.read /class.format bytecode)