aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-02-03 00:13:56 -0400
committerEduardo Julian2019-02-03 00:13:56 -0400
commitfb9202536a4c668f477da2d85af484800e2a3f0c (patch)
tree777070c1695c5c425fce4e8318dbc3537c1e9711
parent7ac55278171d8e5353c44974228e356eb45ec225 (diff)
Relative imports can now alter the start of a path.
Diffstat (limited to '')
-rw-r--r--stdlib/project.clj2
-rw-r--r--stdlib/source/lux.lux116
-rw-r--r--stdlib/test/test.lux (renamed from stdlib/test/tests.lux)2
-rw-r--r--stdlib/test/test/lux/cli.lux5
-rw-r--r--stdlib/test/test/lux/host.jvm.lux88
-rw-r--r--stdlib/test/test/lux/host/jvm.jvm.lux55
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)