aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/predicate.lux5
-rw-r--r--stdlib/source/lux/data/collection/array.lux23
-rw-r--r--stdlib/source/lux/data/collection/row.lux31
-rw-r--r--stdlib/source/lux/data/collection/set.lux7
-rw-r--r--stdlib/source/lux/language/compiler/synthesis.lux10
-rw-r--r--stdlib/source/lux/language/compiler/translation.lux114
-rw-r--r--stdlib/test/test/lux/data/collection/row.lux6
7 files changed, 143 insertions, 53 deletions
diff --git a/stdlib/source/lux/control/predicate.lux b/stdlib/source/lux/control/predicate.lux
index 72fe8165f..1d683bf5a 100644
--- a/stdlib/source/lux/control/predicate.lux
+++ b/stdlib/source/lux/control/predicate.lux
@@ -1,7 +1,6 @@
(.module:
[lux #*
[control [monoid (#+ Monoid)]]
- [data [collection [set (#+ Set)]]]
[function]])
(type: #export (Predicate a)
@@ -41,10 +40,6 @@
(and (base value)
(not (sub value)))))
-(def: #export (set set)
- (All [a] (-> (Set a) (Predicate a)))
- (set.member? set))
-
(def: #export (rec predicate)
(All [a]
(-> (-> (Predicate a) (Predicate a))
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index a4fe01a35..7093de9a1 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -4,7 +4,8 @@
[monoid (#+ Monoid)]
[functor (#+ Functor)]
[equivalence (#+ Equivalence)]
- fold]
+ fold
+ [predicate (#+ Predicate)]]
[data
[collection [list ("list/" Fold<List>)]]
[product]]
@@ -211,3 +212,23 @@
(#.Some value)
(recur (f value so-far) (inc idx)))
so-far)))))
+
+(do-template [<name> <init> <op>]
+ [(def: #export (<name> predicate array)
+ (All [a]
+ (-> (Predicate a) (Array a) Bit))
+ (let [size (..size array)]
+ (loop [idx +0]
+ (if (n/< size idx)
+ (case (..read idx array)
+ (#.Some value)
+ (<op> (predicate value)
+ (recur (inc idx)))
+
+ #.None
+ (recur (inc idx)))
+ <init>))))]
+
+ [every? #1 and]
+ [any? #0 or]
+ )
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index 7ae37ebea..23e5ded20 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -7,7 +7,8 @@
[equivalence (#+ Equivalence)]
monoid
fold
- ["p" parser]]
+ ["p" parser]
+ [predicate (#+ Predicate)]]
[data
[maybe]
[product]
@@ -15,7 +16,7 @@
[i64]]
[collection
[list ("list/" Fold<List> Functor<List> Monoid<List>)]
- [array ("array/" Functor<Array> Fold<Array>)]]]
+ ["." array ("array/" Functor<Array> Fold<Array>)]]]
[macro (#+ with-gensyms)
[code]
["s" syntax (#+ syntax: Syntax)]]
@@ -434,8 +435,30 @@
(^open) Monoid<Row>]
(fold (function (_ post pre) (compose pre post)) identity))))
-(def: #export (reverse xs)
+(def: #export reverse
(All [a] (-> (Row a) (Row a)))
(let [(^open) Fold<Row>
(^open) Monoid<Row>]
- (fold add identity xs)))
+ (fold add identity)))
+
+(do-template [<name> <array> <init> <op>]
+ [(def: #export <name>
+ (All [a]
+ (-> (Predicate a) (Row a) Bit))
+ (let [help (: (All [a]
+ (-> (Predicate a) (Node a) Bit))
+ (function (help predicate node)
+ (case node
+ (#Base base)
+ (<array> predicate base)
+
+ (#Hierarchy hierarchy)
+ (<array> (help predicate) hierarchy))))]
+ (function (<name> predicate row)
+ (let [(^slots [#root #tail]) row]
+ (<op> (help predicate (#Hierarchy root))
+ (help predicate (#Base tail)))))))]
+
+ [every? array.every? #1 and]
+ [any? array.any? #0 or]
+ )
diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux
index 11381c683..d78ae6d19 100644
--- a/stdlib/source/lux/data/collection/set.lux
+++ b/stdlib/source/lux/data/collection/set.lux
@@ -2,7 +2,8 @@
[lux #*
[control
[equivalence (#+ Equivalence)]
- [hash (#+ Hash)]]
+ [hash (#+ Hash)]
+ [predicate (#+ Predicate)]]
[data
[collection
["dict" dictionary (#+ Dictionary)]
@@ -82,3 +83,7 @@
(def: #export (super? sub super)
(All [a] (-> (Set a) (Set a) Bit))
(sub? super sub))
+
+(def: #export predicate
+ (All [a] (-> (Set a) (Predicate a)))
+ ..member?)
diff --git a/stdlib/source/lux/language/compiler/synthesis.lux b/stdlib/source/lux/language/compiler/synthesis.lux
index 3d6762342..baea48c30 100644
--- a/stdlib/source/lux/language/compiler/synthesis.lux
+++ b/stdlib/source/lux/language/compiler/synthesis.lux
@@ -227,6 +227,16 @@
[variable/foreign reference.foreign]
)
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (.<| #..Reference
+ <tag>
+ content))]
+
+ [variable reference.variable]
+ [constant reference.constant]
+ )
+
(do-template [<name> <family> <tag>]
[(template: #export (<name> content)
(.<| #..Control
diff --git a/stdlib/source/lux/language/compiler/translation.lux b/stdlib/source/lux/language/compiler/translation.lux
index 077076d2f..b822d3cf8 100644
--- a/stdlib/source/lux/language/compiler/translation.lux
+++ b/stdlib/source/lux/language/compiler/translation.lux
@@ -4,8 +4,9 @@
["ex" exception (#+ exception:)]
[monad (#+ do)]]
[data
- [maybe ("maybe/" Functor<Maybe>)]
+ [product]
[error (#+ Error)]
+ [ident ("ident/" Equivalence<Ident> Codec<Text,Ident>)]
["." text
format]
[collection
@@ -28,46 +29,58 @@
(exception: #export (cannot-interpret {message Text})
message)
+(do-template [<name>]
+ [(exception: #export (<name> {name Ident})
+ (ex.report ["Artifact" (ident/encode name)]))]
+
+ [cannot-overwrite-artifact]
+ [no-buffer-for-saving-code]
+ )
+
(type: #export Context
{#scope-name Text
#inner-functions Nat})
-(signature: #export (Host code)
- (: (-> code (Error Any))
- execute!)
- (: (-> code (Error Any))
- evaluate!))
+(signature: #export (Host expression statement)
+ (: (-> expression (Error Any))
+ evaluate!)
+ (: (-> statement (Error Any))
+ execute!))
-(type: #export (Buffer code) (Row [Ident code]))
+(type: #export (Buffer statement) (Row [Ident statement]))
-(type: #export (Artifacts code) (Dictionary File (Buffer code)))
+(type: #export (Artifacts statement) (Dictionary File (Buffer statement)))
-(type: #export (State anchor code)
+(type: #export (State anchor expression statement)
{#context Context
#anchor (Maybe anchor)
- #host (Host code)
- #buffer (Maybe (Buffer code))
- #artifacts (Artifacts code)})
+ #host (Host expression statement)
+ #buffer (Maybe (Buffer statement))
+ #artifacts (Artifacts statement)
+ #counter Nat})
-(type: #export (Operation anchor code)
- (extension.Operation (State anchor code) Synthesis code))
+(type: #export (Operation anchor expression statement)
+ (extension.Operation (State anchor expression statement) Synthesis expression))
-(type: #export (Compiler anchor code)
- (extension.Compiler (State anchor code) Synthesis code))
+(type: #export (Compiler anchor expression statement)
+ (extension.Compiler (State anchor expression statement) Synthesis expression))
(def: #export (init host)
- (All [anchor code] (-> (Host code) (..State anchor code)))
+ (All [anchor expression statement]
+ (-> (Host expression statement)
+ (..State anchor expression statement)))
{#context {#scope-name ""
#inner-functions +0}
#anchor #.None
#host host
#buffer #.None
- #artifacts (dict.new text.Hash<Text>)})
+ #artifacts (dict.new text.Hash<Text>)
+ #counter +0})
(def: #export (with-context expr)
- (All [anchor code output]
- (-> (Operation anchor code output)
- (Operation anchor code [Text output])))
+ (All [anchor expression statement output]
+ (-> (Operation anchor expression statement output)
+ (Operation anchor expression statement [Text output])))
(function (_ [bundle state])
(let [[old-scope old-inner] (get@ #context state)
new-scope (format old-scope "c___" (%i (.int old-inner)))]
@@ -80,7 +93,8 @@
(#error.Error error)))))
(def: #export context
- (All [anchor code] (Operation anchor code Text))
+ (All [anchor expression statement]
+ (Operation anchor expression statement Text))
(extension.read (|>> (get@ #context)
(get@ #scope-name))))
@@ -88,7 +102,7 @@
<with-declaration> <with-type> <with-value>
<get> <get-type> <exception>]
[(def: #export <with-declaration>
- (All [anchor code output] <with-type>)
+ (All [anchor expression statement output] <with-type>)
(function (_ body)
(function (_ [bundle state])
(case (body [bundle (set@ <tag> (#.Some <with-value>) state)])
@@ -100,7 +114,8 @@
(#error.Error error)))))
(def: #export <get>
- (All [anchor code] (Operation anchor code <get-type>))
+ (All [anchor expression statement]
+ (Operation anchor expression statement <get-type>))
(function (_ (^@ stateE [bundle state]))
(case (get@ <tag> state)
(#.Some output)
@@ -111,28 +126,35 @@
[#anchor
(with-anchor anchor)
- (-> anchor (Operation anchor code output)
- (Operation anchor code output))
+ (-> anchor (Operation anchor expression statement output)
+ (Operation anchor expression statement output))
anchor
anchor anchor no-anchor]
[#buffer
with-buffer
- (-> (Operation anchor code output)
- (Operation anchor code output))
+ (-> (Operation anchor expression statement output)
+ (Operation anchor expression statement output))
row.empty
- buffer (Buffer code) no-active-buffer]
+ buffer (Buffer statement) no-active-buffer]
)
(def: #export artifacts
- (All [anchor code]
- (Operation anchor code (Artifacts code)))
+ (All [anchor expression statement]
+ (Operation anchor expression statement (Artifacts statement)))
(extension.read (get@ #artifacts)))
-(do-template [<name>]
+(def: #export next
+ (All [anchor expression statement]
+ (Operation anchor expression statement Nat))
+ (do //.Monad<Operation>
+ [_ (extension.update (update@ #counter inc))]
+ (extension.read (get@ #counter))))
+
+(do-template [<name> <inputT>]
[(def: #export (<name> code)
- (All [anchor code]
- (-> code (Operation anchor code Any)))
+ (All [anchor expression statement]
+ (-> <inputT> (Operation anchor expression statement Any)))
(function (_ (^@ stateE [bundle state]))
(case (:: (get@ #host state) <name> code)
(#error.Error error)
@@ -141,20 +163,28 @@
(#error.Success output)
(#error.Success [stateE output]))))]
- [execute!]
- [evaluate!]
+ [evaluate! expression]
+ [execute! statement]
)
(def: #export (save! name code)
- (All [anchor code]
- (-> Ident code (Operation anchor code Any)))
+ (All [anchor expression statement]
+ (-> Ident statement (Operation anchor expression statement Any)))
(do //.Monad<Operation>
- [_ (execute! code)]
- (extension.update (update@ #buffer (maybe/map (row.add [name code]))))))
+ [_ (execute! code)
+ ?buffer (extension.read (get@ #buffer))]
+ (case ?buffer
+ (#.Some buffer)
+ (if (row.any? (|>> product.left (ident/= name)) buffer)
+ (//.throw cannot-overwrite-artifact name)
+ (extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
+
+ #.None
+ (//.throw no-buffer-for-saving-code name))))
(def: #export (save-buffer! target)
- (All [anchor code]
- (-> File (Operation anchor code Any)))
+ (All [anchor expression statement]
+ (-> File (Operation anchor expression statement Any)))
(do //.Monad<Operation>
[buffer ..buffer]
(extension.update (update@ #artifacts (dict.put target buffer)))))
diff --git a/stdlib/test/test/lux/data/collection/row.lux b/stdlib/test/test/lux/data/collection/row.lux
index f8850447a..dbe9280b6 100644
--- a/stdlib/test/test/lux/data/collection/row.lux
+++ b/stdlib/test/test/lux/data/collection/row.lux
@@ -73,4 +73,10 @@
(test "Row concatenation is a monad."
(&/= (&/compose sample other-sample)
(&/join (&.row sample other-sample))))
+
+ (test "Can reverse."
+ (and (not (&/= sample
+ (&.reverse sample)))
+ (not (&/= sample
+ (&.reverse (&.reverse sample))))))
))))