From fb9202536a4c668f477da2d85af484800e2a3f0c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 Feb 2019 00:13:56 -0400 Subject: Relative imports can now alter the start of a path. --- stdlib/source/lux.lux | 116 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 81 insertions(+), 35 deletions(-) (limited to 'stdlib/source/lux.lux') 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 [ ] + [(def: #export ( value) + (-> (I64 Any) ) + (:coerce 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 @@ -4260,6 +4311,12 @@ #refer-open openings}} sub-imports))) + (^ [_ (#Record (list [[_ (#Tuple (list [_ (#Int alteration)] [_ (#Text domain)]))] + parallel-tree]))]) + (do Monad + [parallel-imports (parse-imports nested? relative-root (list parallel-tree))] + (wrap (list/map (alter-domain alteration domain) parallel-imports))) + _ (do Monad [current-module current-module-name] @@ -5175,17 +5232,6 @@ (-> Name Text) (|>> name/encode (text/compose "#"))) -(do-template [ ] - [(def: #export - (-> (I64 Any) ) - (|>> (:coerce )))] - - [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) -- cgit v1.2.3