aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux85
-rw-r--r--stdlib/source/lux/control/interval.lux8
-rw-r--r--stdlib/source/lux/data/coll/ordered.lux2
-rw-r--r--stdlib/source/lux/data/coll/queue.lux2
-rw-r--r--stdlib/source/lux/function/state.lux3
5 files changed, 57 insertions, 43 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bac65ef16..541b4bcdc 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2244,11 +2244,11 @@
"-")]
((_lux_: (-> Int Text Text)
(lambda' recur [input output]
- (if (i.= 0 input)
- (_lux_proc ["text" "append"] [sign output])
- (recur (i./ 10 input)
- (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
- output])))))
+ (if (i.= 0 input)
+ (_lux_proc ["text" "append"] [sign output])
+ (recur (i./ 10 input)
+ (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
+ output])))))
(|> value (i./ 10) Int/abs)
(|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text)))))
@@ -4204,24 +4204,6 @@
_
(list)))
-(def: (use-field prefix [module name] type)
- (-> Text Ident Type (Lux [AST AST]))
- (do Monad<Lux>
- [output (resolve-type-tags type)
- pattern (: (Lux AST)
- (case output
- (#Some [tags members])
- (do Monad<Lux>
- [slots (mapM Monad<Lux>
- (: (-> [Ident Type] (Lux [AST AST]))
- (lambda [[sname stype]] (use-field prefix sname stype)))
- (zip2 tags members))]
- (return (record$ slots)))
-
- #None
- (return (symbol$ ["" (Text/append prefix name)]))))]
- (return [(tag$ [module name]) pattern])))
-
(def: (Type/show type)
(-> Type Text)
(case type
@@ -4270,23 +4252,56 @@
($_ Text/append prefix ";" name)
))
+(def: (foldM Monad<m> f init inputs)
+ (All [m o i]
+ (-> (Monad m) (-> i o (m o)) o (List i) (m o)))
+ (case inputs
+ #;Nil
+ (do Monad<m>
+ []
+ (wrap init))
+
+ (#;Cons input inputs')
+ (do Monad<m>
+ [output (f input init)]
+ (foldM Monad<m> f output inputs'))))
+
(macro: #hidden (^open' tokens)
(case tokens
(^ (list [_ (#SymbolS name)] [_ (#TextS prefix)] body))
(do Monad<Lux>
- [struct-type (find-type name)
- output (resolve-type-tags struct-type)]
- (case output
- (#Some [tags members])
- (do Monad<Lux>
- [slots (mapM Monad<Lux> (: (-> [Ident Type] (Lux [AST AST]))
- (lambda [[sname stype]] (use-field prefix sname stype)))
- (zip2 tags members))
- #let [pattern (record$ slots)]]
- (return (list (` (;_lux_case (~ (symbol$ name)) (~ pattern) (~ body))))))
+ [init-type (find-type name)
+ struct-evidence (resolve-type-tags init-type)]
+ (case struct-evidence
+ #;None
+ (fail (Text/append "Can only \"open\" structs: " (Type/show init-type)))
- _
- (fail (Text/append "Can only \"open\" structs: " (Type/show struct-type)))))
+ (#;Some tags&members)
+ (do Monad<Lux>
+ [full-body ((: (-> Ident [(List Ident) (List Type)] AST (Lux AST))
+ (lambda recur [source [tags members] target]
+ (let [pattern (record$ (map (lambda [[t-module t-name]]
+ [(tag$ [t-module t-name])
+ (symbol$ ["" (Text/append prefix t-name)])])
+ tags))]
+ (do Monad<Lux>
+ [enhanced-target (foldM Monad<Lux>
+ (lambda [[[_ m-name] m-type] enhanced-target]
+ (do Monad<Lux>
+ [m-structure (resolve-type-tags m-type)]
+ (case m-structure
+ (#;Some m-tags&members)
+ (recur ["" (Text/append prefix m-name)]
+ m-tags&members
+ enhanced-target)
+
+ #;None
+ (wrap enhanced-target))))
+ target
+ (zip2 tags members))]
+ (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target))))))))
+ name tags&members body)]
+ (wrap (list full-body)))))
_
(fail "Wrong syntax for ^open")))
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux
index c007477b4..673ad630f 100644
--- a/stdlib/source/lux/control/interval.lux
+++ b/stdlib/source/lux/control/interval.lux
@@ -72,14 +72,14 @@
(def: #export (union left right)
(All [a] (-> (Interval a) (Interval a) (Interval a)))
(struct (def: enum (get@ #enum right))
- (def: bottom (order;min (get@ [#enum #enum;order] right) (:: left bottom) (:: right bottom)))
- (def: top (order;max (get@ [#enum #enum;order] right) (:: left top) (:: right top)))))
+ (def: bottom (order;min (:: right order) (:: left bottom) (:: right bottom)))
+ (def: top (order;max (:: right order) (:: left top) (:: right top)))))
(def: #export (intersection left right)
(All [a] (-> (Interval a) (Interval a) (Interval a)))
(struct (def: enum (get@ #enum right))
- (def: bottom (order;max (get@ [#enum #enum;order] right) (:: left bottom) (:: right bottom)))
- (def: top (order;min (get@ [#enum #enum;order] right) (:: left top) (:: right top)))))
+ (def: bottom (order;max (:: right order) (:: left bottom) (:: right bottom)))
+ (def: top (order;min (:: right order) (:: left top) (:: right top)))))
(def: #export (complement interval)
(All [a] (-> (Interval a) (Interval a)))
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux
index 37fbb1505..568a3f1be 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered.lux
@@ -489,5 +489,5 @@
(struct: #export Eq<Set> (All [a] (Eq (Set a)))
(def: (= reference sample)
- (:: (list;Eq<List> (get@ [#order #order;eq] sample))
+ (:: (list;Eq<List> (:: sample eq))
= (to-list reference) (to-list sample))))
diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux
index 03d40b020..520211dca 100644
--- a/stdlib/source/lux/data/coll/queue.lux
+++ b/stdlib/source/lux/data/coll/queue.lux
@@ -36,7 +36,7 @@
(def: #export empty?
(All [a] (-> (Queue a) Bool))
- (|>. (get@ [#front]) list;empty?))
+ (|>. (get@ #front) list;empty?))
(def: #export (member? Eq<a> queue member)
(All [a] (-> (Eq a) (Queue a) a Bool))
diff --git a/stdlib/source/lux/function/state.lux b/stdlib/source/lux/function/state.lux
index 5f5b96e4b..edca1d81b 100644
--- a/stdlib/source/lux/function/state.lux
+++ b/stdlib/source/lux/function/state.lux
@@ -83,8 +83,7 @@
(struct: (Applicative<StateT> Monad<M>)
(All [M s] (-> (Monad M) (Applicative (All [a] (-> s (M [s a]))))))
- (def: functor (Functor<StateT> (get@ [#M;applicative #A;functor]
- Monad<M>)))
+ (def: functor (Functor<StateT> (:: Monad<M> functor)))
(def: (wrap a)
(lambda [state]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-17 08:08:20 +0000