aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/abstract
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/abstract')
-rw-r--r--stdlib/source/lux/abstract/algebra.lux16
-rw-r--r--stdlib/source/lux/abstract/apply.lux36
-rw-r--r--stdlib/source/lux/abstract/codec.lux28
-rw-r--r--stdlib/source/lux/abstract/comonad.lux78
-rw-r--r--stdlib/source/lux/abstract/comonad/cofree.lux27
-rw-r--r--stdlib/source/lux/abstract/enum.lux25
-rw-r--r--stdlib/source/lux/abstract/equivalence.lux24
-rw-r--r--stdlib/source/lux/abstract/fold.lux16
-rw-r--r--stdlib/source/lux/abstract/functor.lux44
-rw-r--r--stdlib/source/lux/abstract/functor/contravariant.lux8
-rw-r--r--stdlib/source/lux/abstract/hash.lux26
-rw-r--r--stdlib/source/lux/abstract/interval.lux193
-rw-r--r--stdlib/source/lux/abstract/monad.lux183
-rw-r--r--stdlib/source/lux/abstract/monad/free.lux67
-rw-r--r--stdlib/source/lux/abstract/monad/indexed.lux83
-rw-r--r--stdlib/source/lux/abstract/monoid.lux20
-rw-r--r--stdlib/source/lux/abstract/order.lux57
-rw-r--r--stdlib/source/lux/abstract/predicate.lux60
18 files changed, 0 insertions, 991 deletions
diff --git a/stdlib/source/lux/abstract/algebra.lux b/stdlib/source/lux/abstract/algebra.lux
deleted file mode 100644
index 14d29bf16..000000000
--- a/stdlib/source/lux/abstract/algebra.lux
+++ /dev/null
@@ -1,16 +0,0 @@
-(.module:
- [lux #*
- [control
- [functor (#+ Fix)]]])
-
-(type: #export (Algebra f a)
- (-> (f a) a))
-
-(type: #export (CoAlgebra f a)
- (-> a (f a)))
-
-(type: #export (RAlgebra f a)
- (-> (f (& (Fix f) a)) a))
-
-(type: #export (RCoAlgebra f a)
- (-> a (f (| (Fix f) a))))
diff --git a/stdlib/source/lux/abstract/apply.lux b/stdlib/source/lux/abstract/apply.lux
deleted file mode 100644
index 6f0e61ba8..000000000
--- a/stdlib/source/lux/abstract/apply.lux
+++ /dev/null
@@ -1,36 +0,0 @@
-(.module:
- [lux #*]
- [//
- [monad (#+ Monad)]
- ["." functor (#+ Functor)]])
-
-(interface: #export (Apply f)
- {#.doc "Applicative functors."}
- (: (Functor f)
- &functor)
- (: (All [a b]
- (-> (f (-> a b)) (f a) (f b)))
- apply))
-
-(implementation: #export (compose f-monad f-apply g-apply)
- {#.doc "Applicative functor composition."}
- (All [F G]
- (-> (Monad F) (Apply F) (Apply G)
- ## TODO: Replace (All [a] (F (G a))) with (functor.Then F G)
- (Apply (All [a] (F (G a))))))
-
- (def: &functor (functor.compose (get@ #&functor f-apply) (get@ #&functor g-apply)))
-
- (def: (apply fgf fgx)
- ## TODO: Switch from this version to the one below (in comments) ASAP.
- (let [fgf' (\ f-apply apply
- (\ f-monad wrap (\ g-apply apply))
- fgf)]
- (\ f-apply apply fgf' fgx))
- ## (let [applyF (\ f-apply apply)
- ## applyG (\ g-apply apply)]
- ## ($_ applyF
- ## (\ f-monad wrap applyG)
- ## fgf
- ## fgx))
- ))
diff --git a/stdlib/source/lux/abstract/codec.lux b/stdlib/source/lux/abstract/codec.lux
deleted file mode 100644
index 454b64cb5..000000000
--- a/stdlib/source/lux/abstract/codec.lux
+++ /dev/null
@@ -1,28 +0,0 @@
-(.module:
- [lux #*
- [control
- ["." try (#+ Try)]]]
- [//
- [monad (#+ do)]
- ["." functor]])
-
-(interface: #export (Codec m a)
- {#.doc "A way to move back-and-forth between a type and an alternative representation for it."}
- (: (-> a m)
- encode)
- (: (-> m (Try a))
- decode))
-
-(implementation: #export (compose cb-codec ba-codec)
- {#.doc "Codec composition."}
- (All [a b c]
- (-> (Codec c b) (Codec b a)
- (Codec c a)))
- (def: encode
- (|>> (\ ba-codec encode)
- (\ cb-codec encode)))
-
- (def: (decode cy)
- (do try.monad
- [by (\ cb-codec decode cy)]
- (\ ba-codec decode by))))
diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux
deleted file mode 100644
index 63565bd3a..000000000
--- a/stdlib/source/lux/abstract/comonad.lux
+++ /dev/null
@@ -1,78 +0,0 @@
-(.module:
- [lux #*
- [data
- [collection
- ["." list ("#\." fold)]]]
- [math
- [number
- ["n" nat]]]
- [meta
- ["." location]]]
- [//
- [functor (#+ Functor)]])
-
-(interface: #export (CoMonad w)
- {#.doc (doc "CoMonads are the opposite/complement to monads."
- "CoMonadic structures are often infinite in size and built upon lazily-evaluated functions.")}
- (: (Functor w)
- &functor)
- (: (All [a]
- (-> (w a) a))
- unwrap)
- (: (All [a]
- (-> (w a) (w (w a))))
- split))
-
-(macro: #export (be tokens state)
- {#.doc (doc "A co-monadic parallel to the 'do' macro."
- (let [square (function (_ n) (* n n))]
- (be comonad
- [inputs (iterate inc +2)]
- (square (head inputs)))))}
- (case (: (Maybe [(Maybe Text) Code (List Code) Code])
- (case tokens
- (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] comonad]))] [_ (#.Tuple bindings)] body))
- (#.Some [(#.Some name) comonad bindings body])
-
- (^ (list comonad [_ (#.Tuple bindings)] body))
- (#.Some [#.None comonad bindings body])
-
- _
- #.None))
- (#.Some [?name comonad bindings body])
- (if (|> bindings list.size (n.% 2) (n.= 0))
- (let [[module short] (name_of ..be)
- gensym (: (-> Text Code)
- (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy]))
- g!_ (gensym "_")
- g!map (gensym "map")
- g!split (gensym "split")
- body' (list\fold (: (-> [Code Code] Code Code)
- (function (_ binding body')
- (let [[var value] binding]
- (case var
- [_ (#.Tag ["" "let"])]
- (` (let (~ value) (~ body')))
-
- _
- (` (|> (~ value) (~ g!split) ((~ g!map) (function ((~ g!_) (~ var)) (~ body')))))
- ))))
- body
- (list.reverse (list.as_pairs bindings)))]
- (#.Right [state (list (case ?name
- (#.Some name)
- (let [name [location.dummy (#.Identifier ["" name])]]
- (` ({(~ name)
- ({[(~ g!map) (~' unwrap) (~ g!split)]
- (~ body')}
- (~ name))}
- (~ comonad))))
-
- #.None
- (` ({[(~ g!map) (~' unwrap) (~ g!split)]
- (~ body')}
- (~ comonad)))))]))
- (#.Left "'be' bindings must have an even number of parts."))
-
- #.None
- (#.Left "Wrong syntax for 'be'")))
diff --git a/stdlib/source/lux/abstract/comonad/cofree.lux b/stdlib/source/lux/abstract/comonad/cofree.lux
deleted file mode 100644
index 64413f1ce..000000000
--- a/stdlib/source/lux/abstract/comonad/cofree.lux
+++ /dev/null
@@ -1,27 +0,0 @@
-(.module:
- [lux #*]
- [// (#+ CoMonad)
- [//
- [functor (#+ Functor)]]])
-
-(type: #export (CoFree F a)
- {#.doc "The CoFree CoMonad."}
- [a (F (CoFree F a))])
-
-(implementation: #export (functor dsl)
- (All [F] (-> (Functor F) (Functor (CoFree F))))
-
- (def: (map f [head tail])
- [(f head) (\ dsl map (map f) tail)]))
-
-(implementation: #export (comonad dsl)
- (All [F] (-> (Functor F) (CoMonad (CoFree F))))
-
- (def: &functor (..functor dsl))
-
- (def: (unwrap [head tail])
- head)
-
- (def: (split [head tail])
- [[head tail]
- (\ dsl map split tail)]))
diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux
deleted file mode 100644
index d98848f78..000000000
--- a/stdlib/source/lux/abstract/enum.lux
+++ /dev/null
@@ -1,25 +0,0 @@
-(.module:
- [lux #*]
- [//
- ["." order (#+ Order)]])
-
-(interface: #export (Enum e)
- {#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."}
- (: (Order e) &order)
- (: (-> e e) succ)
- (: (-> e e) pred))
-
-(def: #export (range enum from to)
- {#.doc "An inclusive [from, to] range of values."}
- (All [a] (-> (Enum a) a a (List a)))
- (let [(^open "/\.") enum]
- (loop [end to
- output #.Nil]
- (cond (/\< end from)
- (recur (/\pred end) (#.Cons end output))
-
- (/\< from end)
- (recur (/\succ end) (#.Cons end output))
-
- ## (/\= end from)
- (#.Cons end output)))))
diff --git a/stdlib/source/lux/abstract/equivalence.lux b/stdlib/source/lux/abstract/equivalence.lux
deleted file mode 100644
index 58d644c9b..000000000
--- a/stdlib/source/lux/abstract/equivalence.lux
+++ /dev/null
@@ -1,24 +0,0 @@
-(.module:
- [lux #*]
- [//
- [functor
- ["." contravariant]]])
-
-(interface: #export (Equivalence a)
- {#.doc "Equivalence for a type's instances."}
- (: (-> a a Bit)
- =))
-
-(def: #export (rec sub)
- (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a)))
- (implementation
- (def: (= left right)
- (sub = left right))))
-
-(implementation: #export functor
- (contravariant.Functor Equivalence)
-
- (def: (map f equivalence)
- (implementation
- (def: (= reference sample)
- (\ equivalence = (f reference) (f sample))))))
diff --git a/stdlib/source/lux/abstract/fold.lux b/stdlib/source/lux/abstract/fold.lux
deleted file mode 100644
index 3f957bb55..000000000
--- a/stdlib/source/lux/abstract/fold.lux
+++ /dev/null
@@ -1,16 +0,0 @@
-(.module:
- [lux #*]
- [//
- [monoid (#+ Monoid)]])
-
-(interface: #export (Fold F)
- {#.doc "Iterate over a structure's values to build a summary value."}
- (: (All [a b]
- (-> (-> b a a) a (F b) a))
- fold))
-
-(def: #export (with-monoid monoid fold value)
- (All [F a]
- (-> (Monoid a) (Fold F) (F a) a))
- (let [(^open "/\.") monoid]
- (fold /\compose /\identity value)))
diff --git a/stdlib/source/lux/abstract/functor.lux b/stdlib/source/lux/abstract/functor.lux
deleted file mode 100644
index d3012b686..000000000
--- a/stdlib/source/lux/abstract/functor.lux
+++ /dev/null
@@ -1,44 +0,0 @@
-(.module: lux)
-
-(interface: #export (Functor f)
- (: (All [a b]
- (-> (-> a b)
- (-> (f a) (f b))))
- map))
-
-(type: #export (Fix f)
- (f (Fix f)))
-
-(type: #export (Or f g)
- (All [a] (| (f a) (g a))))
-
-(def: #export (sum (^open "f\.") (^open "g\."))
- (All [F G] (-> (Functor F) (Functor G) (Functor (..Or F G))))
- (implementation
- (def: (map f fa|ga)
- (case fa|ga
- (#.Left fa)
- (#.Left (f\map f fa))
-
- (#.Right ga)
- (#.Right (g\map f ga))))))
-
-(type: #export (And f g)
- (All [a] (& (f a) (g a))))
-
-(def: #export (product (^open "f\.") (^open "g\."))
- (All [F G] (-> (Functor F) (Functor G) (Functor (..And F G))))
- (implementation
- (def: (map f [fa ga])
- [(f\map f fa)
- (g\map f ga)])))
-
-(type: #export (Then f g)
- (All [a] (f (g a))))
-
-(def: #export (compose (^open "f\.") (^open "g\."))
- {#.doc "Functor composition."}
- (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G))))
- (implementation
- (def: (map f fga)
- (f\map (g\map f) fga))))
diff --git a/stdlib/source/lux/abstract/functor/contravariant.lux b/stdlib/source/lux/abstract/functor/contravariant.lux
deleted file mode 100644
index d91813e1f..000000000
--- a/stdlib/source/lux/abstract/functor/contravariant.lux
+++ /dev/null
@@ -1,8 +0,0 @@
-(.module:
- [lux #*])
-
-(interface: #export (Functor f)
- (: (All [a b]
- (-> (-> b a)
- (-> (f a) (f b))))
- map))
diff --git a/stdlib/source/lux/abstract/hash.lux b/stdlib/source/lux/abstract/hash.lux
deleted file mode 100644
index 14857ef18..000000000
--- a/stdlib/source/lux/abstract/hash.lux
+++ /dev/null
@@ -1,26 +0,0 @@
-(.module:
- [lux #*]
- [//
- ["." equivalence (#+ Equivalence)]
- [functor
- ["." contravariant]]])
-
-(interface: #export (Hash a)
- {#.doc (doc "A way to produce hash-codes for a type's instances."
- "A necessity when working with some data-structures, such as dictionaries or sets.")}
- (: (Equivalence a)
- &equivalence)
- (: (-> a Nat)
- hash))
-
-(implementation: #export functor
- (contravariant.Functor Hash)
-
- (def: (map f super)
- (implementation
- (def: &equivalence
- (\ equivalence.functor map f
- (\ super &equivalence)))
-
- (def: hash
- (|>> f (\ super hash))))))
diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux
deleted file mode 100644
index e43529890..000000000
--- a/stdlib/source/lux/abstract/interval.lux
+++ /dev/null
@@ -1,193 +0,0 @@
-## https://en.wikipedia.org/wiki/Interval_(mathematics)
-(.module:
- [lux #*]
- [//
- [equivalence (#+ Equivalence)]
- ["." order]
- [enum (#+ Enum)]])
-
-(interface: #export (Interval a)
- {#.doc "A representation of top and bottom boundaries for an ordered type."}
- (: (Enum a)
- &enum)
-
- (: a
- bottom)
-
- (: a
- top))
-
-(def: #export (between enum bottom top)
- (All [a] (-> (Enum a) a a (Interval a)))
- (implementation
- (def: &enum enum)
- (def: bottom bottom)
- (def: top top)))
-
-(def: #export (singleton enum elem)
- (All [a] (-> (Enum a) a (Interval a)))
- (implementation
- (def: &enum enum)
- (def: bottom elem)
- (def: top elem)))
-
-(template [<name> <comp>]
- [(def: #export (<name> interval)
- (All [a] (-> (Interval a) Bit))
- (let [(^open ",\.") interval]
- (<comp> ,\bottom ,\top)))]
-
- [inner? (order.> ,\&order)]
- [outer? ,\<]
- [singleton? ,\=]
- )
-
-(def: #export (within? interval elem)
- (All [a] (-> (Interval a) a Bit))
- (let [(^open ",\.") interval]
- (cond (inner? interval)
- (and (order.>= ,\&order ,\bottom elem)
- (order.<= ,\&order ,\top elem))
-
- (outer? interval)
- (or (order.>= ,\&order ,\bottom elem)
- (order.<= ,\&order ,\top elem))
-
- ## singleton
- (and (,\= ,\bottom elem)
- (,\= ,\top elem)))))
-
-(template [<name> <limit>]
- [(def: #export (<name> elem interval)
- (All [a] (-> a (Interval a) Bit))
- (let [(^open ".") interval]
- (= <limit> elem)))]
-
- [starts_with? bottom]
- [ends_with? top]
- )
-
-(def: #export (borders? interval elem)
- (All [a] (-> (Interval a) a Bit))
- (or (starts_with? elem interval)
- (ends_with? elem interval)))
-
-(def: #export (union left right)
- (All [a] (-> (Interval a) (Interval a) (Interval a)))
- (implementation
- (def: &enum (get@ #&enum right))
- (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)))
- (implementation
- (def: &enum (get@ #&enum right))
- (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)))
- (let [(^open ".") interval]
- (implementation
- (def: &enum (get@ #&enum interval))
- (def: bottom (succ top))
- (def: top (pred bottom)))))
-
-(def: #export (precedes? reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (let [(^open ".") reference
- limit (\ reference bottom)]
- (and (< limit (\ sample bottom))
- (< limit (\ sample top)))))
-
-(def: #export (succeeds? reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (precedes? sample reference))
-
-(template [<name> <comp>]
- [(def: #export (<name> reference sample)
- (All [a] (-> a (Interval a) Bit))
- (let [(^open ",\.") sample]
- (and (<comp> reference ,\bottom)
- (<comp> reference ,\top))))]
-
- [before? ,\<]
- [after? (order.> ,\&order)]
- )
-
-(def: #export (meets? reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (let [(^open ",\.") reference
- limit (\ reference bottom)]
- (and (,\= limit (\ sample top))
- (order.<= ,\&order limit (\ sample bottom)))))
-
-(def: #export (touches? reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (or (meets? reference sample)
- (meets? sample reference)))
-
-(template [<name> <eq_side> <ineq> <ineq_side>]
- [(def: #export (<name> reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (let [(^open ",\.") reference]
- (and (,\= (\ reference <eq_side>)
- (\ sample <eq_side>))
- (<ineq> ,\&order
- (\ reference <ineq_side>)
- (\ sample <ineq_side>)))))]
-
- [starts? ,\bottom order.<= ,\top]
- [finishes? ,\top order.>= ,\bottom]
- )
-
-(implementation: #export equivalence (All [a] (Equivalence (Interval a)))
- (def: (= reference sample)
- (let [(^open ",\.") reference]
- (and (,\= ,\bottom (\ sample bottom))
- (,\= ,\top (\ sample top))))))
-
-(def: #export (nested? reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (cond (or (singleton? sample)
- (and (inner? reference) (inner? sample))
- (and (outer? reference) (outer? sample)))
- (let [(^open ",\.") reference]
- (and (order.>= ,\&order (\ reference bottom) (\ sample bottom))
- (order.<= ,\&order (\ reference top) (\ sample top))))
-
- (or (singleton? reference)
- (and (inner? reference) (outer? sample)))
- #0
-
- ## (and (outer? reference) (inner? sample))
- (let [(^open ",\.") reference]
- (or (and (order.>= ,\&order (\ reference bottom) (\ sample bottom))
- (order.> ,\&order (\ reference bottom) (\ sample top)))
- (and (,\< (\ reference top) (\ sample bottom))
- (order.<= ,\&order (\ reference top) (\ sample top)))))
- ))
-
-(def: #export (overlaps? reference sample)
- (All [a] (-> (Interval a) (Interval a) Bit))
- (let [(^open ",\.") reference]
- (and (not (\ ..equivalence = reference sample))
- (cond (singleton? sample)
- #0
-
- (singleton? reference)
- (nested? sample reference)
-
- (or (and (inner? sample) (outer? reference))
- (and (outer? sample) (inner? reference)))
- (or (order.>= ,\&order (\ reference bottom) (\ sample top))
- (order.<= ,\&order (\ reference top) (\ sample bottom)))
-
- ## both inner
- (inner? sample)
- (inner? (intersection reference sample))
-
- ## both outer
- (not (nested? reference sample))
- ))))
diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux
deleted file mode 100644
index d32bdacbb..000000000
--- a/stdlib/source/lux/abstract/monad.lux
+++ /dev/null
@@ -1,183 +0,0 @@
-(.module:
- [lux #*
- [meta
- ["." location]]]
- [//
- [functor (#+ Functor)]])
-
-(def: (list\fold f init xs)
- (All [a b]
- (-> (-> b a a) a (List b) a))
- (case xs
- #.Nil
- init
-
- (#.Cons x xs')
- (list\fold f (f x init) xs')))
-
-(def: (list\size xs)
- (All [a] (-> (List a) Nat))
- (loop [counter 0
- xs xs]
- (case xs
- #.Nil
- counter
-
- (#.Cons _ xs')
- (recur (inc counter) xs'))))
-
-(def: (reverse xs)
- (All [a]
- (-> (List a) (List a)))
- (list\fold (function (_ head tail) (#.Cons head tail))
- #.Nil
- xs))
-
-(def: (as_pairs xs)
- (All [a] (-> (List a) (List [a a])))
- (case xs
- (#.Cons x1 (#.Cons x2 xs'))
- (#.Cons [x1 x2] (as_pairs xs'))
-
- _
- #.Nil))
-
-(interface: #export (Monad m)
- (: (Functor m)
- &functor)
- (: (All [a]
- (-> a (m a)))
- wrap)
- (: (All [a]
- (-> (m (m a)) (m a)))
- join))
-
-(macro: #export (do tokens state)
- {#.doc (doc "Macro for easy concatenation of monadic operations."
- (do monad
- [y (f1 x)
- z (f2 z)]
- (wrap (f3 z))))}
- (case (: (Maybe [(Maybe Text) Code (List Code) Code])
- (case tokens
- (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] monad]))] [_ (#.Tuple bindings)] body))
- (#.Some [(#.Some name) monad bindings body])
-
- (^ (list monad [_ (#.Tuple bindings)] body))
- (#.Some [#.None monad bindings body])
-
- _
- #.None))
- (#.Some [?name monad bindings body])
- (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 [location.dummy]))
- g!_ (gensym "_")
- g!map (gensym "map")
- g!join (gensym "join")
- body' (list\fold (: (-> [Code Code] Code Code)
- (function (_ binding body')
- (let [[var value] binding]
- (case var
- [_ (#.Tag ["" "let"])]
- (` (let (~ value) (~ body')))
-
- _
- (` (|> (~ value) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))) (~ g!join)))
- ))))
- body
- (reverse (as_pairs bindings)))]
- (#.Right [state (list (case ?name
- (#.Some name)
- (let [name [location.dummy (#.Identifier ["" name])]]
- (` ({(~ name)
- ({[(~ g!map) (~' wrap) (~ g!join)]
- (~ body')}
- (~ name))}
- (~ monad))))
-
- #.None
- (` ({[(~ g!map) (~' wrap) (~ g!join)]
- (~ body')}
- (~ monad)))))]))
- (#.Left "'do' bindings must have an even number of parts."))
-
- #.None
- (#.Left "Wrong syntax for 'do'")))
-
-(def: #export (bind monad f)
- (All [! a b]
- (-> (Monad !) (-> a (! b))
- (-> (! a) (! b))))
- (|>> (\ monad map f)
- (\ monad join)))
-
-(def: #export (seq monad)
- {#.doc "Run all the monadic values in the list and produce a list of the base values."}
- (All [M a]
- (-> (Monad M) (List (M a))
- (M (List a))))
- (let [(^open "!\.") monad]
- (function (recur xs)
- (case xs
- #.Nil
- (!\wrap #.Nil)
-
- (#.Cons x xs')
- (|> x
- (!\map (function (_ _x)
- (!\map (|>> (#.Cons _x)) (recur xs'))))
- !\join)))))
-
-(def: #export (map monad f)
- {#.doc "Apply a monadic function to all values in a list."}
- (All [M a b]
- (-> (Monad M) (-> a (M b)) (List a)
- (M (List b))))
- (let [(^open "!\.") monad]
- (function (recur xs)
- (case xs
- #.Nil
- (!\wrap #.Nil)
-
- (#.Cons x xs')
- (|> (f x)
- (!\map (function (_ _x)
- (!\map (|>> (#.Cons _x)) (recur xs'))))
- !\join)))))
-
-(def: #export (filter monad f)
- {#.doc "Filter the values in a list with a monadic function."}
- (All [! a b]
- (-> (Monad !) (-> a (! Bit)) (List a)
- (! (List a))))
- (let [(^open "!\.") monad]
- (function (recur xs)
- (case xs
- #.Nil
- (!\wrap #.Nil)
-
- (#.Cons head xs')
- (|> (f head)
- (!\map (function (_ verdict)
- (!\map (function (_ tail)
- (if verdict
- (#.Cons head tail)
- tail))
- (recur xs'))))
- !\join)))))
-
-(def: #export (fold monad f init xs)
- {#.doc "Fold a list with a monadic function."}
- (All [M a b]
- (-> (Monad M) (-> b a (M a)) a (List b)
- (M a)))
- (case xs
- #.Nil
- (\ monad wrap init)
-
- (#.Cons x xs')
- (do monad
- [init' (f x init)]
- (fold monad f init' xs'))))
diff --git a/stdlib/source/lux/abstract/monad/free.lux b/stdlib/source/lux/abstract/monad/free.lux
deleted file mode 100644
index 7a9efbeea..000000000
--- a/stdlib/source/lux/abstract/monad/free.lux
+++ /dev/null
@@ -1,67 +0,0 @@
-(.module:
- [lux #*]
- [///
- [functor (#+ Functor)]
- [apply (#+ Apply)]
- [monad (#+ Monad)]])
-
-(type: #export (Free F a)
- {#.doc "The Free Monad."}
- (#Pure a)
- (#Effect (F (Free F a))))
-
-(implementation: #export (functor dsl)
- (All [F] (-> (Functor F) (Functor (Free F))))
-
- (def: (map f ea)
- (case ea
- (#Pure a)
- (#Pure (f a))
-
- (#Effect value)
- (#Effect (\ dsl map (map f) value)))))
-
-(implementation: #export (apply dsl)
- (All [F] (-> (Functor F) (Apply (Free F))))
-
- (def: &functor (..functor dsl))
-
- (def: (apply ef ea)
- (case [ef ea]
- [(#Pure f) (#Pure a)]
- (#Pure (f a))
-
- [(#Pure f) (#Effect fa)]
- (#Effect (\ dsl map
- (\ (..functor dsl) map f)
- fa))
-
- [(#Effect ff) _]
- (#Effect (\ dsl map
- (function (_ f) (apply f ea))
- ff))
- )))
-
-(implementation: #export (monad dsl)
- (All [F] (-> (Functor F) (Monad (Free F))))
-
- (def: &functor (..functor dsl))
-
- (def: (wrap a)
- (#Pure a))
-
- (def: (join efefa)
- (case efefa
- (#Pure efa)
- (case efa
- (#Pure a)
- (#Pure a)
-
- (#Effect fa)
- (#Effect fa))
-
- (#Effect fefa)
- (#Effect (\ dsl map
- (\ (monad dsl) join)
- fefa))
- )))
diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux
deleted file mode 100644
index 5a5a63b27..000000000
--- a/stdlib/source/lux/abstract/monad/indexed.lux
+++ /dev/null
@@ -1,83 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad]
- ["p" parser
- ["s" code (#+ Parser)]]]
- [data
- [collection
- ["." list ("#\." functor fold)]]]
- ["." macro
- [syntax (#+ syntax:)]
- ["." code]]])
-
-(interface: #export (IxMonad m)
- (: (All [p a]
- (-> a (m p p a)))
- wrap)
-
- (: (All [ii it io vi vo]
- (-> (-> vi (m it io vo))
- (m ii it vi)
- (m ii io vo)))
- bind))
-
-(type: Binding [Code Code])
-
-(def: binding
- (Parser Binding)
- (p.and s.any s.any))
-
-(type: Context
- (#Let (List Binding))
- (#Bind Binding))
-
-(def: context
- (Parser Context)
- (p.or (p.after (s.this! (' #let))
- (s.tuple (p.some binding)))
- binding))
-
-(def: (pair_list [binding value])
- (All [a] (-> [a a] (List a)))
- (list binding value))
-
-(def: named_monad
- (Parser [(Maybe Text) Code])
- (p.either (s.record (p.and (\ p.monad map (|>> #.Some)
- s.local_identifier)
- s.any))
- (\ p.monad map (|>> [#.None])
- s.any)))
-
-(syntax: #export (do {[?name monad] ..named_monad}
- {context (s.tuple (p.some context))}
- expression)
- (macro.with_gensyms [g!_ g!bind]
- (let [body (list\fold (function (_ context next)
- (case context
- (#Let bindings)
- (` (let [(~+ (|> bindings
- (list\map pair_list)
- list.concat))]
- (~ next)))
-
- (#Bind [binding value])
- (` ((~ g!bind)
- (.function ((~ g!_) (~ binding))
- (~ next))
- (~ value)))))
- expression
- (list.reverse context))]
- (wrap (list (case ?name
- (#.Some name)
- (let [name (code.local_identifier name)]
- (` (let [(~ name) (~ monad)
- {#..wrap (~' wrap)
- #..bind (~ g!bind)} (~ name)]
- (~ body))))
-
- #.None
- (` (let [{#..wrap (~' wrap)
- #..bind (~ g!bind)} (~ monad)]
- (~ body)))))))))
diff --git a/stdlib/source/lux/abstract/monoid.lux b/stdlib/source/lux/abstract/monoid.lux
deleted file mode 100644
index 2b5560421..000000000
--- a/stdlib/source/lux/abstract/monoid.lux
+++ /dev/null
@@ -1,20 +0,0 @@
-(.module:
- [lux #*])
-
-(interface: #export (Monoid a)
- {#.doc (doc "A way to compose values."
- "Includes an identity value which does not alter any other value when combined with.")}
- (: a
- identity)
- (: (-> a a a)
- compose))
-
-(def: #export (compose left right)
- (All [l r] (-> (Monoid l) (Monoid r) (Monoid [l r])))
- (implementation
- (def: identity
- [(\ left identity) (\ right identity)])
-
- (def: (compose [lL rL] [lR rR])
- [(\ left compose lL lR)
- (\ right compose rL rR)])))
diff --git a/stdlib/source/lux/abstract/order.lux b/stdlib/source/lux/abstract/order.lux
deleted file mode 100644
index 9d031bca2..000000000
--- a/stdlib/source/lux/abstract/order.lux
+++ /dev/null
@@ -1,57 +0,0 @@
-(.module:
- [lux #*
- [control
- ["." function]]]
- [//
- ["." equivalence (#+ Equivalence)]
- [functor
- ["." contravariant]]])
-
-(interface: #export (Order a)
- {#.doc "A signature for types that possess some sense of ordering among their elements."}
-
- (: (Equivalence a)
- &equivalence)
-
- (: (-> a a Bit)
- <)
- )
-
-(type: #export (Comparison a)
- (-> (Order a) a a Bit))
-
-(def: #export (<= order parameter subject)
- Comparison
- (or (\ order < parameter subject)
- (\ order = parameter subject)))
-
-(def: #export (> order parameter subject)
- Comparison
- (\ order < subject parameter))
-
-(def: #export (>= order parameter subject)
- Comparison
- (or (\ order < subject parameter)
- (\ order = subject parameter)))
-
-(type: #export (Choice a)
- (-> (Order a) a a a))
-
-(def: #export (min order x y)
- Choice
- (if (\ order < y x) x y))
-
-(def: #export (max order x y)
- Choice
- (if (\ order < y x) y x))
-
-(implementation: #export functor
- (contravariant.Functor Order)
-
- (def: (map f order)
- (implementation
- (def: &equivalence
- (\ equivalence.functor map f (\ order &equivalence)))
-
- (def: (< reference sample)
- (\ order < (f reference) (f sample))))))
diff --git a/stdlib/source/lux/abstract/predicate.lux b/stdlib/source/lux/abstract/predicate.lux
deleted file mode 100644
index 841865c10..000000000
--- a/stdlib/source/lux/abstract/predicate.lux
+++ /dev/null
@@ -1,60 +0,0 @@
-(.module:
- [lux #*
- [control
- ["." function]]]
- [//
- [monoid (#+ Monoid)]
- [functor
- ["." contravariant]]])
-
-(type: #export (Predicate a)
- (-> a Bit))
-
-(template [<identity_name> <identity_value> <composition_name> <composition>]
- [(def: #export <identity_name>
- Predicate
- (function.constant <identity_value>))
-
- (def: #export (<composition_name> left right)
- (All [a] (-> (Predicate a) (Predicate a) (Predicate a)))
- (function (_ value)
- (<composition> (left value)
- (right value))))]
-
- [none #0 unite or]
- [all #1 intersect and]
- )
-
-(template [<name> <identity> <composition>]
- [(implementation: #export <name>
- (All [a] (Monoid (Predicate a)))
-
- (def: identity <identity>)
- (def: compose <composition>))]
-
- [union ..none ..unite]
- [intersection ..all ..intersect]
- )
-
-(def: #export (complement predicate)
- (All [a] (-> (Predicate a) (Predicate a)))
- (|>> predicate not))
-
-(def: #export (difference sub base)
- (All [a] (-> (Predicate a) (Predicate a) (Predicate a)))
- (function (_ value)
- (and (base value)
- (not (sub value)))))
-
-(def: #export (rec predicate)
- (All [a]
- (-> (-> (Predicate a) (Predicate a))
- (Predicate a)))
- (function (recur input)
- (predicate recur input)))
-
-(implementation: #export functor
- (contravariant.Functor Predicate)
-
- (def: (map f fb)
- (|>> f fb)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 16:31:14 +0000