aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2020-10-14 21:48:00 -0400
committerEduardo Julian2020-10-14 21:48:00 -0400
commit440608bc32916329c9f3c0f2bd9a8d1152ed5da8 (patch)
treee27ae0f41a437c24275293b151b23e63bf938392 /stdlib/source
parent00d5ccbc043960037f644d4ff09b6a46fd0093d0 (diff)
Gave the Location type its own module.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux11
-rw-r--r--stdlib/source/lux/abstract/comonad.lux8
-rw-r--r--stdlib/source/lux/abstract/monad.lux8
-rw-r--r--stdlib/source/lux/control/exception.lux4
-rw-r--r--stdlib/source/lux/control/thread.lux4
-rw-r--r--stdlib/source/lux/control/try.lux6
-rw-r--r--stdlib/source/lux/data/collection/array.lux65
-rw-r--r--stdlib/source/lux/data/collection/bits.lux20
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux52
-rw-r--r--stdlib/source/lux/data/collection/row.lux32
-rw-r--r--stdlib/source/lux/data/maybe.lux6
-rw-r--r--stdlib/source/lux/data/number/rev.lux106
-rw-r--r--stdlib/source/lux/data/text/format.lux14
-rw-r--r--stdlib/source/lux/macro/code.lux8
-rw-r--r--stdlib/source/lux/meta.lux10
-rw-r--r--stdlib/source/lux/meta/location.lux30
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/analysis.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux2
-rw-r--r--stdlib/source/lux/type.lux53
-rw-r--r--stdlib/source/program/aedifex/artifact/extension.lux37
-rw-r--r--stdlib/source/program/aedifex/dependency.lux12
-rw-r--r--stdlib/source/program/aedifex/extension.lux11
-rw-r--r--stdlib/source/program/aedifex/local.lux24
-rw-r--r--stdlib/source/test/aedifex/artifact.lux4
-rw-r--r--stdlib/source/test/aedifex/artifact/extension.lux40
-rw-r--r--stdlib/source/test/lux/data/collection/array.lux244
-rw-r--r--stdlib/source/test/lux/macro/code.lux8
-rw-r--r--stdlib/source/test/lux/meta.lux16
-rw-r--r--stdlib/source/test/lux/target/jvm.lux22
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux10
31 files changed, 557 insertions, 323 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index fa33ac0b4..01401ea29 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1,7 +1,7 @@
("lux def" dummy-location
["" 0 0]
[["" 0 0] (9 #1 (0 #0))]
- #1)
+ #0)
("lux def" double-quote
("lux i64 char" +34)
@@ -5856,15 +5856,6 @@
_
(fail (..wrong-syntax-error (name-of ..^code)))))
-(def: #export (location-description [file line column])
- (-> Location Text)
- (let [separator ", "
- fields ($_ "lux text concat"
- (text@encode file) separator
- (nat@encode line) separator
- (nat@encode column))]
- ($_ "lux text concat" "[" fields "]")))
-
(template [<zero> <one>]
[(def: #export <zero> #0)
(def: #export <one> #1)]
diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux
index 14515da25..0722d7a1b 100644
--- a/stdlib/source/lux/abstract/comonad.lux
+++ b/stdlib/source/lux/abstract/comonad.lux
@@ -4,7 +4,9 @@
[number
["n" nat]]
[collection
- ["." list ("#@." fold)]]]]
+ ["." list ("#@." fold)]]]
+ [meta
+ ["." location]]]
[//
[functor (#+ Functor)]])
@@ -44,7 +46,7 @@
(if (|> bindings list.size (n.% 2) (n.= 0))
(let [[module short] (name-of ..be)
gensym (: (-> Text Code)
- (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [.dummy-location]))
+ (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy]))
g!_ (gensym "_")
g!map (gensym "map")
g!split (gensym "split")
@@ -62,7 +64,7 @@
(list.reverse (list.as-pairs bindings)))]
(#.Right [state (list (case ?name
(#.Some name)
- (let [name [.dummy-location (#.Identifier ["" name])]]
+ (let [name [location.dummy (#.Identifier ["" name])]]
(` ({(~ name)
({[(~ g!map) (~' unwrap) (~ g!split)]
(~ body')}
diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux
index c2b19362d..7cc5ae263 100644
--- a/stdlib/source/lux/abstract/monad.lux
+++ b/stdlib/source/lux/abstract/monad.lux
@@ -1,5 +1,7 @@
(.module:
- [lux #*]
+ [lux #*
+ [meta
+ ["." location]]]
[//
[functor (#+ Functor)]])
@@ -70,7 +72,7 @@
(if (|> bindings list@size .int ("lux i64 %" +2) ("lux i64 =" +0))
(let [[module short] (name-of ..do)
gensym (: (-> Text Code)
- (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [.dummy-location]))
+ (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy]))
g!_ (gensym "_")
g!map (gensym "map")
g!join (gensym "join")
@@ -88,7 +90,7 @@
(reverse (as-pairs bindings)))]
(#.Right [state (list (case ?name
(#.Some name)
- (let [name [.dummy-location (#.Identifier ["" name])]]
+ (let [name [location.dummy (#.Identifier ["" name])]]
(` ({(~ name)
({[(~ g!map) (~' wrap) (~ g!join)]
(~ body')}
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 5d0a04ea9..0b773a08e 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -70,12 +70,12 @@
(def: #export (construct exception message)
{#.doc "Constructs an exception."}
(All [e] (-> (Exception e) e Text))
- ((get@ #constructor exception) message))
+ ((get@ #..constructor exception) message))
(def: #export (throw exception message)
{#.doc "Decorate an error message with an Exception and lift it into the error-handling context."}
(All [e a] (-> (Exception e) e (Try a)))
- (#//.Failure (construct exception message)))
+ (#//.Failure (..construct exception message)))
(def: #export (assert exception message test)
(All [e] (-> (Exception e) e Bit (Try Any)))
diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux
index 28466fc05..2aef71e06 100644
--- a/stdlib/source/lux/control/thread.lux
+++ b/stdlib/source/lux/control/thread.lux
@@ -25,7 +25,7 @@
(All [a] (-> a (All [!] (Thread ! (Box ! a)))))
(function (_ !)
(|> (array.new 1)
- (array.write 0 init)
+ (array.write! 0 init)
:abstraction)))
(def: #export (read box)
@@ -48,7 +48,7 @@
(def: #export (write value box)
(All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
(function (_ !)
- (|> box :representation (array.write 0 value) :abstraction)))
+ (|> box :representation (array.write! 0 value) :abstraction)))
)
(def: #export (run thread)
diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux
index 74707c51b..8f710b0f0 100644
--- a/stdlib/source/lux/control/try.lux
+++ b/stdlib/source/lux/control/try.lux
@@ -4,7 +4,9 @@
[apply (#+ Apply)]
[equivalence (#+ Equivalence)]
["." functor (#+ Functor)]
- ["." monad (#+ Monad do)]]])
+ ["." monad (#+ Monad do)]]
+ [meta
+ ["." location]]])
(type: #export (Try a)
(#Failure Text)
@@ -143,7 +145,7 @@
(#..Success (~' g!temp))
(~' g!temp)
- (#..Failure (~ [.dummy-location (#.Identifier ["" ""])]))
+ (#..Failure (~ [location.dummy (#.Identifier ["" ""])]))
(~ else))))])
_
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 6d2e7c16d..a2a13eb5a 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -89,7 +89,7 @@
(#.Some output)))})
#.None))
- (def: #export (write index value array)
+ (def: #export (write! index value array)
(All [a]
(-> Nat a (Array a) (Array a)))
(for {@.old
@@ -104,15 +104,15 @@
@.js
("js array write" index value array)}))
- (def: #export (delete index array)
+ (def: #export (delete! index array)
(All [a]
(-> Nat (Array a) (Array a)))
(if (n.< (size array) index)
(for {@.old
- (write index (:assume ("jvm object null")) array)
+ (write! index (:assume ("jvm object null")) array)
@.jvm
- (write index (:assume (: <elem-type> ("jvm object null"))) array)
+ (write! index (:assume (: <elem-type> ("jvm object null"))) array)
@.js
("js array delete" index array)})
@@ -129,7 +129,7 @@
_
false))
-(def: #export (update index transform array)
+(def: #export (update! index transform array)
(All [a]
(-> Nat (-> a a) (Array a) (Array a)))
(case (read index array)
@@ -137,16 +137,16 @@
array
(#.Some value)
- (write index (transform value) array)))
+ (write! index (transform value) array)))
-(def: #export (upsert index default transform array)
+(def: #export (upsert! index default transform array)
(All [a]
(-> Nat a (-> a a) (Array a) (Array a)))
- (write index
- (|> array (read index) (maybe.default default) transform)
- array))
+ (write! index
+ (|> array (read index) (maybe.default default) transform)
+ array))
-(def: #export (copy length src-start src-array dest-start dest-array)
+(def: #export (copy! length src-start src-array dest-start dest-array)
(All [a]
(-> Nat Nat (Array a) Nat (Array a)
(Array a)))
@@ -158,11 +158,11 @@
target
(#.Some value)
- (write (n.+ offset dest-start) value target)))
+ (write! (n.+ offset dest-start) value target)))
dest-array
(list.indices length))))
-(def: #export (occupied array)
+(def: #export (occupancy array)
{#.doc "Finds out how many cells in an array are occupied."}
(All [a] (-> (Array a) Nat))
(list@fold (function (_ idx count)
@@ -175,14 +175,14 @@
0
(list.indices (size array))))
-(def: #export (vacant array)
+(def: #export (vacancy array)
{#.doc "Finds out how many cells in an array are vacant."}
(All [a] (-> (Array a) Nat))
- (n.- (occupied array) (size array)))
+ (n.- (..occupancy array) (..size array)))
(def: #export (filter! p xs)
(All [a]
- (-> (-> a Bit) (Array a) (Array a)))
+ (-> (Predicate a) (Array a) (Array a)))
(list@fold (function (_ idx xs')
(case (read idx xs)
#.None
@@ -191,13 +191,13 @@
(#.Some x)
(if (p x)
xs'
- (delete idx xs'))))
+ (delete! idx xs'))))
xs
(list.indices (size xs))))
(def: #export (find p xs)
(All [a]
- (-> (-> a Bit) (Array a) (Maybe a)))
+ (-> (Predicate a) (Array a) (Maybe a)))
(let [arr-size (size xs)]
(loop [idx 0]
(if (n.< arr-size idx)
@@ -237,14 +237,14 @@
ys
(#.Some x)
- (write idx x ys)))
+ (write! idx x ys)))
(new arr-size)
(list.indices arr-size))))
(def: #export (from-list xs)
(All [a] (-> (List a) (Array a)))
(product.right (list@fold (function (_ x [idx arr])
- [(inc idx) (write idx x arr)])
+ [(inc idx) (write! idx x arr)])
[0 (new (list.size xs))]
xs)))
@@ -254,7 +254,7 @@
(All [a] (-> (Array a) (List a)))
(loop [idx (dec (size array))
output #.Nil]
- (if (n.= underflow idx)
+ (if (n.= ..underflow idx)
output
(recur (dec idx)
(case (read idx array)
@@ -268,7 +268,7 @@
(All [a] (-> a (Array a) (List a)))
(loop [idx (dec (size array))
output #.Nil]
- (if (n.= underflow idx)
+ (if (n.= ..underflow idx)
output
(recur (dec idx)
(#.Cons (maybe.default default (read idx array))
@@ -276,6 +276,7 @@
(structure: #export (equivalence (^open ",@."))
(All [a] (-> (Equivalence a) (Equivalence (Array a))))
+
(def: (= xs ys)
(let [sxs (size xs)
sxy (size ys)]
@@ -294,17 +295,21 @@
true
(list.indices sxs))))))
-(structure: #export monoid (All [a] (Monoid (Array a)))
+(structure: #export monoid
+ (All [a] (Monoid (Array a)))
+
(def: identity (new 0))
(def: (compose xs ys)
(let [sxs (size xs)
sxy (size ys)]
(|> (new (n.+ sxy sxs))
- (copy sxs 0 xs 0)
- (copy sxy 0 ys sxs)))))
+ (copy! sxs 0 xs 0)
+ (copy! sxy 0 ys sxs)))))
-(structure: #export functor (Functor Array)
+(structure: #export functor
+ (Functor Array)
+
(def: (map f ma)
(let [arr-size (size ma)]
(if (n.= 0 arr-size)
@@ -315,12 +320,14 @@
mb
(#.Some x)
- (write idx (f x) mb)))
+ (write! idx (f x) mb)))
(new arr-size)
(list.indices arr-size))
))))
-(structure: #export fold (Fold Array)
+(structure: #export fold
+ (Fold Array)
+
(def: (fold f init xs)
(let [arr-size (size xs)]
(loop [so-far init
@@ -337,7 +344,7 @@
(template [<name> <init> <op>]
[(def: #export (<name> predicate array)
(All [a]
- (-> (Predicate a) (Array a) Bit))
+ (-> (Predicate a) (Predicate (Array a))))
(let [size (..size array)]
(loop [idx 0]
(if (n.< size idx)
diff --git a/stdlib/source/lux/data/collection/bits.lux b/stdlib/source/lux/data/collection/bits.lux
index 2529275a3..230b35fa9 100644
--- a/stdlib/source/lux/data/collection/bits.lux
+++ b/stdlib/source/lux/data/collection/bits.lux
@@ -12,14 +12,18 @@
[collection
["." array (#+ Array) ("#@." fold)]]]])
-(type: #export Chunk I64)
+(type: #export Chunk
+ I64)
-(def: #export chunk-size i64.width)
+(def: #export chunk-size
+ i64.width)
(type: #export Bits
(Array Chunk))
-(def: empty-chunk Chunk (.i64 0))
+(def: empty-chunk
+ Chunk
+ (.i64 0))
(def: #export empty
Bits
@@ -79,7 +83,7 @@
(|> (if (is? ..empty output)
(: Bits (array.new size|output))
output)
- (array.write idx|output (.i64 chunk))
+ (array.write! idx|output (.i64 chunk))
(recur (dec size|output))))
output)))))]
@@ -120,7 +124,7 @@
(|> (if (is? ..empty output)
(: Bits (array.new size|output))
output)
- (array.write idx (.i64 chunk))
+ (array.write! idx (.i64 chunk))
(recur (dec size|output)))
output))))))
@@ -147,7 +151,7 @@
(|> (if (is? ..empty output)
(: Bits (array.new size|output))
output)
- (array.write idx (.i64 chunk))
+ (array.write! idx (.i64 chunk))
(recur (dec size|output))))
output)))))]
@@ -156,7 +160,9 @@
[xor i64.xor]
)
-(structure: #export equivalence (Equivalence Bits)
+(structure: #export equivalence
+ (Equivalence Bits)
+
(def: (= reference sample)
(let [size (n.max (array.size reference)
(array.size sample))]
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index 61c82c49b..a71acfb44 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -15,8 +15,7 @@
["n" nat]]
[collection
["." list ("#@." fold functor monoid)]
- ["." array (#+ Array) ("#@." functor fold)]]]
- ])
+ ["." array (#+ Array) ("#@." functor fold)]]]])
## This implementation of Hash Array Mapped Trie (HAMT) is based on
## Clojure's PersistentHashMap implementation.
@@ -25,19 +24,23 @@
## Bitmaps are used to figure out which branches on a #Base node are
## populated. The number of bits that are 1s in a bitmap signal the
## size of the #Base node.
-(type: BitMap Nat)
+(type: BitMap
+ Nat)
## Represents the position of a node in a BitMap.
## It's meant to be a single bit set on a 32-bit word.
## The position of the bit reflects whether an entry in an analogous
## position exists within a #Base, as reflected in it's BitMap.
-(type: BitPosition Nat)
+(type: BitPosition
+ Nat)
## An index into an array.
-(type: Index Nat)
+(type: Index
+ Nat)
## A hash-code derived from a key during tree-traversal.
-(type: Hash-Code Nat)
+(type: Hash-Code
+ Nat)
## Represents the nesting level of a leaf or node, when looking-it-up
## while exploring the tree.
@@ -46,7 +49,8 @@
## A shift of 0 means root level.
## A shift of (* branching-exponent 1) means level 2.
## A shift of (* branching-exponent N) means level N+1.
-(type: Level Nat)
+(type: Level
+ Nat)
## Nodes for the tree data-structure that organizes the data inside
## Dictionaries.
@@ -128,27 +132,27 @@
(All [a] (-> Index a (Array a) (Array a)))
(let [old-size (array.size old-array)]
(|> (array.new (inc old-size))
- (array.copy idx 0 old-array 0)
- (array.write idx value)
- (array.copy (n.- idx old-size) idx old-array (inc idx)))))
+ (array.copy! idx 0 old-array 0)
+ (array.write! idx value)
+ (array.copy! (n.- idx old-size) idx old-array (inc idx)))))
## Creates a copy of an array with an index set to a particular value.
(def: (update! idx value array)
(All [a] (-> Index a (Array a) (Array a)))
- (|> array array.clone (array.write idx value)))
+ (|> array array.clone (array.write! idx value)))
## Creates a clone of the array, with an empty position at index.
(def: (vacant! idx array)
(All [a] (-> Index (Array a) (Array a)))
- (|> array array.clone (array.delete idx)))
+ (|> array array.clone (array.delete! idx)))
## Shrinks a copy of the array by removing the space at index.
(def: (remove! idx array)
(All [a] (-> Index (Array a) (Array a)))
(let [new-size (dec (array.size array))]
(|> (array.new new-size)
- (array.copy idx 0 array 0)
- (array.copy (n.- idx new-size) (inc idx) array idx))))
+ (array.copy! idx 0 array 0)
+ (array.copy! (n.- idx new-size) (inc idx) array idx))))
## Increases the level-shift by the branching-exponent, to explore
## levels further down the tree.
@@ -231,7 +235,7 @@
[insertion-idx node]
[(inc insertion-idx)
[(set-bit-position (->bit-position idx) bitmap)
- (array.write insertion-idx (#.Left sub-node) base)]])
+ (array.write! insertion-idx (#.Left sub-node) base)]])
)))
[0 [clean-bitmap
(array.new (dec h-size))]]
@@ -253,12 +257,12 @@
[(inc base-idx)
(case (array.read base-idx base)
(#.Some (#.Left sub-node))
- (array.write hierarchy-idx sub-node h-array)
+ (array.write! hierarchy-idx sub-node h-array)
(#.Some (#.Right [key' val']))
- (array.write hierarchy-idx
- (put' (level-up level) (:: Hash<k> hash key') key' val' Hash<k> empty)
- h-array)
+ (array.write! hierarchy-idx
+ (put' (level-up level) (:: Hash<k> hash key') key' val' Hash<k> empty)
+ h-array)
#.None
(undefined))]
@@ -326,8 +330,8 @@
## #Collisions node
## is added.
(#Collisions hash (|> (array.new 2)
- (array.write 0 [key' val'])
- (array.write 1 [key val])))
+ (array.write! 0 [key' val'])
+ (array.write! 1 [key val])))
## Otherwise, I can
## just keep using
## #Base nodes, so I
@@ -346,8 +350,8 @@
## KV-pair as a singleton node to it.
(#Hierarchy (inc base-count)
(|> (promote-base put' Hash<k> level bitmap base)
- (array.write (level-index level hash)
- (put' (level-up level) hash key val Hash<k> empty))))
+ (array.write! (level-index level hash)
+ (put' (level-up level) hash key val Hash<k> empty))))
## Otherwise, I just resize the #Base node to accommodate the
## new KV-pair.
(#Base (set-bit-position bit bitmap)
@@ -371,7 +375,7 @@
## contains the old #Collisions node, plus the new KV-pair.
(|> (#Base (bit-position level _hash)
(|> (array.new 1)
- (array.write 0 (#.Left node))))
+ (array.write! 0 (#.Left node))))
(put' level hash key val Hash<k>)))
))
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index 8c0ce748c..8d0dfab29 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -85,13 +85,13 @@
(if (n.= 0 level)
(#Base tail)
(|> (new-hierarchy [])
- (array.write 0 (new-path (level-down level) tail))
+ (array.write! 0 (new-path (level-down level) tail))
#Hierarchy)))
(def: (new-tail singleton)
(All [a] (-> a (Base a)))
(|> (array.new 1)
- (array.write 0 singleton)))
+ (array.write! 0 singleton)))
(def: (push-tail size level tail parent)
(All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a)))
@@ -113,14 +113,14 @@
(undefined))
)]
(|> (array.clone parent)
- (array.write sub-idx sub-node))))
+ (array.write! sub-idx sub-node))))
(def: (expand-tail val tail)
(All [a] (-> a (Base a) (Base a)))
(let [tail-size (array.size tail)]
(|> (array.new (inc tail-size))
- (array.copy tail-size 0 tail 0)
- (array.write tail-size val))))
+ (array.copy! tail-size 0 tail 0)
+ (array.write! tail-size val))))
(def: (put' level idx val hierarchy)
(All [a] (-> Level Index a (Hierarchy a) (Hierarchy a)))
@@ -128,14 +128,14 @@
(case (array.read sub-idx hierarchy)
(#.Some (#Hierarchy sub-node))
(|> (array.clone hierarchy)
- (array.write sub-idx (#Hierarchy (put' (level-down level) idx val sub-node))))
+ (array.write! sub-idx (#Hierarchy (put' (level-down level) idx val sub-node))))
(^multi (#.Some (#Base base))
(n.= 0 (level-down level)))
(|> (array.clone hierarchy)
- (array.write sub-idx (|> (array.clone base)
- (array.write (branch-idx idx) val)
- #Base)))
+ (array.write! sub-idx (|> (array.clone base)
+ (array.write! (branch-idx idx) val)
+ #Base)))
_
(undefined))))
@@ -156,12 +156,12 @@
(#Base _)
(undefined))]
(|> (array.clone hierarchy)
- (array.write sub-idx (#Hierarchy sub))
+ (array.write! sub-idx (#Hierarchy sub))
#.Some))
## Else...
(|> (array.clone hierarchy)
- (array.delete sub-idx)
+ (array.delete! sub-idx)
#.Some)
)))
@@ -216,8 +216,8 @@
(: (Hierarchy ($ 0))
(new-hierarchy []))}
(new-hierarchy []))
- (array.write 0 (#Hierarchy (get@ #root row)))
- (array.write 1 (new-path (get@ #level row) (get@ #tail row)))))
+ (array.write! 0 (#Hierarchy (get@ #root row)))
+ (array.write! 1 (new-path (get@ #level row) (get@ #tail row)))))
(update@ #level level-up))
## Otherwise, just push the current tail onto the root.
(|> row
@@ -281,8 +281,8 @@
(#try.Success (if (n.>= (tail-off row-size) idx)
(update@ #tail (for {@.old
(: (-> (Base ($ 0)) (Base ($ 0)))
- (|>> array.clone (array.write (branch-idx idx) val)))}
- (|>> array.clone (array.write (branch-idx idx) val)))
+ (|>> array.clone (array.write! (branch-idx idx) val)))}
+ (|>> array.clone (array.write! (branch-idx idx) val)))
row)
(update@ #root (put' (get@ #level row) idx val)
row)))
@@ -310,7 +310,7 @@
(|> row
(update@ #size dec)
(set@ #tail (|> (array.new new-tail-size)
- (array.copy new-tail-size 0 old-tail 0)))))
+ (array.copy! new-tail-size 0 old-tail 0)))))
(maybe.assume
(do maybe.monad
[new-tail (base-for (n.- 2 row-size) row)
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 2e7912550..0dcb32b6e 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -6,7 +6,9 @@
[hash (#+ Hash)]
[apply (#+ Apply)]
["." functor (#+ Functor)]
- ["." monad (#+ Monad do)]]])
+ ["." monad (#+ Monad do)]]
+ [meta
+ ["." location]]])
## (type: (Maybe a)
## #.None
@@ -123,7 +125,7 @@
+20)}
(case tokens
(^ (list else maybe))
- (let [g!temp (: Code [.dummy-location (#.Identifier ["" ""])])
+ (let [g!temp (: Code [location.dummy (#.Identifier ["" ""])])
code (` (case (~ maybe)
(#.Some (~ g!temp))
(~ g!temp)
diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux
index be4959726..eef378a75 100644
--- a/stdlib/source/lux/data/number/rev.lux
+++ b/stdlib/source/lux/data/number/rev.lux
@@ -170,25 +170,35 @@
(-> Rev Frac)
(|>> to-significand ("lux f64 /" frac-denominator)))
-(structure: #export equivalence (Equivalence Rev)
+(structure: #export equivalence
+ (Equivalence Rev)
+
(def: = ..=))
-(structure: #export order (Order Rev)
+(structure: #export order
+ (Order Rev)
+
(def: &equivalence ..equivalence)
(def: < ..<))
-(structure: #export enum (Enum Rev)
+(structure: #export enum
+ (Enum Rev)
+
(def: &order ..order)
(def: succ inc)
(def: pred dec))
-(structure: #export interval (Interval Rev)
+(structure: #export interval
+ (Interval Rev)
+
(def: &enum ..enum)
(def: top (.rev -1))
(def: bottom (.rev 0)))
(template [<name> <compose> <identity>]
- [(structure: #export <name> (Monoid Rev)
+ [(structure: #export <name>
+ (Monoid Rev)
+
(def: identity (:: interval <identity>))
(def: compose <compose>))]
@@ -203,7 +213,9 @@
(template [<struct> <codec> <char-bit-size> <error>]
[(with-expansions [<error-output> (as-is (#try.Failure ("lux text concat" <error> repr)))]
- (structure: #export <struct> (Codec Text Rev)
+ (structure: #export <struct>
+ (Codec Text Rev)
+
(def: (encode value)
(let [raw-output (:: <codec> encode (:coerce Nat value))
max-num-chars (//nat.+ (//nat./ <char-bit-size> 64)
@@ -254,53 +266,53 @@
## targeted by Lux.
(type: Digits (Array Nat))
-(def: (make-digits _)
+(def: (digits::new _)
(-> Any Digits)
(array.new //i64.width))
-(def: (digits-get idx digits)
+(def: (digits::get idx digits)
(-> Nat Digits Nat)
(|> digits (array.read idx) (maybe.default 0)))
-(def: digits-put
+(def: digits::put
(-> Nat Nat Digits Digits)
- array.write)
+ array.write!)
(def: (prepend left right)
(-> Text Text Text)
("lux text concat" left right))
-(def: (digits-times-5! idx output)
+(def: (digits::times-5! idx output)
(-> Nat Digits Digits)
(loop [idx idx
carry 0
output output]
(if (//int.>= +0 (.int idx))
- (let [raw (|> (digits-get idx output)
+ (let [raw (|> (digits::get idx output)
(//nat.* 5)
(//nat.+ carry))]
(recur (dec idx)
(//nat./ 10 raw)
- (digits-put idx (//nat.% 10 raw) output)))
+ (digits::put idx (//nat.% 10 raw) output)))
output)))
-(def: (digits-power power)
+(def: (digits::power power)
(-> Nat Digits)
(loop [times power
- output (|> (make-digits [])
- (digits-put power 1))]
+ output (|> (digits::new [])
+ (digits::put power 1))]
(if (//int.>= +0 (.int times))
(recur (dec times)
- (digits-times-5! power output))
+ (digits::times-5! power output))
output)))
-(def: (digits-to-text digits)
+(def: (digits::to-text digits)
(-> Digits Text)
(loop [idx (dec //i64.width)
all-zeroes? #1
output ""]
(if (//int.>= +0 (.int idx))
- (let [digit (digits-get idx digits)]
+ (let [digit (digits::get idx digits)]
(if (and (//nat.= 0 digit)
all-zeroes?)
(recur (dec idx) #1 output)
@@ -313,19 +325,19 @@
"0"
output))))
-(def: (digits-add param subject)
+(def: (digits::+ param subject)
(-> Digits Digits Digits)
(loop [idx (dec //i64.width)
carry 0
- output (make-digits [])]
+ output (digits::new [])]
(if (//int.>= +0 (.int idx))
(let [raw ($_ //nat.+
carry
- (digits-get idx param)
- (digits-get idx subject))]
+ (digits::get idx param)
+ (digits::get idx subject))]
(recur (dec idx)
(//nat./ 10 raw)
- (digits-put idx (//nat.% 10 raw) output)))
+ (digits::put idx (//nat.% 10 raw) output)))
output)))
(def: (text-to-digits input)
@@ -333,7 +345,7 @@
(let [length ("lux text size" input)]
(if (//nat.<= //i64.width length)
(loop [idx 0
- output (make-digits [])]
+ output (digits::new [])]
(if (//nat.< length idx)
(case ("lux text index" 0 ("lux text clip" idx (inc idx) input) "0123456789")
#.None
@@ -341,42 +353,44 @@
(#.Some digit)
(recur (inc idx)
- (digits-put idx digit output)))
+ (digits::put idx digit output)))
(#.Some output)))
#.None)))
-(def: (digits-lt param subject)
+(def: (digits::< param subject)
(-> Digits Digits Bit)
(loop [idx 0]
(and (//nat.< //i64.width idx)
- (let [pd (digits-get idx param)
- sd (digits-get idx subject)]
+ (let [pd (digits::get idx param)
+ sd (digits::get idx subject)]
(if (//nat.= pd sd)
(recur (inc idx))
(//nat.< pd sd))))))
-(def: (digits-sub-once! idx param subject)
+(def: (digits::-!' idx param subject)
(-> Nat Nat Digits Digits)
- (let [sd (digits-get idx subject)]
+ (let [sd (digits::get idx subject)]
(if (//nat.>= param sd)
- (digits-put idx (//nat.- param sd) subject)
+ (digits::put idx (//nat.- param sd) subject)
(let [diff (|> sd
(//nat.+ 10)
(//nat.- param))]
(|> subject
- (digits-put idx diff)
- (digits-sub-once! (dec idx) 1))))))
+ (digits::put idx diff)
+ (digits::-!' (dec idx) 1))))))
-(def: (digits-sub! param subject)
+(def: (digits::-! param subject)
(-> Digits Digits Digits)
(loop [idx (dec //i64.width)
output subject]
(if (//int.>= +0 (.int idx))
(recur (dec idx)
- (digits-sub-once! idx (digits-get idx param) output))
+ (digits::-!' idx (digits::get idx param) output))
output)))
-(structure: #export decimal (Codec Text Rev)
+(structure: #export decimal
+ (Codec Text Rev)
+
(def: (encode input)
(case (:coerce Nat input)
0
@@ -385,16 +399,16 @@
input
(let [last-idx (dec //i64.width)]
(loop [idx last-idx
- digits (make-digits [])]
+ digits (digits::new [])]
(if (//int.>= +0 (.int idx))
(if (//i64.set? idx input)
- (let [digits' (digits-add (digits-power (//nat.- idx last-idx))
- digits)]
+ (let [digits' (digits::+ (digits::power (//nat.- idx last-idx))
+ digits)]
(recur (dec idx)
digits'))
(recur (dec idx)
digits))
- ("lux text concat" "." (digits-to-text digits))
+ ("lux text concat" "." (digits::to-text digits))
)))))
(def: (decode input)
@@ -413,11 +427,11 @@
idx 0
output 0]
(if (//nat.< //i64.width idx)
- (let [power (digits-power idx)]
- (if (digits-lt power digits)
+ (let [power (digits::power idx)]
+ (if (digits::< power digits)
## Skip power
(recur digits (inc idx) output)
- (recur (digits-sub! power digits)
+ (recur (digits::-! power digits)
(inc idx)
(//i64.set (//nat.- idx (dec //i64.width)) output))))
(#try.Success (:coerce Rev output))))
@@ -427,6 +441,8 @@
(#try.Failure ("lux text concat" "Wrong syntax for Rev: " input))))
))
-(structure: #export hash (Hash Rev)
+(structure: #export hash
+ (Hash Rev)
+
(def: &equivalence ..equivalence)
(def: hash .nat))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 388bd3638..ecbdb80df 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -5,8 +5,8 @@
[functor
["." contravariant]]]
[control
- ["p" parser
- ["s" code (#+ Parser)]]]
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
[data
["." bit]
["." name]
@@ -29,8 +29,10 @@
[math
["." modular]]
[macro
- ["." code]
- [syntax (#+ syntax:)]]
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [meta
+ ["." location]]
["." type]])
(type: #export (Format a)
@@ -43,7 +45,7 @@
(def: (map f fb)
(|>> f fb)))
-(syntax: #export (format {fragments (p.many s.any)})
+(syntax: #export (format {fragments (<>.many <c>.any)})
{#.doc (doc "Text interpolation."
(format "Static part " (text static) " does not match URI: " uri))}
(wrap (.list (` ($_ "lux text concat" (~+ fragments))))))
@@ -71,7 +73,7 @@
[instant instant.Instant (:: instant.codec encode)]
[duration duration.Duration (:: duration.codec encode)]
[date date.Date (:: date.codec encode)]
- [location Location .location-description]
+ [location Location location.format]
)
(def: #export (mod modular)
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index 7678852a6..c5064c480 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -12,7 +12,9 @@
["." frac]]
["." text ("#@." monoid equivalence)]
[collection
- ["." list ("#@." functor fold)]]]])
+ ["." list ("#@." functor fold)]]]
+ [meta
+ ["." location]]])
## (type: (Code' w)
## (#.Bit Bit)
@@ -33,7 +35,7 @@
(template [<name> <type> <tag>]
[(def: #export (<name> x)
(-> <type> Code)
- [.dummy-location (<tag> x)])]
+ [location.dummy (<tag> x)])]
[bit Bit #.Bit]
[nat Nat #.Nat]
@@ -52,7 +54,7 @@
[(def: #export (<name> name)
{#.doc <doc>}
(-> Text Code)
- [.dummy-location (<tag> ["" name])])]
+ [location.dummy (<tag> ["" name])])]
[local-identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."]
[local-tag #.Tag "Produces a local tag (a tag with no module prefix)."])
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux
index ec23805c5..1155eaf93 100644
--- a/stdlib/source/lux/meta.lux
+++ b/stdlib/source/lux/meta.lux
@@ -8,16 +8,18 @@
["." try (#+ Try)]]
[data
["." product]
- ["." name ("#@." codec equivalence)]
["." maybe]
+ ["." text ("#@." monoid equivalence)]
+ ["." name ("#@." codec equivalence)]
[number
["n" nat]
["i" int]]
- ["." text ("#@." monoid equivalence)]
[collection
["." list ("#@." monoid monad)]]]
[macro
- ["." code]]])
+ ["." code]]]
+ [/
+ ["." location]])
## (type: (Meta a)
## (-> Lux (Try [Lux a])))
@@ -684,7 +686,7 @@
(do ..monad
[location ..location
output (<func> token)
- #let [_ (log! ($_ text@compose (name@encode (name-of <macro>)) " @ " (.location-description location)))
+ #let [_ (log! ($_ text@compose (name@encode (name-of <macro>)) " @ " (location.format location)))
_ (list@map (|>> code.to-text log!)
output)
_ (log! "")]]
diff --git a/stdlib/source/lux/meta/location.lux b/stdlib/source/lux/meta/location.lux
new file mode 100644
index 000000000..351ace90c
--- /dev/null
+++ b/stdlib/source/lux/meta/location.lux
@@ -0,0 +1,30 @@
+(.module:
+ [lux #*])
+
+(def: #export dummy
+ Location
+ {#.module ""
+ #.line 0
+ #.column 0})
+
+(macro: #export (here tokens compiler)
+ (case tokens
+ #.Nil
+ (let [location (get@ #.location compiler)]
+ (#.Right [compiler
+ (list (` [(~ [..dummy (#.Text (get@ #.module location))])
+ (~ [..dummy (#.Nat (get@ #.line location))])
+ (~ [..dummy (#.Nat (get@ #.column location))])]))]))
+
+ _
+ (#.Left "Wrong syntax for here")))
+
+(def: #export (format value)
+ (-> Location Text)
+ (let [separator ","
+ [file line column] value]
+ ($_ "lux text concat"
+ "@"
+ (("lux in-module" "lux" .text@encode) file) separator
+ (("lux in-module" "lux" .nat@encode) line) separator
+ (("lux in-module" "lux" .nat@encode) column))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
index 96296a39a..18189b405 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
@@ -20,7 +20,9 @@
["." text ("#@." equivalence)
["%" format (#+ Format format)]]
[collection
- ["." list ("#@." functor fold)]]]]
+ ["." list ("#@." functor fold)]]]
+ [meta
+ ["." location]]]
[//
[phase
["." extension (#+ Extension)]]
@@ -522,7 +524,7 @@
(def: dummy-source
Source
- [.dummy-location 0 ""])
+ [location.dummy 0 ""])
(def: type-context
Type-Context
@@ -540,7 +542,7 @@
(-> Info Lux)
{#.info info
#.source ..dummy-source
- #.location .dummy-location
+ #.location location.dummy
#.current-module #.None
#.modules (list)
#.scopes (list)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux
index e490ba168..41c99534a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -7,7 +7,8 @@
[data
[text
["%" format (#+ format)]]]
- ["." meta]]
+ ["." meta
+ ["." location]]]
["." / #_
["#." type]
["#." primitive]
@@ -128,7 +129,7 @@
(/function.apply compile argsC+ functionT functionA archive functionC)))
_
- (//.throw unrecognized-syntax [.dummy-location code'])))
+ (//.throw unrecognized-syntax [location.dummy code'])))
(def: #export (phase expander)
(-> Expander Phase)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
index c0bf41a7e..f05b0e1ba 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
@@ -88,7 +88,7 @@
(def: (named-type location id)
(-> Location Nat Type)
- (let [name (format "{New Type @ " (.location-description location) " " (%.nat id) "}")]
+ (let [name (format "{New Type " (format.location location) " " (%.nat id) "}")]
(#.Primitive name (list))))
(def: new-named-type
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index f7170adc4..8da9421e4 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -6,21 +6,22 @@
[control
["." function]
["." exception (#+ exception:)]
- ["p" parser
- ["s" code (#+ Parser)]]]
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
[data
+ ["." maybe]
["." text ("#@." monoid equivalence)]
["." name ("#@." equivalence codec)]
[number
["n" nat ("#@." decimal)]]
- ["." maybe]
[collection
["." array]
["." list ("#@." functor monoid fold)]]]
- ["." meta]
[macro
- ["." code]
- [syntax (#+ syntax:)]]])
+ [syntax (#+ syntax:)]
+ ["." code]]
+ ["." meta
+ ["." location]]])
(template [<name> <tag>]
[(def: #export (<name> type)
@@ -353,32 +354,46 @@
0 elem-type
_ (|> elem-type (array (dec depth)) (list) (#.Primitive array.type-name))))
-(syntax: #export (:log! {input (p.or s.identifier
- s.any)})
+(syntax: (new-secret-marker)
+ (meta.with-gensyms [g!_secret-marker_]
+ (wrap (list g!_secret-marker_))))
+
+(def: secret-marker
+ (`` (name-of (~~ (new-secret-marker)))))
+
+(syntax: #export (:log! {input (<>.or (<>.and <c>.identifier
+ (<>.maybe (<>.after (<c>.identifier! ..secret-marker) <c>.any)))
+ <c>.any)})
(case input
- (#.Left valueN)
+ (#.Left [valueN valueC])
(do meta.monad
[location meta.location
valueT (meta.find-type valueN)
#let [_ (log! ($_ text@compose
- (name@encode (name-of ..:log!)) " @ " (.location-description location) text.new-line
- "Value: " (name@encode valueN) text.new-line
- " Type: " (..to-text valueT) text.new-line))]]
+ (name@encode (name-of ..:log!)) " " (location.format location) text.new-line
+ "Expression: " (case valueC
+ (#.Some valueC)
+ (code.to-text valueC)
+
+ #.None
+ (name@encode valueN))
+ text.new-line
+ " Type: " (..to-text valueT)))]]
(wrap (list (code.identifier valueN))))
-
+
(#.Right valueC)
(meta.with-gensyms [g!value]
(wrap (list (` (.let [(~ g!value) (~ valueC)]
- (..:log! (~ g!value)))))))))
+ (..:log! (~ valueC) (~ (code.identifier ..secret-marker)) (~ g!value)))))))))
(def: type-parameters
(Parser (List Text))
- (s.tuple (p.some s.local-identifier)))
+ (<c>.tuple (<>.some <c>.local-identifier)))
(syntax: #export (:cast {type-vars type-parameters}
input
output
- {value (p.maybe s.any)})
+ {value (<>.maybe <c>.any)})
(let [casterC (` (: (All [(~+ (list@map code.local-identifier type-vars))]
(-> (~ input) (~ output)))
(|>> :assume)))]
@@ -395,7 +410,7 @@
(def: typed
(Parser Typed)
- (s.record (p.and s.any s.any)))
+ (<c>.record (<>.and <c>.any <c>.any)))
## TODO: Make sure the generated code always gets optimized away.
(syntax: #export (:share {type-vars type-parameters}
@@ -411,7 +426,7 @@
(syntax: #export (:by-example {type-vars type-parameters}
{exemplar typed}
- {extraction s.any})
+ {extraction <c>.any})
(wrap (list (` (:of ((~! :share)
[(~+ (list@map code.local-identifier type-vars))]
{(~ (get@ #type exemplar))
@@ -421,7 +436,7 @@
(exception: #export (hole-type {location Location} {type Type})
(exception.report
- ["Location" (.location-description location)]
+ ["Location" (location.format location)]
["Type" (..to-text type)]))
(syntax: #export (:hole)
diff --git a/stdlib/source/program/aedifex/artifact/extension.lux b/stdlib/source/program/aedifex/artifact/extension.lux
new file mode 100644
index 000000000..04d40fec4
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/extension.lux
@@ -0,0 +1,37 @@
+(.module:
+ [lux #*
+ [data
+ [text
+ ["%" format (#+ format)]]]]
+ ["." // #_
+ ["#" type]])
+
+(type: #export Extension
+ Text)
+
+(def: separator
+ ".")
+
+(def: #export extension
+ (-> //.Type Extension)
+ (|>> (format ..separator)))
+
+(def: #export lux-library
+ Extension
+ (..extension //.lux-library))
+
+(def: #export jvm-library
+ Extension
+ (..extension //.jvm-library))
+
+(def: #export pom
+ Extension
+ (..extension //.pom))
+
+(def: #export sha1
+ Extension
+ (format ..separator "sha1"))
+
+(def: #export md5
+ Extension
+ (format ..separator "md5"))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 3128bb3f3..52a1f00c5 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -29,10 +29,10 @@
[net (#+ URL)
["." uri]]]]
["." // #_
- ["#." extension]
["#." hash]
["#." artifact (#+ Artifact)
- ["#/." type]]])
+ ["#/." type]
+ ["#/." extension]]])
(type: #export Repository
URL)
@@ -219,10 +219,10 @@
(let [[artifact type] dependency
prefix (format repository uri.separator (//artifact.path artifact))]
(do (try.with io.monad)
- [library (..download (format prefix "." type))
- sha1 (..verified-hash dependency library (format prefix //extension.sha1) //hash.sha1 ..sha1 ..sha1-does-not-match)
- md5 (..verified-hash dependency library (format prefix //extension.md5) //hash.md5 ..md5 ..md5-does-not-match)
- pom (..download (format prefix //extension.pom))]
+ [library (..download (format prefix (//artifact/extension.extension type)))
+ sha1 (..verified-hash dependency library (format prefix //artifact/extension.sha1) //hash.sha1 ..sha1 ..sha1-does-not-match)
+ md5 (..verified-hash dependency library (format prefix //artifact/extension.md5) //hash.md5 ..md5 ..md5-does-not-match)
+ pom (..download (format prefix //artifact/extension.pom))]
(:: io.monad wrap
(do try.monad
[pom (encoding.from-utf8 pom)
diff --git a/stdlib/source/program/aedifex/extension.lux b/stdlib/source/program/aedifex/extension.lux
deleted file mode 100644
index 6caa343aa..000000000
--- a/stdlib/source/program/aedifex/extension.lux
+++ /dev/null
@@ -1,11 +0,0 @@
-(.module:
- [lux #*])
-
-(def: #export sha1
- ".sha1")
-
-(def: #export md5
- ".md5")
-
-(def: #export pom
- ".pom")
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 60b5e8881..affbb659e 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -30,12 +30,12 @@
["." export]]]
["." // #_
["/" profile (#+ Profile)]
- ["#." extension]
["#." pom]
["#." dependency (#+ Package Resolution Dependency)]
["#." hash]
["#." artifact (#+ Artifact)
- ["#/." type]]])
+ ["#/." type]
+ ["#/." extension]]])
(def: (local system)
(All [a] (-> (file.System a) Path))
@@ -79,10 +79,10 @@
#let [artifact-name (format repository (:: system separator) (//artifact.identity identity))]
package (export.library system (set.to-list (get@ #/.sources profile)))
_ (..save! system (binary.run tar.writer package)
- (format artifact-name "." //artifact/type.lux-library))
+ (format artifact-name //artifact/extension.lux-library))
pom (:: promise.monad wrap (//pom.project profile))]
(..save! system (|> pom (:: xml.codec encode) encoding.to-utf8)
- (format artifact-name //extension.pom)))
+ (format artifact-name //artifact/extension.pom)))
_
(:: promise.monad wrap (exception.throw /.no-identity []))))
@@ -96,16 +96,16 @@
(file.get-directory promise.monad system directory))
_ (..save! system
(get@ #//dependency.library package)
- (format prefix "." type))
+ (format prefix (//artifact/extension.extension type)))
_ (..save! system
(encoding.to-utf8 (get@ #//dependency.sha1 package))
- (format prefix //extension.sha1))
+ (format prefix //artifact/extension.sha1))
_ (..save! system
(encoding.to-utf8 (get@ #//dependency.md5 package))
- (format prefix //extension.md5))
+ (format prefix //artifact/extension.md5))
_ (..save! system
(|> package (get@ #//dependency.pom) (:: xml.codec encode) encoding.to-utf8)
- (format prefix //extension.pom))]
+ (format prefix //artifact/extension.pom))]
(wrap [])))
(def: #export (cache-all system resolution)
@@ -128,16 +128,16 @@
(do (try.with promise.monad)
[directory (..guarantee-repository! system artifact)
#let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
- pom (..read! system (format prefix //extension.pom))
+ pom (..read! system (format prefix //artifact/extension.pom))
[pom dependencies] (:: promise.monad wrap
(do try.monad
[pom (encoding.from-utf8 pom)
pom (:: xml.codec decode pom)
dependencies (//dependency.from-pom pom)]
(wrap [pom dependencies])))
- library (..read! system (format prefix "." type))
- sha1 (..read! system (format prefix //extension.sha1))
- md5 (..read! system (format prefix //extension.md5))]
+ library (..read! system (format prefix (//artifact/extension.extension type)))
+ sha1 (..read! system (format prefix //artifact/extension.sha1))
+ md5 (..read! system (format prefix //artifact/extension.md5))]
(wrap {#//dependency.library library
#//dependency.pom pom
#//dependency.dependencies dependencies
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 72715fdef..376f26717 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -10,7 +10,8 @@
[math
["." random (#+ Random)]]]
["." / #_
- ["#." type]]
+ ["#." type]
+ ["#." extension]]
{#program
["." /]})
@@ -31,4 +32,5 @@
($equivalence.spec /.equivalence ..random))
/type.test
+ /extension.test
))))
diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux
new file mode 100644
index 000000000..e65dd567a
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/extension.lux
@@ -0,0 +1,40 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." text ("#@." equivalence)]
+ [number
+ ["n" nat]]
+ [collection
+ ["." set]
+ ["." list]]]
+ [math
+ ["." random (#+ Random)]]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#" type]]]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Extension]
+ ($_ _.and
+ (_.cover [/.lux-library /.jvm-library /.pom
+ /.sha1 /.md5]
+ (let [options (list /.lux-library /.jvm-library /.pom /.sha1 /.md5)
+ uniques (set.from-list text.hash options)]
+ (n.= (list.size options)
+ (set.size uniques))))
+ (_.cover [/.extension]
+ (`` (and (~~ (template [<type> <extension>]
+ [(text@= <extension>
+ (/.extension <type>))]
+
+ [//.lux-library /.lux-library]
+ [//.jvm-library /.jvm-library]
+ [//.pom /.pom]
+ )))))
+ ))))
diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux
index 63366a81d..4cd81db10 100644
--- a/stdlib/source/test/lux/data/collection/array.lux
+++ b/stdlib/source/test/lux/data/collection/array.lux
@@ -1,25 +1,24 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
- [monad (#+ do Monad)]
+ [monad (#+ do)]
{[0 #spec]
[/
["$." equivalence]
["$." monoid]
["$." fold]
["$." functor (#+ Injection)]]}]
- [control
- pipe]
[data
+ ["." bit]
["." maybe]
[number
["n" nat]]
[collection
- ["." list]]]
+ ["." list]
+ ["." set]]]
[math
- ["r" random (#+ Random)]]]
+ ["." random (#+ Random)]]]
{1
["." / (#+ Array)]})
@@ -29,90 +28,167 @@
(def: bounded-size
(Random Nat)
- (|> r.nat
- (:: r.monad map (|>> (n.% 100) (n.+ 1)))))
+ (:: random.monad map (|>> (n.% 100) (n.+ 1))
+ random.nat))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.Array)))
- (do {@ r.monad}
- [size bounded-size]
+ (<| (_.covering /._)
+ (_.with-cover [/.Array])
+ (do {@ random.monad}
+ [size ..bounded-size
+ base random.nat
+ shift random.nat
+ dummy (random.filter (|>> (n.= base) not) random.nat)
+ #let [expected (n.+ base shift)]
+ the-array (random.array size random.nat)]
($_ _.and
- ($equivalence.spec (/.equivalence n.equivalence) (r.array size r.nat))
- ($monoid.spec (/.equivalence n.equivalence) /.monoid (r.array size r.nat))
- ($functor.spec ..injection /.equivalence /.functor)
- ($fold.spec ..injection /.equivalence /.fold)
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat)))
+ (_.with-cover [/.monoid]
+ ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat)))
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection /.equivalence /.functor))
+ (_.with-cover [/.fold]
+ ($fold.spec ..injection /.equivalence /.fold))
+ (_.cover [/.new /.size]
+ (n.= size (/.size (: (Array Nat)
+ (/.new size)))))
+ (_.cover [/.read /.write!]
+ (let [the-array (|> (/.new 2)
+ (: (Array Nat))
+ (/.write! 0 expected))]
+ (case [(/.read 0 the-array)
+ (/.read 1 the-array)]
+ [(#.Some actual) #.None]
+ (n.= expected actual)
+
+ _
+ false)))
+ (_.cover [/.delete!]
+ (let [the-array (|> (/.new 1)
+ (: (Array Nat))
+ (/.write! 0 expected))]
+ (case [(/.read 0 the-array)
+ (/.read 0 (/.delete! 0 the-array))]
+ [(#.Some actual) #.None]
+ (n.= expected actual)
+
+ _
+ false)))
+ (_.cover [/.contains?]
+ (let [the-array (|> (/.new 2)
+ (: (Array Nat))
+ (/.write! 0 expected))]
+ (and (/.contains? 0 the-array)
+ (not (/.contains? 1 the-array)))))
+
+ (_.cover [/.update!]
+ (let [the-array (|> (/.new 1)
+ (: (Array Nat))
+ (/.write! 0 base)
+ (/.update! 0 (n.+ shift)))]
+ (case (/.read 0 the-array)
+ (#.Some actual)
+ (n.= expected actual)
+
+ _
+ false)))
+ (_.cover [/.upsert!]
+ (let [the-array (|> (/.new 2)
+ (: (Array Nat))
+ (/.write! 0 base)
+ (/.upsert! 0 dummy (n.+ shift))
+ (/.upsert! 1 base (n.+ shift)))]
+ (case [(/.read 0 the-array)
+ (/.read 1 the-array)]
+ [(#.Some actual/0) (#.Some actual/1)]
+ (and (n.= expected actual/0)
+ (n.= expected actual/1))
+
+ _
+ false)))
+ (do @
+ [occupancy (:: @ map (n.% (inc size)) random.nat)]
+ (_.cover [/.occupancy /.vacancy]
+ (let [the-array (loop [output (: (Array Nat)
+ (/.new size))
+ idx 0]
+ (if (n.< occupancy idx)
+ (recur (/.write! idx expected output)
+ (inc idx))
+ output))]
+ (and (n.= occupancy (/.occupancy the-array))
+ (n.= size (n.+ (/.occupancy the-array)
+ (/.vacancy the-array)))))))
(do @
- [size bounded-size
- original (r.array size r.nat)]
- ($_ _.and
- (_.test "Size function must correctly return size of array."
- (n.= size (/.size original)))
- (_.test "Cloning an array should yield and identical array, but not the same one."
- (let [clone (/.clone original)]
- (and (:: (/.equivalence n.equivalence) = original clone)
- (not (is? original clone)))))
- (_.test "Full-range manual copies should give the same result as cloning."
- (let [copy (: (Array Nat)
- (/.new size))]
- (exec (/.copy size 0 original 0 copy)
- (and (:: (/.equivalence n.equivalence) = original copy)
- (not (is? original copy))))))
- (_.test "Array folding should go over all values."
- (let [manual-copy (: (Array Nat)
- (/.new size))]
- (exec (:: /.fold fold
- (function (_ x idx)
- (exec (/.write idx x manual-copy)
- (inc idx)))
- 0
- original)
- (:: (/.equivalence n.equivalence) = original manual-copy))))
- (_.test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
- (|> original
- /.to-list /.from-list
- (:: (/.equivalence n.equivalence) = original)))
- ))
+ [the-list (random.list size random.nat)]
+ (_.cover [/.from-list /.to-list]
+ (and (|> the-list /.from-list /.to-list
+ (:: (list.equivalence n.equivalence) = the-list))
+ (|> the-array /.to-list /.from-list
+ (:: (/.equivalence n.equivalence) = the-array)))))
(do @
- [size bounded-size
- idx (:: @ map (n.% size) r.nat)
- array (|> (r.array size r.nat)
- (r.filter (|>> /.to-list (list.any? n.odd?))))
- #let [value (maybe.assume (/.read idx array))]]
- ($_ _.and
- (_.test "Shouldn't be able to find a value in an unoccupied cell."
- (case (/.read idx (/.delete idx array))
- (#.Some _) false
- #.None true))
- (_.test "You should be able to access values put into the array."
- (case (/.read idx (/.write idx value array))
- (#.Some value') (n.= value' value)
- #.None false))
- (_.test "All cells should be occupied on a full array."
- (and (n.= size (/.occupied array))
- (n.= 0 (/.vacant array))))
- (_.test "Filtering mutates the array to remove invalid values."
- (exec (/.filter! n.even? array)
- (and (n.< size (/.occupied array))
- (n.> 0 (/.vacant array))
- (n.= size (n.+ (/.occupied array)
- (/.vacant array))))))
- ))
+ [amount (:: @ map (n.% (inc size)) random.nat)]
+ (_.cover [/.copy!]
+ (let [copy (: (Array Nat)
+ (/.new size))]
+ (exec (/.copy! amount 0 the-array 0 copy)
+ (:: (list.equivalence n.equivalence) =
+ (list.take amount (/.to-list the-array))
+ (/.to-list copy))))))
+ (_.cover [/.clone]
+ (let [clone (/.clone the-array)]
+ (and (not (is? the-array clone))
+ (:: (/.equivalence n.equivalence) = the-array clone))))
+ (let [the-array (/.clone the-array)
+ evens (|> the-array /.to-list (list.filter n.even?))
+ odds (|> the-array /.to-list (list.filter n.odd?))]
+ (_.cover [/.filter!]
+ (exec (/.filter! n.even? the-array)
+ (and (n.= (list.size evens) (/.occupancy the-array))
+ (n.= (list.size odds) (/.vacancy the-array))
+ (|> the-array /.to-list (:: (list.equivalence n.equivalence) = evens))))))
(do @
- [size bounded-size
- array (|> (r.array size r.nat)
- (r.filter (|>> /.to-list (list.any? n.even?))))]
- ($_ _.and
- (_.test "Can find values inside arrays."
- (|> (/.find n.even? array)
- (case> (#.Some _) true
- #.None false)))
- (_.test "Can find values inside arrays (with access to indices)."
- (|> (/.find+ (function (_ idx n)
- (and (n.even? n)
- (n.< size idx)))
- array)
- (case> (#.Some _) true
- #.None false)))))
+ [#let [the-array (/.clone the-array)
+ members (|> the-array /.to-list (set.from-list n.hash))]
+ default (random.filter (function (_ value)
+ (not (or (n.even? value)
+ (set.member? members value))))
+ random.nat)]
+ (_.cover [/.to-list']
+ (exec (/.filter! n.even? the-array)
+ (list.every? (function (_ value)
+ (or (n.even? value)
+ (is? default value)))
+ (/.to-list' default the-array)))))
+ (_.cover [/.find]
+ (:: (maybe.equivalence n.equivalence) =
+ (/.find n.even? the-array)
+ (list.find n.even? (/.to-list the-array))))
+ (_.cover [/.find+]
+ (case [(/.find n.even? the-array)
+ (/.find+ (function (_ idx member)
+ (n.even? member))
+ the-array)]
+ [(#.Some expected) (#.Some [idx actual])]
+ (case (/.read idx the-array)
+ (#.Some again)
+ (and (n.= expected actual)
+ (n.= actual again))
+
+ #.None
+ false)
+
+ [#.None #.None]
+ true))
+ (_.cover [/.every?]
+ (:: bit.equivalence =
+ (list.every? n.even? (/.to-list the-array))
+ (/.every? n.even? the-array)))
+ (_.cover [/.any?]
+ (:: bit.equivalence =
+ (list.any? n.even? (/.to-list the-array))
+ (/.any? n.even? the-array)))
))))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index eec419644..717d4be94 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -17,6 +17,8 @@
["n" nat]]
[collection
["." list ("#@." functor)]]]
+ [meta
+ ["." location]]
[tool
[compiler
[language
@@ -69,7 +71,7 @@
syntax.no-aliases
(text.size source-code))
start (: Source
- [.dummy-location 0 source-code])]
+ [location.dummy 0 source-code])]
(case (parse start)
(#.Left [end error])
(#try.Failure error)
@@ -132,7 +134,7 @@
(#try.Failure error)
false)
(:: /.equivalence =
- [.dummy-location (<tag> expected)]
+ [location.dummy (<tag> expected)]
(<coverage> expected)))))]
[/.bit random.bit #.Bit]
@@ -159,7 +161,7 @@
(#try.Failure error)
false)
(:: /.equivalence =
- [.dummy-location (<tag> ["" expected])]
+ [location.dummy (<tag> ["" expected])]
(<coverage> expected)))
))]
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index 1f5e2c5fa..18bc370c2 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -15,6 +15,8 @@
["%" format (#+ format)]]
[number
["n" nat]]]
+ [meta
+ ["." location]]
[math
["." random (#+ Random)]]]
{1
@@ -46,8 +48,8 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
- #.location .dummy-location
+ #.source [location.dummy 0 source-code]
+ #.location location.dummy
#.current-module (#.Some expected-current-module)
#.modules (list)
#.scopes (list)
@@ -93,8 +95,8 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
- #.location .dummy-location
+ #.source [location.dummy 0 source-code]
+ #.location location.dummy
#.current-module (#.Some expected-current-module)
#.modules (list)
#.scopes (list)
@@ -167,8 +169,8 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
- #.location .dummy-location
+ #.source [location.dummy 0 source-code]
+ #.location location.dummy
#.current-module (#.Some expected-current-module)
#.modules (list)
#.scopes (list)
@@ -245,7 +247,7 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
+ #.source [location.dummy 0 source-code]
#.location expected-location
#.current-module (#.Some expected-current-module)
#.modules (list)
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index e1c4dbfe3..7df1cdd07 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -229,38 +229,36 @@
(|>> (:coerce java/lang/Double) host.double-to-float)
random.frac))
(def: $Float::literal /.float)
+(def: valid-float
+ (Random java/lang/Float)
+ (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not)
+ ..$Float::random))
(def: $Float::primitive
(Primitive java/lang/Float)
{#unboxed /type.float
#boxed ..$Float
#wrap ..$Float::wrap
- #random ..$Float::random
+ #random ..valid-float
#literal ..$Float::literal})
-(def: valid-float
- (Random java/lang/Float)
- (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not)
- ..$Float::random))
-
(def: $Double (/type.class "java.lang.Double" (list)))
(def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))
(def: $Double::random (:coerce (Random java/lang/Double) random.frac))
(def: $Double::literal
(-> java/lang/Double (Bytecode Any))
(|>> (:coerce Frac) /.double))
+(def: valid-double
+ (Random java/lang/Double)
+ (random.filter (|>> (:coerce Frac) f.not-a-number? not)
+ ..$Double::random))
(def: $Double::primitive
(Primitive java/lang/Double)
{#unboxed /type.double
#boxed ..$Double
#wrap ..$Double::wrap
- #random ..$Double::random
+ #random ..valid-double
#literal ..$Double::literal})
-(def: valid-double
- (Random java/lang/Double)
- (random.filter (|>> (:coerce Frac) f.not-a-number? not)
- ..$Double::random))
-
(def: $Character
(/type.class "java.lang.Character" (list)))
(def: $Character::wrap
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
index c6ac62bc5..819f6ccf1 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
@@ -18,7 +18,9 @@
["." list]
["." dictionary (#+ Dictionary)]]]
[macro
- ["." code]]]
+ ["." code]]
+ [meta
+ ["." location]]]
{1
["." /]})
@@ -77,7 +79,7 @@
(_.test "Can parse Lux code."
(case (let [source-code (%.code sample)]
(/.parse "" (dictionary.new text.hash) (text.size source-code)
- [.dummy-location 0 source-code]))
+ [location.dummy 0 source-code]))
(#.Left error)
false
@@ -89,7 +91,7 @@
(let [source-code (format (%.code sample) " " (%.code other))
source-code//size (text.size source-code)]
(case (/.parse "" (dictionary.new text.hash) source-code//size
- [.dummy-location 0 source-code])
+ [location.dummy 0 source-code])
(#.Left error)
false
@@ -127,7 +129,7 @@
(case (let [source-code (format comment (%.code sample))
source-code//size (text.size source-code)]
(/.parse "" (dictionary.new text.hash) source-code//size
- [.dummy-location 0 source-code]))
+ [location.dummy 0 source-code]))
(#.Left error)
false