- Changed to the new relative imports syntax.

1 files changed, 104 insertions, 102 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 0dcc335a0..5521e2d0d 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1205,7 +1205,7 @@
     (#Cons x xs')
     (list/fold f (f x init) xs')}))
 
-(def:'' (length list)
+(def:'' (list/size list)
   #;Nil
   (#UnivQ #Nil
           (#Function ($' List (#Bound +1)) Nat))
@@ -1250,7 +1250,7 @@
                                                                       [false _]
                                                                       (replace-syntax (#Cons [self-name (make-bound ("lux nat *"
                                                                                                                      +2 ("lux nat -"
-                                                                                                                         (length names)
+                                                                                                                         (list/size names)
                                                                                                                          +1)))]
                                                                                              #Nil)
                                                                                       body')})
@@ -1301,7 +1301,7 @@
                                                                       [false _]
                                                                       (replace-syntax (#Cons [self-name (make-bound ("lux nat *"
                                                                                                                      +2 ("lux nat -"
-                                                                                                                         (length names)
+                                                                                                                         (list/size names)
                                                                                                                          +1)))]
                                                                                              #Nil)
                                                                                       body')})
@@ -1311,7 +1311,7 @@
            (fail "Wrong syntax for Ex")})
          ))
 
-(def:'' (reverse list)
+(def:'' (list/reverse list)
   #;Nil
   (All [a] (#Function ($' List a) ($' List a)))
   (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a))))
@@ -1326,7 +1326,7 @@
 
                   ## This is the type of a function that takes 2 Ints and returns an Int.")]
          #;Nil)
-  ("lux case" (reverse tokens)
+  ("lux case" (list/reverse tokens)
    {(#Cons output inputs)
     (return (#Cons (list/fold ("lux check" (#Function Code (#Function Code Code))
                                (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil))))))
@@ -1347,7 +1347,7 @@
                                                       (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])]))
                                                              #Nil))))
                             (tag$ ["lux" "Nil"])
-                            (reverse xs))
+                            (list/reverse xs))
                  #Nil)))
 
 (macro:' #export (list& xs)
@@ -1356,7 +1356,7 @@
                   ## In other words, this macro prepends elements to another list.
                   (list& 1 2 3 (list 4 5 6))")]
          #;Nil)
-  ("lux case" (reverse xs)
+  ("lux case" (list/reverse xs)
    {(#Cons last init)
     (return (list (list/fold (function'' [head tail]
                                          (form$ (list (tag$ ["lux" "Cons"])
@@ -1375,7 +1375,7 @@
                   ## The empty tuple, a.k.a. Unit.
                   (&)")]
          #;Nil)
-  ("lux case" (reverse tokens)
+  ("lux case" (list/reverse tokens)
    {#Nil
     (return (list (tag$ ["lux" "Unit"])))
 
@@ -1393,7 +1393,7 @@
                   ## The empty tuple, a.k.a. Void.
                   (|)")]
          #;Nil)
-  ("lux case" (reverse tokens)
+  ("lux case" (list/reverse tokens)
    {#Nil
     (return (list (tag$ ["lux" "Void"])))
 
@@ -1426,7 +1426,7 @@
                                                                             arg
                                                                             body')))
                                                    body
-                                                   (reverse targs))))))})
+                                                   (list/reverse targs))))))})
 
            _
            (fail "Wrong syntax for function'")})))
@@ -1504,7 +1504,7 @@
                                           {[label value]
                                            (form$ (list (text$ "lux case") value (record$ (list [label body]))))})))
                              body
-                             (reverse (as-pairs bindings)))))
+                             (list/reverse (as-pairs bindings)))))
 
     _
     (fail "Wrong syntax for let'")}))
@@ -1600,7 +1600,7 @@
          #;Nil)
   ("lux case" tokens
    {(#Cons op tokens')
-    ("lux case" (reverse tokens')
+    ("lux case" (list/reverse tokens')
      {(#Cons last prevs)
       (return (list (list/fold (_$_joiner op) last prevs)))
 
@@ -1674,7 +1674,7 @@
                                                              (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body'))
                                                              value))}))))
                             body
-                            (reverse (as-pairs bindings)))]
+                            (list/reverse (as-pairs bindings)))]
           (return (list (form$ (list (text$ "lux case")
                                      monad
                                      (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
@@ -1847,7 +1847,7 @@
   (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code))
   ("lux case" replace?
    {true
-    ("lux case" (reverse elems)
+    ("lux case" (list/reverse elems)
      {#Nil
       (return (tag$ ["lux" "Nil"]))
       
@@ -2082,7 +2082,7 @@
                  (fold text/compose \"\"
                        (interpose \" \"
                                   (map int/encode elems)))")])
-  ("lux case" (reverse tokens)
+  ("lux case" (list/reverse tokens)
    {(#Cons [init apps])
     (return (list (list/fold ("lux check" (-> Code Code Code)
                               (function' [app acc]
@@ -2210,9 +2210,9 @@
      {[(#Some bindings') (#Some data')]
       (let' [apply ("lux check" (-> RepEnv ($' List Code))
                     (function' [env] (map (apply-template env) templates)))
-             num-bindings (length bindings')]
+             num-bindings (list/size bindings')]
             (if (every? (function' [sample] ("lux nat =" num-bindings sample))
-                        (map length data'))
+                        (map list/size data'))
               (|> data'
                   (join-map (. apply (make-env bindings')))
                   return)
@@ -2480,7 +2480,7 @@
   #Nil
   (All [a]
     (-> ($' List ($' List a)) ($' List a)))
-  (list/fold list/compose #Nil (reverse xs)))
+  (list/fold list/compose #Nil (list/reverse xs)))
 
 (def:''' (interpose sep xs)
   #Nil
@@ -2752,7 +2752,7 @@
                    (log! \"#2\")
                    (log! \"#3\")
                    \"YOLO\")")])
-  ("lux case" (reverse tokens)
+  ("lux case" (list/reverse tokens)
    {(#Cons value actions)
     (let' [dummy (symbol$ ["" ""])]
           (return (list (list/fold ("lux check" (-> Code Code Code)
@@ -2849,21 +2849,21 @@
     ($_ text/compose "(" (|> xs
                              (map code-to-text)
                              (interpose " ")
-                             reverse
+                             list/reverse
                              (list/fold text/compose "")) ")")
     
     [_ (#Tuple xs)]
     ($_ text/compose "[" (|> xs
                              (map code-to-text)
                              (interpose " ")
-                             reverse
+                             list/reverse
                              (list/fold text/compose "")) "]")
     
     [_ (#Record kvs)]
     ($_ text/compose "{" (|> kvs
                              (map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))})))
                              (interpose " ")
-                             reverse
+                             list/reverse
                              (list/fold text/compose "")) "}")}
    ))
 
@@ -2897,7 +2897,7 @@
     (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches
                                                                                  (map code-to-text)
                                                                                  (interpose " ")
-                                                                                 reverse
+                                                                                 list/reverse
                                                                                  (list/fold text/compose ""))))}))
 
 (macro:' #export (case tokens)
@@ -2996,8 +2996,8 @@
                    (op x y))")])
   (case tokens
     (^ (list [_ (#Tuple bindings)] body))
-    (if (multiple? +2 (length bindings))
-      (|> bindings as-pairs reverse
+    (if (multiple? +2 (list/size bindings))
+      (|> bindings as-pairs list/reverse
           (list/fold (: (-> [Code Code] Code Code)
                         (function' [lr body']
                                    (let' [[l r] lr]
@@ -3041,7 +3041,7 @@
                                            (` ("lux function" (~ g!blank) (~ g!blank)
                                                (case (~ g!blank) (~ arg) (~ body')))))))
                            body
-                           (reverse tail))]
+                           (list/reverse tail))]
       (return (list (if (symbol? head)
                       (` ("lux function" (~ g!name) (~ head) (~ body+)))
                       (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
@@ -3373,7 +3373,7 @@
 (do-template [<name> <form> <message> <doc-msg>]
   [(macro: #export (<name> tokens)
      {#;doc <doc-msg>}
-     (case (reverse tokens)
+     (case (list/reverse tokens)
        (^ (list& last init))
        (return (list (list/fold (: (-> Code Code Code)
                                    (function [pre post] (` <form>)))
@@ -3442,41 +3442,19 @@
     _
     (#;Left "Wrong syntax for default")))
 
-(def: (split-text splitter input)
+(def: (text/split splitter input)
   (-> Text Text (List Text))
   (case (index-of splitter input)
     #;None
-    (#Cons input #Nil)
+    (list input)
 
     (#;Some idx)
-    (#Cons (default (error! "UNDEFINED")
+    (list& (default (error! "UNDEFINED")
                     (clip2 +0 idx input))
-           (split-text splitter
+           (text/split splitter
                        (default (error! "UNDEFINED")
                                 (clip1 (n.+ +1 idx) input))))))
 
-(def: (split-module-contexts module)
-  (-> Text (List Text))
-  (#Cons module (case (last-index-of "/" module)
-                  #;None
-                  #Nil
-
-                  (#;Some idx)
-                  (split-module-contexts (default (error! "UNDEFINED")
-                                                  (clip2 +0 idx module))))))
-
-(def: (split-module module)
-  (-> Text (List Text))
-  (case (index-of "/" module)
-    #;None
-    (list module)
-
-    (#;Some idx)
-    (list& (default (error! "UNDEFINED")
-                    (clip2 +0 idx module))
-           (split-module (default (error! "UNDEFINED")
-                                  (clip1 (n.+ +1 idx) module))))))
-
 (def: (nth idx xs)
   (All [a]
     (-> Nat (List a) (Maybe a)))
@@ -3719,7 +3697,7 @@
 
 (def: (text/join parts)
   (-> (List Text) Text)
-  (|> parts reverse (list/fold text/compose "")))
+  (|> parts list/reverse (list/fold text/compose "")))
 
 (macro: #export (struct: tokens)
   {#;doc "## Definition of structures ala ML.
@@ -3969,7 +3947,7 @@
   (All [a]
     (-> (-> a Bool) (List a) [(List a) (List a)]))
   (let [[ys' xs'] (split-with' p #Nil xs)]
-    [(reverse ys') xs']))
+    [(list/reverse ys') xs']))
 
 (def: (parse-short-referrals tokens)
   (-> (List Code) (Meta [Referrals (List Code)]))
@@ -4089,30 +4067,53 @@
   (-> Text Text Text Text)
   ("lux text replace-all" template pattern value))
 
-(def: (clean-module module)
-  (-> Text (Meta Text))
-  (do Monad<Meta>
-    [current-module current-module-name]
-    (case (split-module module)
-      (^ (list& "." parts))
-      (return (|> (list& current-module parts) (interpose "/") reverse (list/fold text/compose "")))
-
-      parts
-      (let [[ups parts'] (split-with (text/= "..") parts)
-            num-ups (length ups)]
-        (if (n.= +0 num-ups)
-          (return module)
-          (case (nth num-ups (split-module-contexts current-module))
-            #None
-            (fail (text/compose "Cannot clean module: " module))
-
-            (#Some top-module)
-            (return (|> (list& top-module parts') (interpose "/") reverse (list/fold text/compose ""))))
-          )))
-    ))
-
-(def: (parse-imports imports)
-  (-> (List Code) (Meta (List Importation)))
+(def: (count-ups ups input)
+  (-> Nat Text Nat)
+  (case ("lux text index" input "/" ups)
+    #;None
+    ups
+
+    (#;Some found)
+    (if (n.= ups found)
+      (count-ups (n.+ +1 ups) input)
+      ups)))
+
+(def: (list/drop amount a+)
+  (All [a] (-> Nat (List a) (List a)))
+  (case [amount a+]
+    (^or [+0 _] [_ #;Nil])
+    a+
+
+    [_ (#;Cons _ a+')]
+    (list/drop (n.- +1 amount) a+')))
+
+(def: (clean-module relative-root module)
+  (-> Text Text (Meta Text))
+  (case (count-ups +0 module)
+    +0
+    (return module)
+    
+    ups
+    (let [parts (text/split "/" 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)
+              clean (|> module (clip1 ups) (default (error! "UNDEFINED")))
+              output (case ("lux text size" clean)
+                       +0 prefix
+                       _ ($_ text/compose prefix "/" clean))]
+          (return output))
+        (fail ($_ text/compose
+                  "Cannot climb the module hierarchy...\n"
+                  "Importing module: " module "\n"
+                  "   Relative Root: " relative-root "\n"))))))
+
+(def: (parse-imports relative-root imports)
+  (-> Text (List Code) (Meta (List Importation)))
   (do Monad<Meta>
     [imports' (monad/map Monad<Meta>
                          (: (-> Code (Meta (List Importation)))
@@ -4120,20 +4121,20 @@
                               (case token
                                 [_ (#Symbol "" m-name)]
                                 (do Monad<Meta>
-                                  [m-name (clean-module m-name)]
+                                  [m-name (clean-module relative-root m-name)]
                                   (wrap (list [m-name #None {#refer-defs #All
                                                              #refer-open (list)}])))
 
                                 (^ [_ (#Form (list& [_ (#Symbol "" m-name)] extra))])
                                 (do Monad<Meta>
-                                  [m-name (clean-module m-name)
+                                  [m-name (clean-module relative-root m-name)
                                    alias+extra (parse-alias extra)
                                    #let [[alias extra] alias+extra]
                                    referral+extra (parse-referrals extra)
                                    #let [[referral extra] referral+extra]
                                    openings+extra (parse-openings extra)
                                    #let [[openings extra] openings+extra]
-                                   sub-imports (parse-imports extra)
+                                   sub-imports (parse-imports relative-root extra)
                                    #let [sub-imports (decorate-sub-importations m-name sub-imports)]]
                                   (wrap (case [referral alias openings]
                                           [#Nothing #None #Nil] sub-imports
@@ -4145,7 +4146,7 @@
 
                                 (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Symbol "" m-name)] extra))])
                                 (do Monad<Meta>
-                                  [m-name (clean-module m-name)
+                                  [m-name (clean-module relative-root m-name)
                                    referral+extra (parse-short-referrals extra)
                                    #let [[referral extra] referral+extra]
                                    openings+extra (parse-short-openings extra)
@@ -4157,7 +4158,7 @@
 
                                 (^ [_ (#Tuple (list& [_ (#Symbol "" raw-m-name)] extra))])
                                 (do Monad<Meta>
-                                  [m-name (clean-module raw-m-name)
+                                  [m-name (clean-module relative-root raw-m-name)
                                    referral+extra (parse-short-referrals extra)
                                    #let [[referral extra] referral+extra]
                                    openings+extra (parse-short-openings extra)
@@ -4366,7 +4367,7 @@
       name
 
       _
-      ($_ text/compose "(" name " " (|> params (map type/show) (interpose " ") reverse (list/fold text/compose "")) ")"))
+      ($_ text/compose "(" name " " (|> params (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")"))
 
     #Void
     "Void"
@@ -4375,13 +4376,13 @@
     "Unit"
 
     (#Sum _)
-    ($_ text/compose "(| " (|> (flatten-variant type) (map type/show) (interpose " ") reverse (list/fold text/compose "")) ")")
+    ($_ text/compose "(| " (|> (flatten-variant type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")
     
     (#Product _)
-    ($_ text/compose "[" (|> (flatten-tuple type) (map type/show) (interpose " ") reverse (list/fold text/compose "")) "]")
+    ($_ text/compose "[" (|> (flatten-tuple type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) "]")
 
     (#Function _)
-    ($_ text/compose "(-> " (|> (flatten-lambda type) (map type/show) (interpose " ") reverse (list/fold text/compose "")) ")")
+    ($_ text/compose "(-> " (|> (flatten-lambda type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")
 
     (#Bound id)
     (nat/encode id)
@@ -4402,7 +4403,7 @@
     (let [[func args] (flatten-app type)]
       ($_ text/compose
           "(" (type/show func) " "
-          (|> args (map type/show) (interpose " ") reverse (list/fold text/compose ""))
+          (|> args (map type/show) (interpose " ") list/reverse (list/fold text/compose ""))
           ")"))
     
     (#Named [prefix name] _)
@@ -4473,9 +4474,9 @@
                 (n.odd? num) \"odd\"
                 ## else-branch
                 \"???\")"}
-  (if (n.= +0 (n.% +2 (length tokens)))
+  (if (n.= +0 (n.% +2 (list/size tokens)))
     (fail "cond requires an even number of arguments.")
-    (case (reverse tokens)
+    (case (list/reverse tokens)
       (^ (list& else branches'))
       (return (list (list/fold (: (-> [Code Code] Code Code)
                                   (function [branch else]
@@ -4758,7 +4759,7 @@
                        (ident #open (\"ident/\" Codec<Text,Ident>)))
                  meta
                  (macro code))
-            (.. (type #open (\"\" Eq<Type>))))
+            (// (type #open (\"\" Eq<Type>))))
 
           (;module: {#;doc \"Some documentation...\"}
             lux
@@ -4769,7 +4770,7 @@
                        [ident \"ident/\" Codec<Text,Ident>])
                  meta
                  (macro code))
-            (.. [type \"\" Eq<Type>]))"}
+            (// [type \"\" Eq<Type>]))"}
   (do Monad<Meta>
     [#let [[_meta _imports] (: [(List [Code Code]) (List Code)]
                                (case tokens
@@ -4778,7 +4779,8 @@
 
                                  _
                                  [(list) tokens]))]
-     imports (parse-imports _imports)
+     current-module current-module-name
+     imports (parse-imports current-module _imports)
      #let [=imports (map (: (-> Importation Code)
                             (function [[m-name m-alias =refer]]
                               (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))
@@ -4870,14 +4872,14 @@
                                          (function [[s b] v]
                                            (` (;;set@ (~ s) (~ v) (~ b)))))
                                       value
-                                      (reverse pairs))
+                                      (list/reverse pairs))
                [_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))])
                                            (function [[new-slot new-binding] [old-record accesses']]
                                              [(` (get@ (~ new-slot) (~ new-binding)))
                                               (#;Cons (list new-binding old-record) accesses')]))
                                         [record (: (List (List Code)) #;Nil)]
                                         pairs)
-               accesses (list/join (reverse accesses'))]]
+               accesses (list/join (list/reverse accesses'))]]
         (wrap (list (` (let [(~@ accesses)]
                          (~ update-expr)))))))
     
@@ -5011,7 +5013,7 @@
              (do Monad<Maybe>
                [bindings' (monad/map Monad<Maybe> get-name bindings)
                 data' (monad/map Monad<Maybe> tuple->list data)]
-               (if (every? (n.= (length bindings')) (map length data'))
+               (if (every? (n.= (list/size bindings')) (map list/size data'))
                  (let [apply (: (-> RepEnv (List Code))
                                 (function [env] (map (apply-template env) templates)))]
                    (|> data'
@@ -5193,7 +5195,7 @@
   (case fragment
     (#Doc-Comment comment)
     (|> comment
-        (split-text "\n")
+        (text/split "\n")
         (map (function [line] ($_ text/compose "## " line "\n")))
         text/join)
 
@@ -5574,7 +5576,7 @@
                                              (~ g!_)
                                              #;None)))
                                       (` (#;Some (~ body)))
-                                      (: (List [Code Code]) (reverse levels)))]
+                                      (: (List [Code Code]) (list/reverse levels)))]
     (list init-pattern inner-pattern-body)))
 
 (macro: #export (^multi tokens)
@@ -5680,7 +5682,7 @@
     (^ (list [_ (#Nat idx)]))
     (do Monad<Meta>
       [stvs get-scope-type-vars]
-      (case (list-at idx (reverse stvs))
+      (case (list-at idx (list/reverse stvs))
         (#;Some var-id)
         (wrap (list (` (#Ex (~ (nat$ var-id))))))
 
@@ -6060,11 +6062,11 @@
 
     (^template [<tag>]
       [_ (<tag> elems)]
-      (case (reverse elems)
+      (case (list/reverse elems)
         (#;Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
                 inits)
         (do Monad<Meta>
-          [=inits (monad/map Monad<Meta> untemplate-pattern (reverse inits))
+          [=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits))
            g!meta (gensym "g!meta")]
           (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))])))