aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux.lux428
-rw-r--r--stdlib/source/lux/cli.lux22
-rw-r--r--stdlib/source/lux/control/apply.lux19
-rw-r--r--stdlib/source/lux/control/codec.lux12
-rw-r--r--stdlib/source/lux/control/comonad.lux5
-rw-r--r--stdlib/source/lux/control/concatenative.lux10
-rw-r--r--stdlib/source/lux/control/concurrency/actor.lux35
-rw-r--r--stdlib/source/lux/control/concurrency/atom.lux2
-rw-r--r--stdlib/source/lux/control/concurrency/frp.lux42
-rw-r--r--stdlib/source/lux/control/concurrency/process.lux2
-rw-r--r--stdlib/source/lux/control/concurrency/promise.lux16
-rw-r--r--stdlib/source/lux/control/concurrency/semaphore.lux14
-rw-r--r--stdlib/source/lux/control/concurrency/stm.lux32
-rw-r--r--stdlib/source/lux/control/concurrency/task.lux25
-rw-r--r--stdlib/source/lux/control/continuation.lux12
-rw-r--r--stdlib/source/lux/control/enum.lux4
-rw-r--r--stdlib/source/lux/control/equivalence.lux6
-rw-r--r--stdlib/source/lux/control/exception.lux4
-rw-r--r--stdlib/source/lux/control/functor.lux16
-rw-r--r--stdlib/source/lux/control/hash.lux5
-rw-r--r--stdlib/source/lux/control/identity.lux2
-rw-r--r--stdlib/source/lux/control/interval.lux28
-rw-r--r--stdlib/source/lux/control/monad.lux14
-rw-r--r--stdlib/source/lux/control/monad/free.lux14
-rw-r--r--stdlib/source/lux/control/monad/indexed.lux2
-rw-r--r--stdlib/source/lux/control/order.lux24
-rw-r--r--stdlib/source/lux/control/parser.lux46
-rw-r--r--stdlib/source/lux/control/pipe.lux8
-rw-r--r--stdlib/source/lux/control/reader.lux28
-rw-r--r--stdlib/source/lux/control/region.lux16
-rw-r--r--stdlib/source/lux/control/remember.lux20
-rw-r--r--stdlib/source/lux/control/security/capability.lux2
-rw-r--r--stdlib/source/lux/control/security/integrity.lux10
-rw-r--r--stdlib/source/lux/control/security/privacy.lux10
-rw-r--r--stdlib/source/lux/control/state.lux53
-rw-r--r--stdlib/source/lux/control/thread.lux12
-rw-r--r--stdlib/source/lux/control/writer.lux34
-rw-r--r--stdlib/source/lux/data/bit.lux17
-rw-r--r--stdlib/source/lux/data/collection/array.lux10
-rw-r--r--stdlib/source/lux/data/collection/bits.lux4
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux10
-rw-r--r--stdlib/source/lux/data/collection/dictionary/ordered.lux16
-rw-r--r--stdlib/source/lux/data/collection/dictionary/plist.lux4
-rw-r--r--stdlib/source/lux/data/collection/list.lux69
-rw-r--r--stdlib/source/lux/data/collection/queue.lux10
-rw-r--r--stdlib/source/lux/data/collection/queue/priority.lux9
-rw-r--r--stdlib/source/lux/data/collection/row.lux57
-rw-r--r--stdlib/source/lux/data/collection/sequence.lux13
-rw-r--r--stdlib/source/lux/data/collection/set.lux20
-rw-r--r--stdlib/source/lux/data/collection/set/multi.lux8
-rw-r--r--stdlib/source/lux/data/collection/set/ordered.lux6
-rw-r--r--stdlib/source/lux/data/collection/tree/rose.lux10
-rw-r--r--stdlib/source/lux/data/collection/tree/rose/zipper.lux14
-rw-r--r--stdlib/source/lux/data/color.lux7
-rw-r--r--stdlib/source/lux/data/env.lux9
-rw-r--r--stdlib/source/lux/data/error.lux41
-rw-r--r--stdlib/source/lux/data/format/binary.lux39
-rw-r--r--stdlib/source/lux/data/format/context.lux2
-rw-r--r--stdlib/source/lux/data/format/css.lux13
-rw-r--r--stdlib/source/lux/data/format/css/value.lux7
-rw-r--r--stdlib/source/lux/data/format/html.lux42
-rw-r--r--stdlib/source/lux/data/format/json.lux67
-rw-r--r--stdlib/source/lux/data/format/xml.lux43
-rw-r--r--stdlib/source/lux/data/identity.lux18
-rw-r--r--stdlib/source/lux/data/lazy.lux10
-rw-r--r--stdlib/source/lux/data/maybe.lux51
-rw-r--r--stdlib/source/lux/data/name.lux10
-rw-r--r--stdlib/source/lux/data/number.lux961
-rw-r--r--stdlib/source/lux/data/number/complex.lux17
-rw-r--r--stdlib/source/lux/data/number/frac.lux441
-rw-r--r--stdlib/source/lux/data/number/int.lux134
-rw-r--r--stdlib/source/lux/data/number/nat.lux211
-rw-r--r--stdlib/source/lux/data/number/ratio.lux21
-rw-r--r--stdlib/source/lux/data/number/rev.lux291
-rw-r--r--stdlib/source/lux/data/store.lux10
-rw-r--r--stdlib/source/lux/data/text.lux23
-rw-r--r--stdlib/source/lux/data/text/buffer.lux2
-rw-r--r--stdlib/source/lux/data/text/format.lux34
-rw-r--r--stdlib/source/lux/data/text/lexer.lux23
-rw-r--r--stdlib/source/lux/data/text/regex.lux60
-rw-r--r--stdlib/source/lux/data/text/unicode.lux22
-rw-r--r--stdlib/source/lux/data/trace.lux6
-rw-r--r--stdlib/source/lux/function.lux2
-rw-r--r--stdlib/source/lux/host.js.lux2
-rw-r--r--stdlib/source/lux/host.jvm.lux144
-rw-r--r--stdlib/source/lux/host/jvm/attribute.lux18
-rw-r--r--stdlib/source/lux/host/jvm/class.lux30
-rw-r--r--stdlib/source/lux/host/jvm/constant.lux50
-rw-r--r--stdlib/source/lux/host/jvm/constant/pool.lux12
-rw-r--r--stdlib/source/lux/host/jvm/constant/tag.lux4
-rw-r--r--stdlib/source/lux/host/jvm/descriptor.lux2
-rw-r--r--stdlib/source/lux/host/jvm/encoding.lux12
-rw-r--r--stdlib/source/lux/host/jvm/field.lux12
-rw-r--r--stdlib/source/lux/host/jvm/index.lux6
-rw-r--r--stdlib/source/lux/host/jvm/loader.jvm.lux6
-rw-r--r--stdlib/source/lux/host/jvm/method.lux10
-rw-r--r--stdlib/source/lux/host/jvm/modifier.lux10
-rw-r--r--stdlib/source/lux/io.lux55
-rw-r--r--stdlib/source/lux/locale.lux10
-rw-r--r--stdlib/source/lux/locale/language.lux8
-rw-r--r--stdlib/source/lux/locale/territory.lux8
-rw-r--r--stdlib/source/lux/macro.lux111
-rw-r--r--stdlib/source/lux/macro/code.lux57
-rw-r--r--stdlib/source/lux/macro/poly.lux51
-rw-r--r--stdlib/source/lux/macro/poly/equivalence.lux50
-rw-r--r--stdlib/source/lux/macro/poly/functor.lux10
-rw-r--r--stdlib/source/lux/macro/poly/json.lux104
-rw-r--r--stdlib/source/lux/macro/syntax.lux40
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux18
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux2
-rw-r--r--stdlib/source/lux/macro/template.lux2
-rw-r--r--stdlib/source/lux/math/infix.lux8
-rw-r--r--stdlib/source/lux/math/logic/continuous.lux4
-rw-r--r--stdlib/source/lux/math/modular.lux11
-rw-r--r--stdlib/source/lux/math/random.lux59
-rw-r--r--stdlib/source/lux/platform/compiler.lux26
-rw-r--r--stdlib/source/lux/platform/compiler/cli.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/default/evaluation.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/default/init.lux18
-rw-r--r--stdlib/source/lux/platform/compiler/default/platform.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/default/syntax.lux16
-rw-r--r--stdlib/source/lux/platform/compiler/host/scheme.lux2
-rw-r--r--stdlib/source/lux/platform/compiler/meta/archive.lux22
-rw-r--r--stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux5
-rw-r--r--stdlib/source/lux/platform/compiler/meta/archive/document.lux20
-rw-r--r--stdlib/source/lux/platform/compiler/meta/archive/signature.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/meta/cache.lux14
-rw-r--r--stdlib/source/lux/platform/compiler/meta/cache/dependency.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/phase.lux20
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/case.lux32
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux32
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/expression.lux2
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/function.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/inference.lux22
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/macro.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/module.lux18
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/reference.lux8
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/scope.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/structure.lux24
-rw-r--r--stdlib/source/lux/platform/compiler/phase/analysis/type.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/phase/extension.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux12
-rw-r--r--stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux88
-rw-r--r--stdlib/source/lux/platform/compiler/phase/extension/bundle.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/phase/extension/statement.lux14
-rw-r--r--stdlib/source/lux/platform/compiler/phase/statement/total.lux2
-rw-r--r--stdlib/source/lux/platform/compiler/phase/synthesis.lux28
-rw-r--r--stdlib/source/lux/platform/compiler/phase/synthesis/case.lux14
-rw-r--r--stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux12
-rw-r--r--stdlib/source/lux/platform/compiler/phase/synthesis/function.lux30
-rw-r--r--stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux32
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation.lux12
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux16
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux15
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux8
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux6
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux2
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux2
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux16
-rw-r--r--stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux4
-rw-r--r--stdlib/source/lux/platform/compiler/reference.lux6
-rw-r--r--stdlib/source/lux/platform/interpreter.lux12
-rw-r--r--stdlib/source/lux/platform/interpreter/type.lux22
-rw-r--r--stdlib/source/lux/platform/mediator.lux20
-rw-r--r--stdlib/source/lux/platform/mediator/parallelism.lux169
-rw-r--r--stdlib/source/lux/test.lux18
-rw-r--r--stdlib/source/lux/time/date.lux241
-rw-r--r--stdlib/source/lux/time/day.lux76
-rw-r--r--stdlib/source/lux/time/duration.lux22
-rw-r--r--stdlib/source/lux/time/instant.lux93
-rw-r--r--stdlib/source/lux/time/month.lux101
-rw-r--r--stdlib/source/lux/type.lux18
-rw-r--r--stdlib/source/lux/type/abstract.lux12
-rw-r--r--stdlib/source/lux/type/check.lux76
-rw-r--r--stdlib/source/lux/type/dynamic.lux2
-rw-r--r--stdlib/source/lux/type/implicit.lux66
-rw-r--r--stdlib/source/lux/type/quotient.lux2
-rw-r--r--stdlib/source/lux/type/refinement.lux4
-rw-r--r--stdlib/source/lux/type/resource.lux62
-rw-r--r--stdlib/source/lux/type/unit.lux14
-rw-r--r--stdlib/source/lux/world/binary.lux4
-rw-r--r--stdlib/source/lux/world/console.lux6
-rw-r--r--stdlib/source/lux/world/db/jdbc.jvm.lux20
-rw-r--r--stdlib/source/lux/world/db/jdbc/input.jvm.lux8
-rw-r--r--stdlib/source/lux/world/db/jdbc/output.jvm.lux30
-rw-r--r--stdlib/source/lux/world/db/sql.lux4
-rw-r--r--stdlib/source/lux/world/environment.jvm.lux2
-rw-r--r--stdlib/source/lux/world/file.lux52
-rw-r--r--stdlib/source/lux/world/net/http/cookie.lux6
-rw-r--r--stdlib/source/lux/world/net/http/mime.lux11
-rw-r--r--stdlib/source/lux/world/net/http/query.lux13
-rw-r--r--stdlib/source/lux/world/net/http/request.lux24
-rw-r--r--stdlib/source/lux/world/net/http/response.lux24
-rw-r--r--stdlib/source/lux/world/net/http/route.lux4
-rw-r--r--stdlib/source/lux/world/net/tcp.jvm.lux16
-rw-r--r--stdlib/source/lux/world/net/udp.jvm.lux10
198 files changed, 3533 insertions, 3249 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index b7de70c5d..334632272 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1635,7 +1635,7 @@
($' m a)
($' m b)))))))
-(def:''' Monad<Maybe>
+(def:''' maybe-monad
#Nil
($' Monad Maybe)
{#wrap
@@ -1647,7 +1647,7 @@
(#Some a) (f a)}
ma))})
-(def:''' Monad<Meta>
+(def:''' meta-monad
#Nil
($' Monad Meta)
{#wrap
@@ -1852,17 +1852,17 @@
(return (tag$ ["lux" "Nil"]))
(#Cons lastI inits)
- (do Monad<Meta>
+ (do meta-monad
[lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
(let' [[[_module-name _ _] _] spliced]
(wrap spliced))
_
- (do Monad<Meta>
+ (do meta-monad
[lastO (untemplate lastI)]
(wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))}
lastI)]
- (monad/fold Monad<Meta>
+ (monad/fold meta-monad
(function' [leftI rightO]
({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
(let' [[[_module-name _ _] _] spliced]
@@ -1871,7 +1871,7 @@
rightO))))
_
- (do Monad<Meta>
+ (do meta-monad
[leftO (untemplate leftI)]
(wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))}
leftI))
@@ -1879,8 +1879,8 @@
inits))}
(list/reverse elems))
#0
- (do Monad<Meta>
- [=elems (monad/map Monad<Meta> untemplate elems)]
+ (do meta-monad
+ [=elems (monad/map meta-monad untemplate elems)]
(wrap (untemplate-list =elems)))}
replace?))
@@ -1923,7 +1923,7 @@
(return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name))))))))
[#1 [_ (#Identifier [module name])]]
- (do Monad<Meta>
+ (do meta-monad
[real-name ({""
(if (text/= "" subst)
(wrap [module name])
@@ -1942,7 +1942,7 @@
(return unquoted)
[#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]]
- (do Monad<Meta>
+ (do meta-monad
[independent (untemplate replace? subst dependent)]
(wrap (wrap-meta (form$ (list (tag$ ["lux" "Form"])
(untemplate-list (list (untemplate-text "lux in-module")
@@ -1953,24 +1953,24 @@
(untemplate #0 subst keep-quoted)
[_ [meta (#Form elems)]]
- (do Monad<Meta>
+ (do meta-monad
[output (splice replace? (untemplate replace? subst) elems)
#let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]]
(wrap [meta output']))
[_ [meta (#Tuple elems)]]
- (do Monad<Meta>
+ (do meta-monad
[output (splice replace? (untemplate replace? subst) elems)
#let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]]
(wrap [meta output']))
[_ [_ (#Record fields)]]
- (do Monad<Meta>
- [=fields (monad/map Monad<Meta>
+ (do meta-monad
+ [=fields (monad/map meta-monad
("lux check" (-> (& Code Code) ($' Meta Code))
(function' [kv]
(let' [[k v] kv]
- (do Monad<Meta>
+ (do meta-monad
[=k (untemplate replace? subst k)
=v (untemplate replace? subst v)]
(wrap (tuple$ (list =k =v)))))))
@@ -2016,7 +2016,7 @@
"## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." __paragraph
"(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))])
({(#Cons template #Nil)
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name
=template (untemplate #1 current-module template)]
(wrap (list (form$ (list (text$ "lux check")
@@ -2033,7 +2033,7 @@
"## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph
"(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))])
({(#Cons template #Nil)
- (do Monad<Meta>
+ (do meta-monad
[=template (untemplate #1 "" template)]
(wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template)))))
@@ -2047,7 +2047,7 @@
"## Quotation as a macro." __paragraph
"(' YOLO)"))])
({(#Cons template #Nil)
- (do Monad<Meta>
+ (do meta-monad
[=template (untemplate #0 "" template)]
(wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template)))))
@@ -2278,8 +2278,8 @@
_
(fail "Wrong syntax for do-template")}
- [(monad/map Monad<Maybe> get-short bindings)
- (monad/map Monad<Maybe> tuple->list data)])
+ [(monad/map maybe-monad get-short bindings)
+ (monad/map maybe-monad tuple->list data)])
_
(fail "Wrong syntax for do-template")}
@@ -2621,7 +2621,7 @@
(-> ($' List (& Text Module))
Text Text Text
($' Maybe Macro))
- (do Monad<Maybe>
+ (do maybe-monad
[$module (get module modules)
gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)]
(get name bindings))]
@@ -2650,7 +2650,7 @@
#Nil
(-> Name ($' Meta Name))
({["" name]
- (do Monad<Meta>
+ (do meta-monad
[module-name current-module-name]
(wrap [module-name name]))
@@ -2661,7 +2661,7 @@
(def:''' (find-macro full-name)
#Nil
(-> Name ($' Meta ($' Maybe Macro)))
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name]
(let' [[module name] full-name]
(function' [state]
@@ -2676,7 +2676,7 @@
(def:''' (macro? name)
#Nil
(-> Name ($' Meta Bit))
- (do Monad<Meta>
+ (do meta-monad
[name (normalize name)
output (find-macro name)]
(wrap ({(#Some _) #1
@@ -2707,7 +2707,7 @@
#Nil
(-> Code ($' Meta ($' List Code)))
({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))]
- (do Monad<Meta>
+ (do meta-monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
({(#Some macro)
@@ -2725,13 +2725,13 @@
#Nil
(-> Code ($' Meta ($' List Code)))
({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))]
- (do Monad<Meta>
+ (do meta-monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
({(#Some macro)
- (do Monad<Meta>
+ (do meta-monad
[expansion (macro args)
- expansion' (monad/map Monad<Meta> macro-expand expansion)]
+ expansion' (monad/map meta-monad macro-expand expansion)]
(wrap (list/join expansion')))
#None
@@ -2746,37 +2746,37 @@
#Nil
(-> Code ($' Meta ($' List Code)))
({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))]
- (do Monad<Meta>
+ (do meta-monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
({(#Some macro)
- (do Monad<Meta>
+ (do meta-monad
[expansion (macro args)
- expansion' (monad/map Monad<Meta> macro-expand-all expansion)]
+ expansion' (monad/map meta-monad macro-expand-all expansion)]
(wrap (list/join expansion')))
#None
- (do Monad<Meta>
- [args' (monad/map Monad<Meta> macro-expand-all args)]
+ (do meta-monad
+ [args' (monad/map meta-monad macro-expand-all args)]
(wrap (list (form$ (#Cons (identifier$ macro-name) (list/join args'))))))}
?macro))
[_ (#Form members)]
- (do Monad<Meta>
- [members' (monad/map Monad<Meta> macro-expand-all members)]
+ (do meta-monad
+ [members' (monad/map meta-monad macro-expand-all members)]
(wrap (list (form$ (list/join members')))))
[_ (#Tuple members)]
- (do Monad<Meta>
- [members' (monad/map Monad<Meta> macro-expand-all members)]
+ (do meta-monad
+ [members' (monad/map meta-monad macro-expand-all members)]
(wrap (list (tuple$ (list/join members')))))
[_ (#Record pairs)]
- (do Monad<Meta>
- [pairs' (monad/map Monad<Meta>
+ (do meta-monad
+ [pairs' (monad/map meta-monad
(function' [kv]
(let' [[key val] kv]
- (do Monad<Meta>
+ (do meta-monad
[val' (macro-expand-all val)]
({(#Cons val'' #Nil)
(return [key val''])
@@ -2825,7 +2825,7 @@
"## Takes a type expression and returns it's representation as data-structure." __paragraph
"(type (All [a] (Maybe (List a))))"))])
({(#Cons type #Nil)
- (do Monad<Meta>
+ (do meta-monad
[type+ (macro-expand-all type)]
({(#Cons type' #Nil)
(wrap (list (walk-type type')))
@@ -2882,8 +2882,8 @@
#Nil
(-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text)))))
({(#Cons [_ (#Record pairs)] #Nil)
- (do Monad<Meta>
- [members (monad/map Monad<Meta>
+ (do meta-monad
+ [members (monad/map meta-monad
(: (-> [Code Code] (Meta [Text Code]))
(function' [pair]
({[[_ (#Tag "" member-name)] member-type]
@@ -2908,8 +2908,8 @@
type)
(#Cons case cases)
- (do Monad<Meta>
- [members (monad/map Monad<Meta>
+ (do meta-monad
+ [members (monad/map meta-monad
(: (-> Code (Meta [Text Code]))
(function' [case]
({[_ (#Tag "" member-name)]
@@ -3093,25 +3093,25 @@
({(#Cons [_ (#Form (#Cons [_ (#Identifier macro-name)] macro-args))]
(#Cons body
branches'))
- (do Monad<Meta>
+ (do meta-monad
[??? (macro? macro-name)]
(if ???
- (do Monad<Meta>
+ (do meta-monad
[init-expansion (macro-expand-once (form$ (list& (identifier$ macro-name) (form$ macro-args) body branches')))]
(expander init-expansion))
- (do Monad<Meta>
+ (do meta-monad
[sub-expansion (expander branches')]
(wrap (list& (form$ (list& (identifier$ macro-name) macro-args))
body
sub-expansion)))))
(#Cons pattern (#Cons body branches'))
- (do Monad<Meta>
+ (do meta-monad
[sub-expansion (expander branches')]
(wrap (list& pattern body sub-expansion)))
#Nil
- (do Monad<Meta> [] (wrap (list)))
+ (do meta-monad [] (wrap (list)))
_
(fail ($_ text/compose "'lux.case' expects an even number of tokens: " (|> branches
@@ -3132,7 +3132,7 @@
" " "_" ..new-line
" " "#None)"))])
({(#Cons value branches)
- (do Monad<Meta>
+ (do meta-monad
[expansion (expander branches)]
(wrap (list (` ((~ (record$ (as-pairs expansion))) (~ value))))))
@@ -3153,7 +3153,7 @@
" #None)"))])
(case tokens
(#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches))
- (do Monad<Meta>
+ (do meta-monad
[pattern+ (macro-expand-all pattern)]
(case pattern+
(#Cons pattern' #Nil)
@@ -3514,11 +3514,11 @@
#None))]
(case ?parts
(#Some name args meta sigs)
- (do Monad<Meta>
+ (do meta-monad
[name+ (normalize name)
- sigs' (monad/map Monad<Meta> macro-expand sigs)
+ sigs' (monad/map meta-monad macro-expand sigs)
members (: (Meta (List [Text Code]))
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Code (Meta [Text Code]))
(function (_ token)
(case token
@@ -3723,7 +3723,7 @@
(#Some (beta-reduce (list& type-fn param env) body))
(#Apply A F)
- (do Monad<Maybe>
+ (do maybe-monad
[type-fn* (apply-type F A)]
(apply-type type-fn* param))
@@ -3765,7 +3765,7 @@
(#Some (flatten-tuple type))
(#Apply arg func)
- (do Monad<Maybe>
+ (do maybe-monad
[output (apply-type func arg)]
(resolve-struct-type output))
@@ -3800,13 +3800,13 @@
(def: get-current-module
(Meta Module)
- (do Monad<Meta>
+ (do meta-monad
[module-name current-module-name]
(find-module module-name)))
(def: (resolve-tag [module name])
(-> Name (Meta [Nat (List Name) Bit Type]))
- (do Monad<Meta>
+ (do meta-monad
[=module (find-module module)
#let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]]
(case (get name tags-table)
@@ -3829,7 +3829,7 @@
(resolve-type-tags body)
(#Named [module name] unnamed)
- (do Monad<Meta>
+ (do meta-monad
[=module (find-module module)
#let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]]
(case (get name types)
@@ -3863,8 +3863,8 @@
(macro: #export (structure tokens)
{#.doc "Not meant to be used directly. Prefer 'structure:'."}
- (do Monad<Meta>
- [tokens' (monad/map Monad<Meta> macro-expand tokens)
+ (do meta-monad
+ [tokens' (monad/map meta-monad macro-expand tokens)
struct-type get-expected-type
tags+type (resolve-type-tags struct-type)
tags (: (Meta (List Name))
@@ -3877,7 +3877,7 @@
#let [tag-mappings (: (List [Text Code])
(list/map (function (_ tag) [(second tag) (tag$ tag)])
tags))]
- members (monad/map Monad<Meta>
+ members (monad/map meta-monad
(: (-> Code (Meta [Code Code]))
(function (_ token)
(case token
@@ -3909,8 +3909,8 @@
(macro: #export (structure: tokens)
{#.doc (text$ ($_ "lux text concat"
"## Definition of structures ala ML." ..new-line
- "(structure: #export Ord<Int> (Ord Int)" ..new-line
- " (def: eq Equivalence<Int>)" ..new-line
+ "(structure: #export order (Order Int)" ..new-line
+ " (def: &equivalence equivalence)" ..new-line
" (def: (< test subject)" ..new-line
" (lux.i/< test subject))" ..new-line
" (def: (<= test subject)" ..new-line
@@ -3940,47 +3940,17 @@
#None))]
(case ?parts
(#Some [name args type meta definitions])
- (case (case name
- [_ (#Identifier ["" "_"])]
- (case type
- (^ [_ (#Form (list& [_ (#Identifier [_ sig-name])] sig-args))])
- (case (: (Maybe (List Text))
- (monad/map Monad<Maybe>
- (function (_ sa)
- (case sa
- [_ (#Identifier [_ arg-name])]
- (#Some arg-name)
+ (let [usage (case args
+ #Nil
+ name
- _
- #None))
- sig-args))
- (^ (#Some params))
- (#Some (identifier$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") (text/join-with "")) ">")]))
-
- _
- #None)
-
- _
- #None)
-
- _
- (#Some name)
- )
- (#Some name)
- (let [usage (case args
- #Nil
- name
-
- _
- (` ((~ name) (~+ args))))]
- (return (list (` (..def: (~+ (export exported?)) (~ usage)
- (~ (meta-code-merge (` {#.struct? #1})
- meta))
- (~ type)
- (structure (~+ definitions)))))))
-
- #None
- (fail "Cannot infer name, so struct must have a name other than '_'!"))
+ _
+ (` ((~ name) (~+ args))))]
+ (return (list (` (..def: (~+ (export exported?)) (~ usage)
+ (~ (meta-code-merge (` {#.struct? #1})
+ meta))
+ (~ type)
+ (structure (~+ definitions)))))))
#None
(fail "Wrong syntax for structure:"))))
@@ -4022,7 +3992,7 @@
#None))]
(case parts
(#Some name args meta type-codes)
- (do Monad<Meta>
+ (do meta-monad
[type+tags?? (unfold-type-def type-codes)
module-name current-module-name]
(let [type-name (identifier$ ["" name])
@@ -4100,7 +4070,7 @@
(def: (extract-defs defs)
(-> (List Code) (Meta (List Text)))
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Code (Meta Text))
(function (_ def)
(case def
@@ -4116,13 +4086,13 @@
(case tokens
(^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens'))
(^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens')))
- (do Monad<Meta>
+ (do meta-monad
[defs' (extract-defs defs)]
(return [(#Only defs') tokens']))
(^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens'))
(^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens')))
- (do Monad<Meta>
+ (do meta-monad
[defs' (extract-defs defs)]
(return [(#Exclude defs') tokens']))
@@ -4140,8 +4110,8 @@
(return [#.Nil #.Nil])
(^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts'))
- (do Monad<Meta>
- [structs' (monad/map Monad<Meta>
+ (do meta-monad
+ [structs' (monad/map meta-monad
(function (_ struct)
(case struct
[_ (#Identifier ["" struct-name])]
@@ -4165,7 +4135,7 @@
(def: (split-with token sample)
(-> Text Text (Maybe [Text Text]))
- (do ..Monad<Maybe>
+ (do ..maybe-monad
[index (..index-of token sample)
#let [[pre post'] (split! index sample)
[_ post] (split! ("lux text size" token) post')]]
@@ -4259,14 +4229,14 @@
(def: (parse-imports nested? relative-root imports)
(-> Bit Text (List Code) (Meta (List Importation)))
- (do Monad<Meta>
- [imports' (monad/map Monad<Meta>
+ (do meta-monad
+ [imports' (monad/map meta-monad
(: (-> Code (Meta (List Importation)))
(function (_ token)
(case token
## Simple
[_ (#Identifier ["" m-name])]
- (do Monad<Meta>
+ (do meta-monad
[m-name (clean-module nested? relative-root m-name)]
(wrap (list {#import-name m-name
#import-alias #None
@@ -4275,7 +4245,7 @@
## Nested
(^ [_ (#Tuple (list& [_ (#Identifier ["" m-name])] extra))])
- (do Monad<Meta>
+ (do meta-monad
[import-name (clean-module nested? relative-root m-name)
referral+extra (parse-referrals extra)
#let [[referral extra] referral+extra]
@@ -4291,7 +4261,7 @@
sub-imports))))
(^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m-name])] extra))])
- (do Monad<Meta>
+ (do meta-monad
[import-name (clean-module nested? relative-root m-name)
referral+extra (parse-referrals extra)
#let [[referral extra] referral+extra]
@@ -4308,25 +4278,25 @@
(^ [_ (#Record (list [[_ (#Tuple (list [_ (#Nat alteration)]
[_ (#Tag ["" domain])]))]
parallel-tree]))])
- (do Monad<Meta>
+ (do meta-monad
[parallel-imports (parse-imports nested? relative-root (list parallel-tree))]
(wrap (list/map (alter-domain alteration domain) parallel-imports)))
(^ [_ (#Record (list [[_ (#Nat alteration)]
parallel-tree]))])
- (do Monad<Meta>
+ (do meta-monad
[parallel-imports (parse-imports nested? relative-root (list parallel-tree))]
(wrap (list/map (alter-domain alteration "") parallel-imports)))
(^ [_ (#Record (list [[_ (#Tag ["" domain])]
parallel-tree]))])
- (do Monad<Meta>
+ (do meta-monad
[parallel-imports (parse-imports nested? relative-root (list parallel-tree))
#let [alteration (list/size (text/split-all-with ..module-separator domain))]]
(wrap (list/map (alter-domain alteration domain) parallel-imports)))
_
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name]
(fail (text/compose "Wrong syntax for import @ " current-module))))))
imports)]
@@ -4460,7 +4430,7 @@
(def: (find-type full-name)
(-> Name (Meta Type))
- (do Monad<Meta>
+ (do meta-monad
[#let [[module name] full-name]
current-module current-module-name]
(function (_ compiler)
@@ -4569,12 +4539,12 @@
" (range' <= succ from to))"))}
(case tokens
(^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches))
- (do Monad<Meta>
+ (do meta-monad
[g!temp (gensym "temp")]
(wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches)))
(^ (list [_ (#Identifier name)] [_ (#Text alias)] body))
- (do Monad<Meta>
+ (do meta-monad
[init-type (find-type name)
struct-evidence (resolve-type-tags init-type)]
(case struct-evidence
@@ -4582,17 +4552,17 @@
(fail (text/compose "Can only 'open' structs: " (type/encode init-type)))
(#Some tags&members)
- (do Monad<Meta>
+ (do meta-monad
[full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code))
(function (recur source [tags members] target)
(let [pattern (record$ (list/map (function (_ [t-module t-name])
[(tag$ [t-module t-name])
(identifier$ ["" (de-alias t-name alias)])])
tags))]
- (do Monad<Meta>
- [enhanced-target (monad/fold Monad<Meta>
+ (do meta-monad
+ [enhanced-target (monad/fold meta-monad
(function (_ [[_ m-name] m-type] enhanced-target)
- (do Monad<Meta>
+ (do meta-monad
[m-structure (resolve-type-tags m-type)]
(case m-structure
(#Some m-tags&members)
@@ -4659,7 +4629,7 @@
" (getter my-record))"))}
(case tokens
(^ (list [_ (#Tag slot')] record))
- (do Monad<Meta>
+ (do meta-monad
[slot (normalize slot')
output (resolve-tag slot)
#let [[idx tags exported? type] output]
@@ -4687,7 +4657,7 @@
slots)))
(^ (list selector))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!record (gensym "record")]
(wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record)))))))
@@ -4697,13 +4667,13 @@
(def: (open-field alias [module name] source type)
(-> Text Name Code Type (Meta (List Code)))
- (do Monad<Meta>
+ (do meta-monad
[output (resolve-type-tags type)
#let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]]
(case output
(#Some [tags members])
- (do Monad<Meta>
- [decls' (monad/map Monad<Meta>
+ (do meta-monad
+ [decls' (monad/map meta-monad
(: (-> [Name Type] (Meta (List Code)))
(function (_ [sname stype]) (open-field alias sname source+ stype)))
(zip2 tags members))]
@@ -4719,27 +4689,27 @@
"## Opens a structure and generates a definition for each of its members (including nested members)."
__paragraph
"## For example:" ..new-line
- "(open: ''i:.'' Number<Int>)"
+ "(open: ''i:.'' number)"
__paragraph
"## Will generate:" ..new-line
- "(def: i:+ (:: Number<Int> +))" ..new-line
- "(def: i:- (:: Number<Int> -))" ..new-line
- "(def: i:* (:: Number<Int> *))" ..new-line
+ "(def: i:+ (:: number +))" ..new-line
+ "(def: i:- (:: number -))" ..new-line
+ "(def: i:* (:: number *))" ..new-line
"..."))}
(case tokens
(^ (list [_ (#Text alias)] struct))
(case struct
[_ (#Identifier struct-name)]
- (do Monad<Meta>
+ (do meta-monad
[struct-type (find-type struct-name)
output (resolve-type-tags struct-type)
#let [source (identifier$ struct-name)]]
(case output
(#Some [tags members])
- (do Monad<Meta>
- [decls' (monad/map Monad<Meta> (: (-> [Name Type] (Meta (List Code)))
- (function (_ [sname stype])
- (open-field alias sname source stype)))
+ (do meta-monad
+ [decls' (monad/map meta-monad (: (-> [Name Type] (Meta (List Code)))
+ (function (_ [sname stype])
+ (open-field alias sname source stype)))
(zip2 tags members))]
(return (list/join decls')))
@@ -4747,7 +4717,7 @@
(fail (text/compose "Can only 'open:' structs: " (type/encode struct-type)))))
_
- (do Monad<Meta>
+ (do meta-monad
[g!struct (gensym "struct")]
(return (list (` ("lux def" (~ g!struct) (~ struct)
[(~ cursor-code) (#.Record #Nil)]))
@@ -4762,7 +4732,7 @@
"(|>> (list/map int/encode) (interpose '' '') (fold text/compose ''''))" ..new-line
"## =>" ..new-line
"(function (_ <arg>) (fold text/compose '''' (interpose '' '' (list/map int/encode <arg>))))"))}
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!arg (gensym "arg")]
(return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens))))))))
@@ -4773,21 +4743,21 @@
"(<<| (fold text/compose '''') (interpose '' '') (list/map int/encode))" ..new-line
"## =>" ..new-line
"(function (_ <arg>) (fold text/compose '''' (interpose '' '' (list/map int/encode <arg>))))"))}
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!arg (gensym "arg")]
(return (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg))))))))
(def: (imported-by? import-name module-name)
(-> Text Text (Meta Bit))
- (do Monad<Meta>
+ (do meta-monad
[module (find-module module-name)
#let [{#module-hash _ #module-aliases _ #definitions _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]]
(wrap (is-member? imports import-name))))
(def: (read-refer module-name options)
(-> Text (List Code) (Meta Refer))
- (do Monad<Meta>
+ (do meta-monad
[referral+options (parse-referrals options)
#let [[referral options] referral+options]
openings+options (parse-openings options)
@@ -4795,7 +4765,7 @@
current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
(function (_ module-name all-defs referred-defs)
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Text (Meta Any))
(function (_ _def)
(if (is-member? all-defs _def)
@@ -4816,11 +4786,11 @@
(def: (write-refer module-name [r-defs r-opens])
(-> Text Refer (Meta (List Code)))
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
(function (_ module-name all-defs referred-defs)
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Text (Meta Any))
(function (_ _def)
(if (is-member? all-defs _def)
@@ -4832,13 +4802,13 @@
(exported-definitions module-name)
(#Only +defs)
- (do Monad<Meta>
+ (do meta-monad
[*defs (exported-definitions module-name)
_ (test-referrals module-name *defs +defs)]
(wrap +defs))
(#Exclude -defs)
- (do Monad<Meta>
+ (do meta-monad
[*defs (exported-definitions module-name)
_ (test-referrals module-name *defs -defs)]
(wrap (filter (|>> (is-member? -defs) not) *defs)))
@@ -4866,7 +4836,7 @@
(macro: #export (refer tokens)
(case tokens
(^ (list& [_ (#Text module-name)] options))
- (do Monad<Meta>
+ (do meta-monad
[=refer (read-refer module-name options)]
(write-refer module-name =refer))
@@ -4908,12 +4878,12 @@
" [''M'' monad #*]]" ..new-line
" [data" ..new-line
" maybe" ..new-line
- " [''.'' name (''name/.'' Codec<Text,Name>)]]" ..new-line
+ " [''.'' name (''name/.'' codec)]]" ..new-line
" [macro" ..new-line
" code]]" ..new-line
" [//" ..new-line
- " [type (''.'' Equivalence<Type>)]])"))}
- (do Monad<Meta>
+ " [type (''.'' equivalence)]])"))}
+ (do meta-monad
[#let [[_meta _imports] (: [(List [Code Code]) (List Code)]
(case tokens
(^ (list& [_ (#Record _meta)] _imports))
@@ -4940,10 +4910,10 @@
(macro: #export (:: tokens)
{#.doc (text$ ($_ "lux text concat"
"## Allows accessing the value of a structure's member." ..new-line
- "(:: Codec<Text,Int> encode)"
+ "(:: codec encode)"
__paragraph
"## Also allows using that value as a function." ..new-line
- "(:: Codec<Text,Int> encode +123)"))}
+ "(:: codec encode +123)"))}
(case tokens
(^ (list struct [_ (#Identifier member)]))
(return (list (` (let [(^open ".") (~ struct)] (~ (identifier$ member))))))
@@ -4967,17 +4937,17 @@
"(let [setter (set@ [#foo #bar #baz])] (setter value my-record))"))}
(case tokens
(^ (list [_ (#Tag slot')] value record))
- (do Monad<Meta>
+ (do meta-monad
[slot (normalize slot')
output (resolve-tag slot)
#let [[idx tags exported? type] output]]
(case (resolve-struct-type type)
(#Some members)
- (do Monad<Meta>
- [pattern' (monad/map Monad<Meta>
+ (do meta-monad
+ [pattern' (monad/map meta-monad
(: (-> [Name [Nat Type]] (Meta [Name Nat Code]))
(function (_ [r-slot-name [r-idx r-type]])
- (do Monad<Meta>
+ (do meta-monad
[g!slot (gensym "")]
(return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
@@ -5004,8 +4974,8 @@
(fail "Wrong syntax for set@")
_
- (do Monad<Meta>
- [bindings (monad/map Monad<Meta>
+ (do meta-monad
+ [bindings (monad/map meta-monad
(: (-> Code (Meta Code))
(function (_ _) (gensym "temp")))
slots)
@@ -5026,13 +4996,13 @@
(~ update-expr)))))))
(^ (list selector value))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!record (gensym "record")]
(wrap (list (` (function ((~ g!_) (~ g!record)) (..set@ (~ selector) (~ value) (~ g!record)))))))
(^ (list selector))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!value (gensym "value")
g!record (gensym "record")]
@@ -5054,17 +5024,17 @@
"(let [updater (update@ [#foo #bar #baz])] (updater func my-record))"))}
(case tokens
(^ (list [_ (#Tag slot')] fun record))
- (do Monad<Meta>
+ (do meta-monad
[slot (normalize slot')
output (resolve-tag slot)
#let [[idx tags exported? type] output]]
(case (resolve-struct-type type)
(#Some members)
- (do Monad<Meta>
- [pattern' (monad/map Monad<Meta>
+ (do meta-monad
+ [pattern' (monad/map meta-monad
(: (-> [Name [Nat Type]] (Meta [Name Nat Code]))
(function (_ [r-slot-name [r-idx r-type]])
- (do Monad<Meta>
+ (do meta-monad
[g!slot (gensym "")]
(return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
@@ -5091,7 +5061,7 @@
(fail "Wrong syntax for update@")
_
- (do Monad<Meta>
+ (do meta-monad
[g!record (gensym "record")
g!temp (gensym "temp")]
(wrap (list (` (let [(~ g!record) (~ record)
@@ -5099,13 +5069,13 @@
(set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record))))))))
(^ (list selector fun))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!record (gensym "record")]
(wrap (list (` (function ((~ g!_) (~ g!record)) (..update@ (~ selector) (~ fun) (~ g!record)))))))
(^ (list selector))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!fun (gensym "fun")
g!record (gensym "record")]
@@ -5154,9 +5124,9 @@
[_ (#Form data)]
branches))
(case (: (Maybe (List Code))
- (do Monad<Maybe>
- [bindings' (monad/map Monad<Maybe> get-short bindings)
- data' (monad/map Monad<Maybe> tuple->list data)]
+ (do maybe-monad
+ [bindings' (monad/map maybe-monad get-short bindings)
+ data' (monad/map maybe-monad tuple->list data)]
(if (every? (n/= (list/size bindings')) (list/map list/size data'))
(let [apply (: (-> RepEnv (List Code))
(function (_ env) (list/map (apply-template env) templates)))]
@@ -5426,20 +5396,20 @@
vars (list/map first pairs)
inits (list/map second pairs)]
(if (every? identifier? inits)
- (do Monad<Meta>
+ (do meta-monad
[inits' (: (Meta (List Name))
- (case (monad/map Monad<Maybe> get-name inits)
+ (case (monad/map maybe-monad get-name inits)
(#Some inits') (return inits')
#None (fail "Wrong syntax for loop")))
- init-types (monad/map Monad<Meta> find-type inits')
+ init-types (monad/map meta-monad find-type inits')
expected get-expected-type]
(return (list (` (("lux check" (-> (~+ (list/map type-to-code init-types))
(~ (type-to-code expected)))
(function ((~ name) (~+ vars))
(~ body)))
(~+ inits))))))
- (do Monad<Meta>
- [aliases (monad/map Monad<Meta>
+ (do meta-monad
+ [aliases (monad/map meta-monad
(: (-> Code (Meta Code))
(function (_ _) (gensym "")))
inits)]
@@ -5457,12 +5427,12 @@
(f foo bar baz)))}
(case tokens
(^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches))
- (do Monad<Meta>
+ (do meta-monad
[slots (: (Meta [Name (List Name)])
(case (: (Maybe [Name (List Name)])
- (do Monad<Maybe>
+ (do maybe-monad
[hslot (get-tag hslot')
- tslots (monad/map Monad<Maybe> get-tag tslots')]
+ tslots (monad/map maybe-monad get-tag tslots')]
(wrap [hslot tslots])))
(#Some slots)
(return slots)
@@ -5471,7 +5441,7 @@
(fail "Wrong syntax for ^slots")))
#let [[hslot tslots] slots]
hslot (normalize hslot)
- tslots (monad/map Monad<Meta> normalize tslots)
+ tslots (monad/map meta-monad normalize tslots)
output (resolve-tag hslot)
g!_ (gensym "_")
#let [[idx tags exported? type] output
@@ -5504,18 +5474,18 @@
(^template [<tag> <ctor>]
[_ (<tag> elems)]
- (do Monad<Maybe>
- [placements (monad/map Monad<Maybe> (place-tokens label tokens) elems)]
+ (do maybe-monad
+ [placements (monad/map maybe-monad (place-tokens label tokens) elems)]
(wrap (list (<ctor> (list/join placements))))))
([#Tuple tuple$]
[#Form form$])
[_ (#Record pairs)]
- (do Monad<Maybe>
- [=pairs (monad/map Monad<Maybe>
+ (do maybe-monad
+ [=pairs (monad/map maybe-monad
(: (-> [Code Code] (Maybe [Code Code]))
(function (_ [slot value])
- (do Monad<Maybe>
+ (do maybe-monad
[slot' (place-tokens label tokens slot)
value' (place-tokens label tokens value)]
(case [slot' value']
@@ -5537,7 +5507,7 @@
[<tests> (do-template [<expr> <text> <pattern>]
[(compare <pattern> <expr>)
(compare <text> (:: Code/encode encode <expr>))
- (compare #1 (:: Equivalence<Code> = <expr> <expr>))]
+ (compare #1 (:: equivalence = <expr> <expr>))]
[(bit #1) "#1" [_ (#.Bit #1)]]
[(bit #0) "#0" [_ (#.Bit #0)]]
@@ -5557,7 +5527,7 @@
(^ (list& [_ (#Tuple bindings)] bodies))
(case bindings
(^ (list& [_ (#Identifier ["" var-name])] macro-expr bindings'))
- (do Monad<Meta>
+ (do meta-monad
[expansion (macro-expand-once macro-expr)]
(case (place-tokens var-name expansion (` (.with-expansions
[(~+ bindings')]
@@ -5598,7 +5568,7 @@
(def: (anti-quote-def name)
(-> Name (Meta Code))
- (do Monad<Meta>
+ (do meta-monad
[type+value (find-def-value name)
#let [[type value] type+value]]
(case (flatten-alias type)
@@ -5620,38 +5590,38 @@
(case token
[_ (#Identifier [def-prefix def-name])]
(if (text/= "" def-prefix)
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name]
(anti-quote-def [current-module def-name]))
(anti-quote-def [def-prefix def-name]))
(^template [<tag>]
[meta (<tag> parts)]
- (do Monad<Meta>
- [=parts (monad/map Monad<Meta> anti-quote parts)]
+ (do meta-monad
+ [=parts (monad/map meta-monad anti-quote parts)]
(wrap [meta (<tag> =parts)])))
([#Form]
[#Tuple])
[meta (#Record pairs)]
- (do Monad<Meta>
- [=pairs (monad/map Monad<Meta>
+ (do meta-monad
+ [=pairs (monad/map meta-monad
(: (-> [Code Code] (Meta [Code Code]))
(function (_ [slot value])
- (do Monad<Meta>
+ (do meta-monad
[=value (anti-quote value)]
(wrap [slot =value]))))
pairs)]
(wrap [meta (#Record =pairs)]))
_
- (:: Monad<Meta> return token)
+ (:: meta-monad return token)
))
(macro: #export (static tokens)
(case tokens
(^ (list pattern))
- (do Monad<Meta>
+ (do meta-monad
[pattern' (anti-quote pattern)]
(wrap (list pattern')))
@@ -5678,8 +5648,8 @@
(fail "Multi-level patterns cannot be empty.")
(#Cons init extras)
- (do Monad<Meta>
- [extras' (monad/map Monad<Meta> case-level^ extras)]
+ (do meta-monad
+ [extras' (monad/map meta-monad case-level^ extras)]
(wrap [init extras']))))
(def: (multi-level-case$ g!_ [[init-pattern levels] body])
@@ -5716,7 +5686,7 @@
(#.Left (format "Static part " (%t static) " does not match URI: " uri))))}
(case tokens
(^ (list& [_meta (#Form levels)] body next-branches))
- (do Monad<Meta>
+ (do meta-monad
[mlc (multi-level-case^ levels)
expected get-expected-type
g!temp (gensym "temp")]
@@ -5804,7 +5774,7 @@
list)))}
(case tokens
(^ (list [_ (#Nat idx)]))
- (do Monad<Meta>
+ (do meta-monad
[stvs get-scope-type-vars]
(case (list-at idx (list/reverse stvs))
(#Some var-id)
@@ -5864,7 +5834,7 @@
(: Dinosaur (:assume (list +1 +2 +3))))}
(case tokens
(^ (list expr))
- (do Monad<Meta>
+ (do meta-monad
[type get-expected-type]
(wrap (list (` ("lux coerce" (~ (type-to-code type)) (~ expr))))))
@@ -5899,12 +5869,12 @@
Int)}
(case tokens
(^ (list [_ (#Identifier var-name)]))
- (do Monad<Meta>
+ (do meta-monad
[var-type (find-type var-name)]
(wrap (list (type-to-code var-type))))
(^ (list expression))
- (do Monad<Meta>
+ (do meta-monad
[g!temp (gensym "g!temp")]
(wrap (list (` (let [(~ g!temp) (~ expression)]
(..:of (~ g!temp)))))))
@@ -5916,8 +5886,8 @@
(-> (List Code) (Meta [[Text (List Text)] (List Code)]))
(case tokens
(^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens'))
- (do Monad<Meta>
- [args (monad/map Monad<Meta>
+ (do meta-monad
+ [args (monad/map meta-monad
(function (_ arg')
(case arg'
[_ (#Identifier ["" arg-name])]
@@ -5977,7 +5947,7 @@
"For simple macros that do not need any fancy features."
(template: (square x)
(i/* x x)))}
- (do Monad<Meta>
+ (do meta-monad
[#let [[export? tokens] (export^ tokens)]
name+args|tokens (parse-complex-declaration tokens)
#let [[[name args] tokens] name+args|tokens]
@@ -6051,7 +6021,7 @@
))
(macro: #export (for tokens)
- (do Monad<Meta>
+ (do meta-monad
[target target]
(case tokens
(^ (list [_ (#Record options)]))
@@ -6081,23 +6051,23 @@
(-> Code (Meta [(List [Code Code]) Code]))
(case code
(^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))])
- (do Monad<Meta>
+ (do meta-monad
[g!expansion (gensym "g!expansion")]
(wrap [(list [g!expansion expansion]) g!expansion]))
(^template [<tag>]
[ann (<tag> parts)]
- (do Monad<Meta>
- [=parts (monad/map Monad<Meta> label-code parts)]
+ (do meta-monad
+ [=parts (monad/map meta-monad label-code parts)]
(wrap [(list/fold list/compose (list) (list/map left =parts))
[ann (<tag> (list/map right =parts))]])))
([#Form] [#Tuple])
[ann (#Record kvs)]
- (do Monad<Meta>
- [=kvs (monad/map Monad<Meta>
+ (do meta-monad
+ [=kvs (monad/map meta-monad
(function (_ [key val])
- (do Monad<Meta>
+ (do meta-monad
[=key (label-code key)
=val (label-code val)
#let [[key-labels key-labelled] =key
@@ -6113,7 +6083,7 @@
(macro: #export (`` tokens)
(case tokens
(^ (list raw))
- (do Monad<Meta>
+ (do meta-monad
[=raw (label-code raw)
#let [[labels labelled] =raw]]
(wrap (list (` (with-expansions [(~+ (|> labels
@@ -6143,7 +6113,7 @@
(case pattern
(^template [<tag> <name> <gen>]
[_ (<tag> value)]
- (do Monad<Meta>
+ (do meta-monad
[g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))))
([#Bit "Bit" bit$]
@@ -6156,10 +6126,10 @@
[#Identifier "Identifier" name$])
[_ (#Record fields)]
- (do Monad<Meta>
- [=fields (monad/map Monad<Meta>
+ (do meta-monad
+ [=fields (monad/map meta-monad
(function (_ [key value])
- (do Monad<Meta>
+ (do meta-monad
[=key (untemplate-pattern key)
=value (untemplate-pattern value)]
(wrap (` [(~ =key) (~ =value)]))))
@@ -6178,14 +6148,14 @@
(case (list/reverse elems)
(#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
inits)
- (do Monad<Meta>
- [=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits))
+ (do meta-monad
+ [=inits (monad/map meta-monad untemplate-pattern (list/reverse inits))
g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))])))
_
- (do Monad<Meta>
- [=elems (monad/map Monad<Meta> untemplate-pattern elems)
+ (do meta-monad
+ [=elems (monad/map meta-monad untemplate-pattern elems)
g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))])))))
([#Tuple] [#Form])
@@ -6194,12 +6164,12 @@
(macro: #export (^code tokens)
(case tokens
(^ (list& [_meta (#Form (list template))] body branches))
- (do Monad<Meta>
+ (do meta-monad
[pattern (untemplate-pattern template)]
(wrap (list& pattern body branches)))
(^ (list template))
- (do Monad<Meta>
+ (do meta-monad
[pattern (untemplate-pattern template)]
(wrap (list pattern)))
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index b86b2a51b..b6c6693ee 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -7,8 +7,8 @@
["." process]]]
[data
[collection
- [list ("list/." Monoid<List> Monad<List>)]]
- ["." text ("text/." Equivalence<Text>)
+ [list ("list/." monoid monad)]]
+ ["." text ("text/." equivalence)
format]
["." error (#+ Error)]]
[macro (#+ with-gensyms)
@@ -54,7 +54,7 @@
{#.doc "Parses the next input with a parsing function."}
(All [a] (-> (-> Text (Error a)) (CLI a)))
(function (_ inputs)
- (do error.Monad<Error>
+ (do error.monad
[[remaining raw] (any inputs)
output (parser raw)]
(wrap [remaining output]))))
@@ -63,7 +63,7 @@
{#.doc "Checks that a token is in the inputs."}
(-> Text (CLI Any))
(function (_ inputs)
- (do error.Monad<Error>
+ (do error.monad
[[remaining raw] (any inputs)]
(if (text/= reference raw)
(wrap [remaining []])
@@ -84,7 +84,7 @@
(#error.Failure error)
(#.Cons to-omit immediate')
- (do error.Monad<Error>
+ (do error.monad
[[remaining output] (recur immediate')]
(wrap [(#.Cons to-omit remaining)
output])))))))
@@ -117,7 +117,7 @@
(def: program-args^
(Syntax Program-Args)
(p.or s.local-identifier
- (s.tuple (p.some (p.either (do p.Monad<Parser>
+ (s.tuple (p.some (p.either (do p.monad
[name s.local-identifier]
(wrap [(code.identifier ["" name]) (` any)]))
(s.record (p.and s.any s.any)))))))
@@ -128,7 +128,7 @@
{#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
"Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
(program: all-args
- (do Monad<IO>
+ (do io.monad
[foo init-program
bar (do-something all-args)]
(wrap [])))
@@ -137,7 +137,7 @@
(io (log! (text/compose "Hello, " name))))
(program: [{config config^}]
- (do Monad<IO>
+ (do io.monad
[data (init-program config)]
(do-something data))))}
(with-gensyms [g!program]
@@ -145,7 +145,7 @@
(#Raw args)
(wrap (list (` ("lux program"
(.function ((~ g!program) (~ (code.identifier ["" args])))
- ((~! do) (~! io.Monad<IO>)
+ ((~! do) (~! io.monad)
[]
(~ body)))))))
@@ -154,13 +154,13 @@
(wrap (list (` ("lux program"
(.function ((~ g!program) (~ g!args))
(case ((: (~! (..CLI (io.IO .Any)))
- ((~! do) (~! p.Monad<Parser>)
+ ((~! do) (~! p.monad)
[(~+ (|> args
(list/map (function (_ [binding parser])
(list binding parser)))
list/join))
(~ g!_) ..end]
- ((~' wrap) ((~! do) (~! io.Monad<IO>)
+ ((~' wrap) ((~! do) (~! io.monad)
[(~ g!output) (~ body)
(~+ (`` (for {(~~ (static host.jvm))
(list)}
diff --git a/stdlib/source/lux/control/apply.lux b/stdlib/source/lux/control/apply.lux
index 39ea39991..5eb42b63d 100644
--- a/stdlib/source/lux/control/apply.lux
+++ b/stdlib/source/lux/control/apply.lux
@@ -7,29 +7,30 @@
(signature: #export (Apply f)
{#.doc "Applicative functors."}
(: (Functor f)
- functor)
+ &functor)
(: (All [a b]
(-> (f (-> a b)) (f a) (f b)))
apply))
-(structure: #export (compose Monad<F> Apply<F> Apply<G>)
+(structure: #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 Apply<F>) (get@ #functor Apply<G>)))
+ (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' (:: Apply<F> apply
- (:: Monad<F> wrap (:: Apply<G> apply))
+ (let [fgf' (:: f-apply apply
+ (:: f-monad wrap (:: g-apply apply))
fgf)]
- (:: Apply<F> apply fgf' fgx))
- ## (let [applyF (:: Apply<F> apply)
- ## applyG (:: Apply<G> apply)]
+ (:: f-apply apply fgf' fgx))
+ ## (let [applyF (:: f-apply apply)
+ ## applyG (:: g-apply apply)]
## ($_ applyF
- ## (:: Monad<F> wrap applyG)
+ ## (:: f-monad wrap applyG)
## fgf
## fgx))
))
diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux
index d2641fe38..b51f76d97 100644
--- a/stdlib/source/lux/control/codec.lux
+++ b/stdlib/source/lux/control/codec.lux
@@ -14,16 +14,16 @@
decode))
## [Values]
-(structure: #export (compose Codec<c,b> Codec<b,a>)
+(structure: #export (compose cb-codec ba-codec)
{#.doc "Codec composition."}
(All [a b c]
(-> (Codec c b) (Codec b a)
(Codec c a)))
(def: encode
- (|>> (:: Codec<b,a> encode)
- (:: Codec<c,b> encode)))
+ (|>> (:: ba-codec encode)
+ (:: cb-codec encode)))
(def: (decode cy)
- (do error.Monad<Error>
- [by (:: Codec<c,b> decode cy)]
- (:: Codec<b,a> decode by))))
+ (do error.monad
+ [by (:: cb-codec decode cy)]
+ (:: ba-codec decode by))))
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index 2d96364ad..853c43615 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -2,7 +2,8 @@
[lux #*
[data
[collection
- ["." list ("list/." Fold<List>)]]]]
+ ["." list ("list/." Fold)]
+ ["." sequence]]]]
[//
["F" functor]])
@@ -30,7 +31,7 @@
(macro: #export (be tokens state)
{#.doc (doc "A co-monadic parallel to the 'do' macro."
(let [square (function (_ n) (i/* n n))]
- (be CoMonad<Stream>
+ (be sequence.comonad
[inputs (iterate inc +2)]
(square (head inputs)))))}
(case tokens
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux
index 80fa1b40e..1a628b88a 100644
--- a/stdlib/source/lux/control/concatenative.lux
+++ b/stdlib/source/lux/control/concatenative.lux
@@ -5,15 +5,15 @@
r/+ r/- r/* r// r/% r/= r/< r/<= r/> r/>=
f/+ f/- f/* f// f/% f/= f/< f/<= f/> f/>=)
[control
- ["p" parser ("parser/." Monad<Parser>)]
+ ["p" parser ("parser/." monad)]
["." monad]]
[data
["." text
format]
- ["." maybe ("maybe/." Monad<Maybe>)]
+ ["." maybe ("maybe/." monad)]
[collection
- ["." list ("list/." Fold<List> Functor<List>)]]]
- ["." macro (#+ with-gensyms Monad<Meta>)
+ ["." list ("list/." fold functor)]]]
+ ["." macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax:)]
[syntax
@@ -56,7 +56,7 @@
(def: (singleton expander)
(-> (Meta (List Code)) (Meta Code))
- (monad.do Monad<Meta>
+ (monad.do ..monad
[expansion expander]
(case expansion
(#.Cons singleton #.Nil)
diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux
index 9b20dcfde..3e288ca42 100644
--- a/stdlib/source/lux/control/concurrency/actor.lux
+++ b/stdlib/source/lux/control/concurrency/actor.lux
@@ -3,15 +3,15 @@
[control monad
["p" parser]
["ex" exception (#+ exception:)]]
- ["." io (#- run) ("io/." Monad<IO>)]
+ ["." io ("io/." monad)]
[data
["." product]
["e" error]
[text
format]
[collection
- ["." list ("list/." Monoid<List> Monad<List> Fold<List>)]]]
- ["." macro (#+ with-gensyms Monad<Meta>)
+ ["." list ("list/." monoid monad fold)]]]
+ ["." macro (#+ with-gensyms monad)
["." code]
["s" syntax (#+ syntax: Syntax)]
[syntax
@@ -23,7 +23,7 @@
abstract]]
[//
["." atom (#+ Atom atom)]
- ["." promise (#+ Promise Resolver) ("promise/." Monad<Promise>)]
+ ["." promise (#+ Promise Resolver) ("promise/." monad)]
["." task (#+ Task)]])
(exception: #export poisoned)
@@ -33,7 +33,6 @@
(ex.report ["Actor" actor-name]
["Message" message-name]))
-## [Types]
(with-expansions
[<Message> (as-is (-> s (Actor s) (Task s)))
<Obituary> (as-is [Text s (List <Message>)])
@@ -90,7 +89,7 @@
(promise.promise []))
process (loop [state init
[|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))]
- (do promise.Monad<Promise>
+ (do promise.monad
[[head tail] |mailbox|
?state' (handle head state self)]
(case ?state'
@@ -120,7 +119,7 @@
(All [s] (-> (Message s) (Actor s) (IO Bit)))
(if (alive? actor)
(let [entry [message (promise.promise [])]]
- (do Monad<IO>
+ (do io.monad
[|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))]
(loop [[|mailbox| resolve] |mailbox|&resolve]
(case (promise.poll |mailbox|)
@@ -139,7 +138,6 @@
)
)
-## [Values]
(def: (default-handle message state self)
(All [s] (-> (Message s) s (Actor s) (Task s)))
(message state self))
@@ -161,7 +159,6 @@
(task.throw poisoned []))
actor))
-## [Syntax]
(do-template [<with> <resolve> <tag> <desc>]
[(def: #export (<with> name)
(-> Name cs.Annotations cs.Annotations)
@@ -170,7 +167,7 @@
(def: #export (<resolve> name)
(-> Name (Meta Name))
- (do Monad<Meta>
+ (do io.monad
[[_ annotations _] (macro.find-def name)]
(case (macro.get-tag-ann (name-of <tag>) annotations)
(#.Some actor-name)
@@ -186,7 +183,7 @@
(def: actor-decl^
(Syntax [Text (List Text)])
(p.either (s.form (p.and s.local-identifier (p.some s.local-identifier)))
- (p.and s.local-identifier (:: p.Monad<Parser> wrap (list)))))
+ (p.and s.local-identifier (:: p.monad wrap (list)))))
(do-template [<name> <desc>]
[(def: #export <name>
@@ -227,7 +224,7 @@
Nat
((stop cause state)
- (:: promise.Monad<Promise> wrap
+ (:: promise.monad wrap
(log! (if (ex.match? ..poisoned cause)
(format "Counter was poisoned: " (%n state))
cause)))))
@@ -236,7 +233,7 @@
(List a)
((handle message state self)
- (do task.Monad<Task>
+ (do task.monad
[#let [_ (log! "BEFORE")]
output (message state self)
#let [_ (log! "AFTER")]]
@@ -268,7 +265,7 @@
(~ (code.local-identifier messageN))
(~ (code.local-identifier stateN))
(~ (code.local-identifier selfN)))
- (do task.Monad<Task>
+ (do task.monad
[]
(~ bodyC))))))
#..end (~ (case ?stop
@@ -279,7 +276,7 @@
(` (function ((~ g!_)
(~ (code.local-identifier causeN))
(~ (code.local-identifier stateN)))
- (do promise.Monad<Promise>
+ (do promise.monad
[]
(~ bodyC))))))}))
(` (def: (~+ (csw.export export)) ((~ g!new) (~ g!init))
@@ -309,7 +306,7 @@
(def: reference^
(s.Syntax [Name (List Text)])
(p.either (s.form (p.and s.identifier (p.some s.local-identifier)))
- (p.and s.identifier (:: p.Monad<Parser> wrap (list)))))
+ (p.and s.identifier (:: p.monad wrap (list)))))
(syntax: #export (message:
{export csr.export}
@@ -367,12 +364,12 @@
(let [[(~ g!task) (~ g!resolve)] (: [(task.Task (~ g!outputT))
(task.Resolver (~ g!outputT))]
(task.task []))]
- (io.run (do io.Monad<IO>
+ (io.run (do io.monad
[(~ g!sent?) (..send (function ((~ g!_) (~ g!state) (~ g!self))
- (do promise.Monad<Promise>
+ (do promise.monad
[(~ g!return) (: (Task [((~ g!type) (~+ g!actor-refs))
(~ g!outputT)])
- (do task.Monad<Task>
+ (do task.monad
[]
(~ body)))]
(case (~ g!return)
diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux
index b1692b6e3..61152d7b6 100644
--- a/stdlib/source/lux/control/concurrency/atom.lux
+++ b/stdlib/source/lux/control/concurrency/atom.lux
@@ -46,7 +46,7 @@
"The retries will be done with the new values of the atom, as they show up.")}
(All [a] (-> (-> a a) (Atom a) (IO a)))
(loop [_ []]
- (do io.Monad<IO>
+ (do io.monad
[old (read atom)
#let [new (f old)]
swapped? (compare-and-swap old new atom)]
diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux
index 18b385a65..84def78d1 100644
--- a/stdlib/source/lux/control/concurrency/frp.lux
+++ b/stdlib/source/lux/control/concurrency/frp.lux
@@ -8,14 +8,14 @@
[equivalence (#+ Equivalence)]]
["." io (#+ IO)]
[data
- [maybe ("maybe/." Functor<Maybe>)]
+ [maybe ("maybe/." functor)]
[collection
- [list ("list/." Monoid<List>)]]]
+ [list ("list/." monoid)]]]
[type (#+ :share)
abstract]]
[//
["." atom (#+ Atom)]
- ["." promise (#+ Promise) ("promise/." Functor<Promise>)]])
+ ["." promise (#+ Promise) ("promise/." functor)]])
(type: #export (Channel a)
{#.doc "An asynchronous channel to distribute values."}
@@ -35,7 +35,7 @@
(structure
(def: close
(loop [_ []]
- (do io.Monad<IO>
+ (do io.monad
[current (atom.read source)
stopped? (current #.None)]
(if stopped?
@@ -52,7 +52,7 @@
(def: (feed value)
(loop [_ []]
- (do io.Monad<IO>
+ (do io.monad
[current (atom.read source)
#let [[next resolve-next] (:share [a]
{(promise.Resolver (Maybe [a (Channel a)]))
@@ -82,7 +82,7 @@
(All [a] (-> (-> a (IO Any)) (Channel a) (IO Any)))
(io.io (exec (: (Promise Any)
(loop [channel channel]
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
(#.Some [head tail])
@@ -93,18 +93,18 @@
(wrap [])))))
[])))
-(structure: #export _ (Functor Channel)
+(structure: #export functor (Functor Channel)
(def: (map f)
(promise/map
(maybe/map
(function (_ [head tail])
[(f head) (map f tail)])))))
-(structure: #export _ (Apply Channel)
- (def: functor Functor<Channel>)
+(structure: #export apply (Apply Channel)
+ (def: &functor ..functor)
(def: (apply ff fa)
- (do promise.Monad<Promise>
+ (do promise.monad
[cons-f ff
cons-a fa]
(case [cons-f cons-a]
@@ -114,8 +114,8 @@
_
(wrap #.None)))))
-(structure: #export _ (Monad Channel)
- (def: functor Functor<Channel>)
+(structure: #export monad (Monad Channel)
+ (def: &functor ..functor)
(def: (wrap a)
(promise.resolved (#.Some [a (promise.resolved #.None)])))
@@ -128,7 +128,7 @@
(def: #export (filter pass? channel)
(All [a] (-> (Predicate a) (Channel a) (Channel a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
(#.Some [head tail])
@@ -151,7 +151,7 @@
(All [a b]
(-> (-> b a (Promise a)) a (Channel b)
(Promise a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
#.None
@@ -167,7 +167,7 @@
(All [a b]
(-> (-> b a (Promise a)) a (Channel b)
(Channel a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
#.None
@@ -182,7 +182,7 @@
(All [a] (-> Nat (IO a) (Channel a)))
(let [[output source] (channel [])]
(exec (io.run (loop [_ []]
- (do io.Monad<IO>
+ (do io.monad
[value action
_ (:: source feed value)]
(promise.await recur (promise.wait milli-seconds)))))
@@ -194,7 +194,7 @@
(def: #export (iterate f init)
(All [a] (-> (-> a (Promise (Maybe a))) a (Channel a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[?next (f init)]
(case ?next
(#.Some next)
@@ -205,7 +205,7 @@
(def: (distinct' equivalence previous channel)
(All [a] (-> (Equivalence a) a (Channel a) (Channel a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
(#.Some [head tail])
@@ -218,7 +218,7 @@
(def: #export (distinct equivalence channel)
(All [a] (-> (Equivalence a) (Channel a) (Channel a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
(#.Some [head tail])
@@ -230,7 +230,7 @@
(def: #export (consume channel)
{#.doc "Reads the entirety of a channel's content and returns it as a list."}
(All [a] (-> (Channel a) (Promise (List a))))
- (do promise.Monad<Promise>
+ (do promise.monad
[cons channel]
(case cons
(#.Some [head tail])
@@ -247,6 +247,6 @@
(promise.resolved #.None)
(#.Cons head tail)
- (promise.resolved (#.Some [head (do promise.Monad<Promise>
+ (promise.resolved (#.Some [head (do promise.monad
[_ (promise.wait milli-seconds)]
(sequential milli-seconds tail))]))))
diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux
index a67734747..d1d2ac245 100644
--- a/stdlib/source/lux/control/concurrency/process.lux
+++ b/stdlib/source/lux/control/concurrency/process.lux
@@ -87,7 +87,7 @@
(def: #export run!
(IO Any)
(loop [_ []]
- (do io.Monad<IO>
+ (do io.monad
[processes (atom.read runner)]
(case processes
## And... we're done!
diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux
index 33a04190b..244951139 100644
--- a/stdlib/source/lux/control/concurrency/promise.lux
+++ b/stdlib/source/lux/control/concurrency/promise.lux
@@ -25,7 +25,7 @@
{#.doc "Sets an promise's value if it has not been done yet."}
(All [a] (-> (Promise a) (Resolver a)))
(function (resolve value)
- (do io.Monad<IO>
+ (do io.monad
[(^@ old [_value _observers]) (atom.read promise)]
(case _value
(#.Some _)
@@ -82,14 +82,14 @@
(#.Some _)
#1))
-(structure: #export _ (Functor Promise)
+(structure: #export functor (Functor Promise)
(def: (map f fa)
(let [[fb resolve] (..promise [])]
(exec (io.run (await (|>> f resolve) fa))
fb))))
-(structure: #export _ (Apply Promise)
- (def: functor Functor<Promise>)
+(structure: #export apply (Apply Promise)
+ (def: &functor ..functor)
(def: (apply ff fa)
(let [[fb resolve] (..promise [])]
@@ -98,8 +98,8 @@
ff))
fb))))
-(structure: #export _ (Monad Promise)
- (def: functor Functor<Promise>)
+(structure: #export monad (Monad Promise)
+ (def: &functor ..functor)
(def: wrap ..resolved)
@@ -113,7 +113,7 @@
(def: #export (and left right)
{#.doc "Sequencing combinator."}
(All [a b] (-> (Promise a) (Promise b) (Promise [a b])))
- (do Monad<Promise>
+ (do ..monad
[a left
b right]
(wrap [a b])))
@@ -148,7 +148,7 @@
"Returns a Promise that will eventually host its result.")}
(All [a] (-> Nat (IO a) (Promise a)))
(let [[!out resolve] (..promise [])]
- (exec (|> (do io.Monad<IO>
+ (exec (|> (do io.monad
[value computation]
(resolve value))
(process.schedule millis-delay)
diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux
index 46762ecf3..ddc73b300 100644
--- a/stdlib/source/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/lux/control/concurrency/semaphore.lux
@@ -29,7 +29,7 @@
(io.run
(loop [signal (: (Promise Any)
(promise.promise #.None))]
- (do io.Monad<IO>
+ (do io.monad
[state (atom.read semaphore)
#let [[ready? state'] (: [Bit State]
(case (get@ #open-positions state)
@@ -50,7 +50,7 @@
(let [semaphore (:representation semaphore)]
(promise.future
(loop [_ []]
- (do io.Monad<IO>
+ (do io.monad
[state (atom.read semaphore)
#let [[?signal state'] (: [(Maybe (Promise Any)) State]
(case (get@ #waiting-list state)
@@ -91,7 +91,7 @@
(def: #export (synchronize mutex procedure)
(All [a] (-> Mutex (IO (Promise a)) (Promise a)))
- (do promise.Monad<Promise>
+ (do promise.monad
[_ (acquire mutex)
output (io.run procedure)
_ (release mutex)]
@@ -120,15 +120,15 @@
(-> Nat Semaphore (Promise Any))
(loop [step 0]
(if (n/< times step)
- (do promise.Monad<Promise>
+ (do promise.monad
[_ (signal turnstile)]
(recur (inc step)))
- (:: promise.Monad<Promise> wrap []))))
+ (:: promise.monad wrap []))))
(do-template [<phase> <update> <goal> <turnstile>]
[(def: (<phase> (^:representation barrier))
(-> Barrier (Promise Any))
- (do promise.Monad<Promise>
+ (do promise.monad
[#let [limit (refinement.un-refine (get@ #limit barrier))
goal <goal>
count (io.run (atom.update <update> (get@ #count barrier)))]
@@ -143,7 +143,7 @@
(def: #export (block barrier)
(-> Barrier (Promise Any))
- (do promise.Monad<Promise>
+ (do promise.monad
[_ (start barrier)]
(end barrier)))
)
diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux
index 34122abd4..5bb537025 100644
--- a/stdlib/source/lux/control/concurrency/stm.lux
+++ b/stdlib/source/lux/control/concurrency/stm.lux
@@ -15,7 +15,7 @@
[//
["." atom (#+ Atom atom)]
["." promise (#+ Promise Resolver)]
- ["." frp ("frp/." Functor<Channel>)]])
+ ["." frp ("frp/." functor)]])
(type: #export (Observer a)
(-> a (IO Any)))
@@ -39,11 +39,11 @@
(All [a] (-> (Var a) (IO a)))
(|> var
atom.read
- (:: io.Functor<IO> map product.left)))
+ (:: io.functor map product.left)))
(def: (write! new-value (^:representation var))
(All [a] (-> a (Var a) (IO Any)))
- (do io.Monad<IO>
+ (do io.monad
[(^@ old [_value _observers]) (atom.read var)
succeeded? (atom.compare-and-swap old [new-value _observers] var)]
(if succeeded?
@@ -55,7 +55,7 @@
(def: #export (follow target)
{#.doc "Creates a channel that will receive all changes to the value of the given var."}
(All [a] (-> (Var a) (IO (frp.Channel a))))
- (do io.Monad<IO>
+ (do io.monad
[#let [[channel source] (frp.channel [])
target (:representation target)]
_ (atom.update (function (_ [value observers])
@@ -82,8 +82,8 @@
(list.find (function (_ [_var _original _current])
(is? (:coerce (Var Any) var)
(:coerce (Var Any) _var))))
- (:: maybe.Monad<Maybe> map (function (_ [_var _original _current])
- _current))
+ (:: maybe.monad map (function (_ [_var _original _current])
+ _current))
(:assume)
))
@@ -137,8 +137,8 @@
(let [[tx' a] (fa tx)]
[tx' (f a)]))))
-(structure: #export _ (Apply STM)
- (def: functor Functor<STM>)
+(structure: #export apply (Apply STM)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ tx)
@@ -146,8 +146,8 @@
[tx'' a] (fa tx')]
[tx'' (f a)]))))
-(structure: #export _ (Monad STM)
- (def: functor Functor<STM>)
+(structure: #export monad (Monad STM)
+ (def: &functor ..functor)
(def: (wrap a)
(function (_ tx) [tx a]))
@@ -160,7 +160,7 @@
(def: #export (update f var)
{#.doc "Will update a Var's value, and return a tuple with the old and the new values."}
(All [a] (-> (-> a a) (Var a) (STM [a a])))
- (do Monad<STM>
+ (do ..monad
[a (read var)
#let [a' (f a)]
_ (write a' var)]
@@ -198,12 +198,12 @@
(def: (issue-commit commit)
(All [a] (-> (Commit a) (IO Any)))
(let [entry [commit (promise.promise [])]]
- (do io.Monad<IO>
+ (do io.monad
[|commits|&resolve (atom.read pending-commits)]
(loop [[|commits| resolve] |commits|&resolve]
(case (promise.poll |commits|)
#.None
- (do io.Monad<IO>
+ (do io.monad
[resolved? (resolve entry)]
(if resolved?
(atom.write (product.right entry) pending-commits)
@@ -217,14 +217,14 @@
(let [[stm-proc output resolve] commit
[finished-tx value] (stm-proc fresh-tx)]
(if (can-commit? finished-tx)
- (do io.Monad<IO>
+ (do io.monad
[_ (monad.map @ commit-var! finished-tx)]
(resolve value))
(issue-commit commit))))
(def: init-processor!
(IO Any)
- (do io.Monad<IO>
+ (do io.monad
[flag (atom.read commit-processor-flag)]
(if flag
(wrap [])
@@ -247,7 +247,7 @@
"For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")}
(All [a] (-> (STM a) (Promise a)))
(let [[output resolver] (promise.promise [])]
- (exec (io.run (do io.Monad<IO>
+ (exec (io.run (do io.monad
[_ init-processor!]
(issue-commit [stm-proc output resolver])))
output)))
diff --git a/stdlib/source/lux/control/concurrency/task.lux b/stdlib/source/lux/control/concurrency/task.lux
index a5bf17819..1f16da8ca 100644
--- a/stdlib/source/lux/control/concurrency/task.lux
+++ b/stdlib/source/lux/control/concurrency/task.lux
@@ -29,16 +29,15 @@
(def: #export (throw exception message)
(All [e a] (-> (Exception e) e (Task a)))
- (:: promise.Monad<Promise> wrap
- (ex.throw exception message)))
+ (:: promise.monad wrap (ex.throw exception message)))
(def: #export (try computation)
(All [a] (-> (Task a) (Task (Error a))))
- (:: promise.Functor<Promise> map (|>> #error.Success) computation))
+ (:: promise.functor map (|>> #error.Success) computation))
-(structure: #export _ (Functor Task)
+(structure: #export functor (Functor Task)
(def: (map f fa)
- (:: promise.Functor<Promise> map
+ (:: promise.functor map
(function (_ fa')
(case fa'
(#error.Failure error)
@@ -48,25 +47,25 @@
(#error.Success (f a))))
fa)))
-(structure: #export _ (Apply Task)
- (def: functor Functor<Task>)
+(structure: #export apply (Apply Task)
+ (def: &functor ..functor)
(def: (apply ff fa)
- (do promise.Monad<Promise>
+ (do promise.monad
[ff' ff
fa' fa]
- (wrap (do error.Monad<Error>
+ (wrap (do error.monad
[f ff'
a fa']
(wrap (f a)))))))
-(structure: #export _ (Monad Task)
- (def: functor Functor<Task>)
+(structure: #export monad (Monad Task)
+ (def: &functor ..functor)
(def: wrap return)
(def: (join mma)
- (do promise.Monad<Promise>
+ (do promise.monad
[mma' mma]
(case mma'
(#error.Failure error)
@@ -81,4 +80,4 @@
(def: #export (from-promise promise)
(All [a] (-> (Promise a) (Task a)))
- (:: promise.Functor<Promise> map (|>> #error.Success) promise))
+ (:: promise.functor map (|>> #error.Success) promise))
diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux
index beaab50fb..66233773a 100644
--- a/stdlib/source/lux/control/continuation.lux
+++ b/stdlib/source/lux/control/continuation.lux
@@ -23,12 +23,12 @@
(All [a] (-> (Cont a a) a))
(cont id))
-(structure: #export Functor<Cont> (All [o] (Functor (All [i] (Cont i o))))
+(structure: #export functor (All [o] (Functor (All [i] (Cont i o))))
(def: (map f fv)
(function (_ k) (fv (compose k f)))))
-(structure: #export Apply<Cont> (All [o] (Apply (All [i] (Cont i o))))
- (def: functor Functor<Cont>)
+(structure: #export apply (All [o] (Apply (All [i] (Cont i o))))
+ (def: &functor ..functor)
(def: (apply ff fv)
(function (_ k)
@@ -36,8 +36,8 @@
(function (_ v)) fv
(function (_ f)) ff))))
-(structure: #export Monad<Cont> (All [o] (Monad (All [i] (Cont i o))))
- (def: functor Functor<Cont>)
+(structure: #export monad (All [o] (Monad (All [i] (Cont i o))))
+ (def: &functor ..functor)
(def: (wrap value)
(function (_ k) (k value)))
@@ -69,7 +69,7 @@
i]
z)))
(call/cc (function (_ k)
- (do Monad<Cont>
+ (do ..monad
[#let [nexus (function (nexus val)
(k [nexus val]))]
_ (k [nexus init])]
diff --git a/stdlib/source/lux/control/enum.lux b/stdlib/source/lux/control/enum.lux
index b5b69faf1..9f2845b01 100644
--- a/stdlib/source/lux/control/enum.lux
+++ b/stdlib/source/lux/control/enum.lux
@@ -3,14 +3,12 @@
[control
["." order]]])
-## [Signatures]
(signature: #export (Enum e)
{#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."}
- (: (order.Order e) order)
+ (: (order.Order e) &order)
(: (-> e e) succ)
(: (-> e e) pred))
-## [Functions]
(def: (range' <= succ from to)
(All [a] (-> (-> a a Bit) (-> a a) a a (List a)))
(if (<= to from)
diff --git a/stdlib/source/lux/control/equivalence.lux b/stdlib/source/lux/control/equivalence.lux
index 1b1cc45d3..57db7a925 100644
--- a/stdlib/source/lux/control/equivalence.lux
+++ b/stdlib/source/lux/control/equivalence.lux
@@ -35,8 +35,8 @@
(def: (= left right)
(sub (rec sub) left right))))
-(structure: #export _ (Contravariant Equivalence)
- (def: (map-1 f Equivalence<b>)
+(structure: #export contravariant (Contravariant Equivalence)
+ (def: (map-1 f equivalence)
(structure
(def: (= reference sample)
- (:: Equivalence<b> = (f reference) (f sample))))))
+ (:: equivalence = (f reference) (f sample))))))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index c5fa9632c..bac945de2 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -7,9 +7,9 @@
["//" error (#+ Error)]
["." maybe]
["." product]
- ["." text ("text/." Monoid<Text>)]
+ ["." text ("text/." monoid)]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]]]
+ ["." list ("list/." functor fold)]]]
["." macro
["." code]
["s" syntax (#+ syntax: Syntax)]
diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux
index 415d57c93..1ade0a45b 100644
--- a/stdlib/source/lux/control/functor.lux
+++ b/stdlib/source/lux/control/functor.lux
@@ -9,21 +9,21 @@
(type: #export (Fix f)
(f (Fix f)))
-(type: #export (<&> f g)
+(type: #export (And f g)
(All [a] (& (f a) (g a))))
-(type: #export (<|> f g)
+(type: #export (Or f g)
(All [a] (| (f a) (g a))))
-(type: #export (<$> f g)
+(type: #export (Then f g)
(All [a] (f (g a))))
-(structure: #export (compose Functor<F> Functor<G>)
+(def: #export (compose f-functor g-functor)
{#.doc "Functor composition."}
- (All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a))))))
-
- (def: (map f fga)
- (:: Functor<F> map (:: Functor<G> map f) fga)))
+ (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G))))
+ (structure
+ (def: (map f fga)
+ (:: f-functor map (:: g-functor map f) fga))))
(signature: #export (Contravariant f)
(: (All [a b]
diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux
index 4e50c3658..d2dee3bcb 100644
--- a/stdlib/source/lux/control/hash.lux
+++ b/stdlib/source/lux/control/hash.lux
@@ -1,12 +1,13 @@
(.module:
lux
- [// [equivalence (#+ Equivalence)]])
+ [//
+ [equivalence (#+ Equivalence)]])
## [Signatures]
(signature: #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)
- eq)
+ &equivalence)
(: (-> a Nat)
hash))
diff --git a/stdlib/source/lux/control/identity.lux b/stdlib/source/lux/control/identity.lux
index 094ede9a6..ff79bedca 100644
--- a/stdlib/source/lux/control/identity.lux
+++ b/stdlib/source/lux/control/identity.lux
@@ -12,7 +12,7 @@
code
- (structure: #export (Equivalence<ID> Equivalence<code>)
+ (structure: #export (equivalence Equivalence<code>)
(All [code entity storage]
(-> (Equivalence code)
(Equivalence (ID code entity storage))))
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux
index 5e94aea90..940b85a21 100644
--- a/stdlib/source/lux/control/interval.lux
+++ b/stdlib/source/lux/control/interval.lux
@@ -9,7 +9,7 @@
(signature: #export (Interval a)
{#.doc "A representation of top and bottom boundaries for an ordered type."}
(: (Enum a)
- enum)
+ &enum)
(: a
bottom)
@@ -17,15 +17,15 @@
(: a
top))
-(def: #export (between Enum<a> bottom top)
+(def: #export (between enum bottom top)
(All [a] (-> (Enum a) a a (Interval a)))
- (structure (def: enum Enum<a>)
+ (structure (def: &enum enum)
(def: bottom bottom)
(def: top top)))
-(def: #export (singleton Enum<a> elem)
+(def: #export (singleton enum elem)
(All [a] (-> (Enum a) a (Interval a)))
- (structure (def: enum Enum<a>)
+ (structure (def: &enum enum)
(def: bottom elem)
(def: top elem)))
@@ -72,20 +72,20 @@
(def: #export (union left right)
(All [a] (-> (Interval a) (Interval a) (Interval a)))
- (structure (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)))))
+ (structure (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)))
- (structure (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)))))
+ (structure (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]
- (structure (def: enum (get@ #enum interval))
+ (structure (def: &enum (get@ #&enum interval))
(def: bottom (succ top))
(def: top (pred bottom)))))
@@ -134,7 +134,7 @@
[after? >]
)
-(structure: #export Equivalence<Interval> (All [a] (Equivalence (Interval a)))
+(structure: #export equivalence (All [a] (Equivalence (Interval a)))
(def: (= reference sample)
(let [(^open ".") reference]
(and (= bottom (:: sample bottom))
@@ -164,7 +164,7 @@
(def: #export (overlaps? reference sample)
(All [a] (-> (Interval a) (Interval a) Bit))
(let [(^open ".") reference]
- (and (not (:: Equivalence<Interval> = reference sample))
+ (and (not (:: ..equivalence = reference sample))
(cond (singleton? sample)
#0
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 6e0992444..67f1fb047 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -3,7 +3,6 @@
[//
["." functor (#+ Functor)]])
-## [Utils]
(def: (list/fold f init xs)
(All [a b]
(-> (-> b a a) a (List b) a))
@@ -41,10 +40,9 @@
_
#.Nil))
-## [Signatures]
(signature: #export (Monad m)
(: (Functor m)
- functor)
+ &functor)
(: (All [a]
(-> a (m a)))
wrap)
@@ -52,12 +50,11 @@
(-> (m (m a)) (m a)))
join))
-## [Syntax]
(def: _cursor Cursor ["" 0 0])
(macro: #export (do tokens state)
{#.doc (doc "Macro for easy concatenation of monadic operations."
- (do Monad<Maybe>
+ (do monad
[y (f1 x)
z (f2 z)]
(wrap (f3 z))))}
@@ -80,7 +77,7 @@
body
(reverse (as-pairs bindings)))]
(#.Right [state (#.Cons (` ({(~' @)
- ({{#..functor {#functor.map (~ g!map)}
+ ({{#..&functor {#functor.map (~ g!map)}
#..wrap (~' wrap)
#..join (~ g!join)}
(~ body')}
@@ -92,7 +89,6 @@
_
(#.Left "Wrong syntax for 'do'")))
-## [Functions]
(def: #export (seq monad)
{#.doc "Run all the monadic values in the list and produce a list of the base values."}
(All [M a]
@@ -162,11 +158,11 @@
[init' (f x init)]
(fold monad f init' xs'))))
-(def: #export (lift Monad<M> f)
+(def: #export (lift monad f)
{#.doc "Lift a normal function into the space of monads."}
(All [M a b]
(-> (Monad M) (-> a b) (-> (M a) (M b))))
(function (_ ma)
- (do Monad<M>
+ (do monad
[a ma]
(wrap (f a)))))
diff --git a/stdlib/source/lux/control/monad/free.lux b/stdlib/source/lux/control/monad/free.lux
index b30de7b1f..214261450 100644
--- a/stdlib/source/lux/control/monad/free.lux
+++ b/stdlib/source/lux/control/monad/free.lux
@@ -10,7 +10,7 @@
(#Pure a)
(#Effect (F (Free F a))))
-(structure: #export (Functor<Free> dsl)
+(structure: #export (functor dsl)
(All [F] (-> (Functor F) (Functor (Free F))))
(def: (map f ea)
@@ -21,10 +21,10 @@
(#Effect value)
(#Effect (:: dsl map (map f) value)))))
-(structure: #export (Apply<Free> dsl)
+(structure: #export (apply dsl)
(All [F] (-> (Functor F) (Apply (Free F))))
- (def: functor (Functor<Free> dsl))
+ (def: &functor (..functor dsl))
(def: (apply ef ea)
(case [ef ea]
@@ -33,7 +33,7 @@
[(#Pure f) (#Effect fa)]
(#Effect (:: dsl map
- (:: (Functor<Free> dsl) map f)
+ (:: (..functor dsl) map f)
fa))
[(#Effect ff) _]
@@ -42,10 +42,10 @@
ff))
)))
-(structure: #export (Monad<Free> dsl)
+(structure: #export (monad dsl)
(All [F] (-> (Functor F) (Monad (Free F))))
- (def: functor (Functor<Free> dsl))
+ (def: &functor (..functor dsl))
(def: (wrap a)
(#Pure a))
@@ -62,6 +62,6 @@
(#Effect fefa)
(#Effect (:: dsl map
- (:: (Monad<Free> dsl) join)
+ (:: (monad dsl) join)
fefa))
)))
diff --git a/stdlib/source/lux/control/monad/indexed.lux b/stdlib/source/lux/control/monad/indexed.lux
index ef2acb904..bd18ab72c 100644
--- a/stdlib/source/lux/control/monad/indexed.lux
+++ b/stdlib/source/lux/control/monad/indexed.lux
@@ -5,7 +5,7 @@
["p" parser]]
[data
[collection
- ["." list ("list/." Functor<List> Fold<List>)]]]
+ ["." list ("list/." functor fold)]]]
["." macro
["s" syntax (#+ Syntax syntax:)]]])
diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux
index 4375f4e7c..a56f512cb 100644
--- a/stdlib/source/lux/control/order.lux
+++ b/stdlib/source/lux/control/order.lux
@@ -6,12 +6,11 @@
[//
["." equivalence (#+ Equivalence)]])
-## [Signatures]
(`` (signature: #export (Order a)
{#.doc "A signature for types that possess some sense of ordering among their elements."}
(: (Equivalence a)
- eq)
+ &equivalence)
(~~ (do-template [<name>]
[(: (-> a a Bit) <name>)]
@@ -20,20 +19,23 @@
))
))
-## [Values]
-(def: #export (order eq <)
+(def: #export (order equivalence <)
(All [a]
(-> (Equivalence a) (-> a a Bit) (Order a)))
(let [> (flip <)]
- (structure (def: eq eq)
+ (structure (def: &equivalence equivalence)
+
(def: < <)
+
(def: (<= test subject)
(or (< test subject)
- (:: eq = test subject)))
+ (:: equivalence = test subject)))
+
(def: > >)
+
(def: (>= test subject)
(or (> test subject)
- (:: eq = test subject))))))
+ (:: equivalence = test subject))))))
(do-template [<name> <op>]
[(def: #export (<name> order x y)
@@ -45,14 +47,14 @@
[max >]
)
-(`` (structure: #export _ (Contravariant Order)
- (def: (map-1 f Order<b>)
+(`` (structure: #export contravariant (Contravariant Order)
+ (def: (map-1 f order)
(structure
- (def: eq (:: equivalence.Contravariant<Equivalence> map-1 f (:: Order<b> eq)))
+ (def: &equivalence (:: equivalence.contravariant map-1 f (:: order &equivalence)))
(~~ (do-template [<name>]
[(def: (<name> reference sample)
- (:: Order<b> <name> (f reference) (f sample)))]
+ (:: order <name> (f reference) (f sample)))]
[<] [<=] [>] [>=]
))))))
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
index 4b4ef0d34..4ea39a006 100644
--- a/stdlib/source/lux/control/parser.lux
+++ b/stdlib/source/lux/control/parser.lux
@@ -3,11 +3,11 @@
[control
[functor (#+ Functor)]
[apply (#+ Apply)]
- [monad (#+ do Monad)]
+ [monad (#+ Monad do)]
[codec (#+ Codec)]]
[data
[collection
- ["." list ("list/." Functor<List> Monoid<List>)]]
+ ["." list ("list/." functor monoid)]]
["." product]
["." error (#+ Error)]]])
@@ -15,8 +15,7 @@
{#.doc "A generic parser."}
(-> s (Error [s a])))
-## [Structures]
-(structure: #export Functor<Parser> (All [s] (Functor (Parser s)))
+(structure: #export functor (All [s] (Functor (Parser s)))
(def: (map f ma)
(function (_ input)
(case (ma input)
@@ -26,8 +25,8 @@
(#error.Success [input' a])
(#error.Success [input' (f a)])))))
-(structure: #export Apply<Parser> (All [s] (Apply (Parser s)))
- (def: functor Functor<Parser>)
+(structure: #export apply (All [s] (Apply (Parser s)))
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ input)
@@ -43,8 +42,8 @@
(#error.Failure msg)
(#error.Failure msg)))))
-(structure: #export Monad<Parser> (All [s] (Monad (Parser s)))
- (def: functor Functor<Parser>)
+(structure: #export monad (All [s] (Monad (Parser s)))
+ (def: &functor ..functor)
(def: (wrap x)
(function (_ input)
@@ -59,7 +58,6 @@
(#error.Success [input' ma])
(ma input')))))
-## [Parsers]
(def: #export (assert message test)
{#.doc "Fails with the given message if the test is #0."}
(All [s] (-> Text Bit (Parser s Any)))
@@ -96,7 +94,7 @@
(#error.Success [input' x])
(run input'
- (do Monad<Parser>
+ (do ..monad
[xs (some p)]
(wrap (list& x xs)))
))))
@@ -105,7 +103,7 @@
{#.doc "1-or-more combinator."}
(All [s a]
(-> (Parser s a) (Parser s (List a))))
- (do Monad<Parser>
+ (do ..monad
[x p
xs (some p)]
(wrap (list& x xs))))
@@ -114,7 +112,7 @@
{#.doc "Sequencing combinator."}
(All [s a b]
(-> (Parser s a) (Parser s b) (Parser s [a b])))
- (do Monad<Parser>
+ (do ..monad
[x1 p1
x2 p2]
(wrap [x1 x2])))
@@ -130,7 +128,7 @@
(#error.Failure _)
(run tokens
- (do Monad<Parser>
+ (do ..monad
[x2 p2]
(wrap (1 x2))))
)))
@@ -152,16 +150,16 @@
{#.doc "Parse exactly N times."}
(All [s a] (-> Nat (Parser s a) (Parser s (List a))))
(if (n/> 0 n)
- (do Monad<Parser>
+ (do ..monad
[x p
xs (exactly (dec n) p)]
(wrap (#.Cons x xs)))
- (:: Monad<Parser> wrap (list))))
+ (:: ..monad wrap (list))))
(def: #export (at-least n p)
{#.doc "Parse at least N times."}
(All [s a] (-> Nat (Parser s a) (Parser s (List a))))
- (do Monad<Parser>
+ (do ..monad
[min (exactly n p)
extra (some p)]
(wrap (list/compose min extra))))
@@ -177,24 +175,24 @@
(#error.Success [input' x])
(run input'
- (do Monad<Parser>
+ (do ..monad
[xs (at-most (dec n) p)]
(wrap (#.Cons x xs))))
))
- (:: Monad<Parser> wrap (list))))
+ (:: ..monad wrap (list))))
(def: #export (between from to p)
{#.doc "Parse between N and M times."}
(All [s a] (-> Nat Nat (Parser s a) (Parser s (List a))))
- (do Monad<Parser>
+ (do ..monad
[min-xs (exactly from p)
max-xs (at-most (n/- from to) p)]
- (wrap (:: list.Monad<List> join (list min-xs max-xs)))))
+ (wrap (:: list.monad join (list min-xs max-xs)))))
(def: #export (sep-by sep p)
{#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."}
(All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a))))
- (do Monad<Parser>
+ (do ..monad
[?x (maybe p)]
(case ?x
#.None
@@ -255,20 +253,20 @@
(def: #export (after param subject)
(All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a)))
- (do Monad<Parser>
+ (do ..monad
[_ param]
subject))
(def: #export (before param subject)
(All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a)))
- (do Monad<Parser>
+ (do ..monad
[output subject
_ param]
(wrap output)))
(def: #export (filter test parser)
(All [s a] (-> (-> a Bit) (Parser s a) (Parser s a)))
- (do Monad<Parser>
+ (do ..monad
[output parser
_ (assert "Constraint failed." (test output))]
(wrap output)))
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index a5f9eca95..ec1e787e2 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -6,7 +6,7 @@
[data
["e" error]
[collection
- ["." list ("list/." Fold<List> Monad<List>)]]]
+ ["." list ("list/." fold monad)]]]
[macro (#+ with-gensyms)
["s" syntax (#+ syntax: Syntax)]
["." code]]])
@@ -54,7 +54,7 @@
[(new> -1)])))}
(with-gensyms [g!temp]
(wrap (list (` (let [(~ g!temp) (~ prev)]
- (cond (~+ (do list.Monad<List>
+ (cond (~+ (do list.monad
[[test then] branches]
(list (` (|> (~ g!temp) (~+ test)))
(` (|> (~ g!temp) (~+ then))))))
@@ -90,14 +90,14 @@
{#.doc (doc "Monadic pipes."
"Each steps in the monadic computation is a pipe and must be given inside a tuple."
(|> +5
- (do> Monad<Identity>
+ (do> monad
[(i/* +3)]
[(i/+ +4)]
[inc])))}
(with-gensyms [g!temp]
(case (list.reverse steps)
(^ (list& last-step prev-steps))
- (let [step-bindings (do list.Monad<List>
+ (let [step-bindings (do list.monad
[step (list.reverse prev-steps)]
(list g!temp (` (|> (~ g!temp) (~+ step)))))]
(wrap (list (` ((~! do) (~ monad)
diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux
index 1d19b5594..d8ce527cc 100644
--- a/stdlib/source/lux/control/reader.lux
+++ b/stdlib/source/lux/control/reader.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
[control
- ["F" functor]
- ["A" apply]
+ [functor (#+ Functor)]
+ [apply (#+ Apply)]
["." monad (#+ do Monad)]]])
## [Types]
@@ -11,26 +11,26 @@
(-> r a))
## [Structures]
-(structure: #export Functor<Reader>
- (All [r] (F.Functor (Reader r)))
+(structure: #export functor
+ (All [r] (Functor (Reader r)))
(def: (map f fa)
(function (_ env)
(f (fa env)))))
-(structure: #export Apply<Reader>
- (All [r] (A.Apply (Reader r)))
+(structure: #export apply
+ (All [r] (Apply (Reader r)))
- (def: functor Functor<Reader>)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ env)
((ff env) (fa env)))))
-(structure: #export Monad<Reader>
+(structure: #export monad
(All [r] (Monad (Reader r)))
- (def: functor Functor<Reader>)
+ (def: &functor ..functor)
(def: (wrap x)
(function (_ env) x))
@@ -54,21 +54,21 @@
(All [r a] (-> r (Reader r a) a))
(proc env))
-(structure: #export (ReaderT Monad<M>)
+(structure: #export (ReaderT monad)
{#.doc "Monad transformer for Reader."}
(All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a)))))))
- (def: functor (F.compose Functor<Reader> (get@ #monad.functor Monad<M>)))
+ (def: &functor (F.compose ..functor (get@ #monad.&functor monad)))
- (def: wrap (|>> (:: Monad<M> wrap) (:: Monad<Reader> wrap)))
+ (def: wrap (|>> (:: monad wrap) (:: ..monad wrap)))
(def: (join eMeMa)
(function (_ env)
- (do Monad<M>
+ (do monad
[eMa (run env eMeMa)]
(run env eMa)))))
(def: #export lift
{#.doc "Lift monadic values to the Reader wrapper."}
(All [M e a] (-> (M a) (Reader e (M a))))
- (:: Monad<Reader> wrap))
+ (:: ..monad wrap))
diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux
index e014777dd..126344514 100644
--- a/stdlib/source/lux/control/region.lux
+++ b/stdlib/source/lux/control/region.lux
@@ -10,7 +10,7 @@
["." text
format]
[collection
- [list ("list/." Fold<List>)]]]])
+ [list ("list/." fold)]]]])
(type: (Cleaner r m)
(-> r (m (Error Any))))
@@ -66,7 +66,7 @@
cleaners)
(#error.Success value)])))
-(structure: #export (Functor<Region> Functor<m>)
+(structure: #export (functor Functor<m>)
(All [m]
(-> (Functor m)
(All [r] (Functor (Region r m)))))
@@ -84,13 +84,13 @@
(#error.Failure error))])
(fa region+cleaners))))))
-(structure: #export (Apply<Region> Monad<m>)
+(structure: #export (apply Monad<m>)
(All [m]
(-> (Monad m)
(All [r] (Apply (Region r m)))))
- (def: functor
- (Functor<Region> (get@ #monad.functor Monad<m>)))
+ (def: &functor
+ (..functor (get@ #monad.functor Monad<m>)))
(def: (apply ff fa)
(function (_ [region cleaners])
@@ -105,13 +105,13 @@
[_ (#error.Failure error)])
(wrap [cleaners (#error.Failure error)]))))))
-(structure: #export (Monad<Region> Monad<m>)
+(structure: #export (monad Monad<m>)
(All [m]
(-> (Monad m)
(All [r] (Monad (Region r m)))))
- (def: functor
- (Functor<Region> (get@ #monad.functor Monad<m>)))
+ (def: &functor
+ (..functor (get@ #monad.&functor Monad<m>)))
(def: (wrap value)
(function (_ [region cleaners])
diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux
index a355a705b..8085ad176 100644
--- a/stdlib/source/lux/control/remember.lux
+++ b/stdlib/source/lux/control/remember.lux
@@ -2,7 +2,7 @@
[lux #*
[control
[monad (#+ do)]
- ["p" parser ("p/." Functor<Parser>)]
+ ["p" parser ("p/." functor)]
["ex" exception (#+ exception:)]]
[data
["." error]
@@ -10,7 +10,7 @@
format]]
[time
["." instant]
- ["." date (#+ Date) ("date/." Order<Date> Codec<Text,Date>)]]
+ ["." date (#+ Date) ("date/." order codec)]]
["." macro
["." code]
["s" syntax (#+ Syntax syntax:)]]
@@ -30,9 +30,9 @@
($_ p.either
(p/map (|>> instant.from-millis instant.date)
s.int)
- (do p.Monad<Parser>
+ (do p.monad
[raw s.text]
- (case (:: date.Codec<Text,Date> decode raw)
+ (case (:: date.codec decode raw)
(#error.Success date)
(wrap date)
@@ -54,13 +54,13 @@
(do-template [<name> <message>]
[(syntax: #export (<name> {deadline ..deadline} {message s.text} {focus (p.maybe s.any)})
(wrap (list (` (..remember (~ (code.text (date/encode deadline)))
- (~ (code.text (format <message> " " message)))
- (~+ (case focus
- (#.Some focus)
- (list focus)
+ (~ (code.text (format <message> " " message)))
+ (~+ (case focus
+ (#.Some focus)
+ (list focus)
- #.None
- (list))))))))]
+ #.None
+ (list))))))))]
[to-do "TODO"]
[fix-me "FIXME"]
diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux
index 847dbf714..f757ced19 100644
--- a/stdlib/source/lux/control/security/capability.lux
+++ b/stdlib/source/lux/control/security/capability.lux
@@ -7,7 +7,7 @@
[text
format]
[collection
- [list ("list/." Functor<List>)]]]
+ [list ("list/." functor)]]]
[type
abstract]
["." macro
diff --git a/stdlib/source/lux/control/security/integrity.lux b/stdlib/source/lux/control/security/integrity.lux
index b78351b38..81dee0c16 100644
--- a/stdlib/source/lux/control/security/integrity.lux
+++ b/stdlib/source/lux/control/security/integrity.lux
@@ -32,18 +32,18 @@
(All [a] (-> (Dirty a) a))
(|>> :representation))
- (structure: #export _ (Functor Dirty)
+ (structure: #export functor (Functor Dirty)
(def: (map f fa)
(|> fa :representation f :abstraction)))
- (structure: #export _ (Apply Dirty)
- (def: functor Functor<Dirty>)
+ (structure: #export apply (Apply Dirty)
+ (def: &functor ..functor)
(def: (apply ff fa)
(:abstraction ((:representation ff) (:representation fa)))))
- (structure: #export _ (Monad Dirty)
- (def: functor Functor<Dirty>)
+ (structure: #export monad (Monad Dirty)
+ (def: &functor ..functor)
(def: wrap (|>> :abstraction))
diff --git a/stdlib/source/lux/control/security/privacy.lux b/stdlib/source/lux/control/security/privacy.lux
index e24d49acb..51d530673 100644
--- a/stdlib/source/lux/control/security/privacy.lux
+++ b/stdlib/source/lux/control/security/privacy.lux
@@ -74,24 +74,24 @@
(-> Type Type)
(type (All [label] (constructor (All [value] (Private value label))))))
- (structure: #export Functor<Private>
+ (structure: #export functor
(:~ (privatize Functor))
(def: (map f fa)
(|> fa :representation f :abstraction)))
- (structure: #export Apply<Private>
+ (structure: #export apply
(:~ (privatize Apply))
- (def: functor Functor<Private>)
+ (def: &functor ..functor)
(def: (apply ff fa)
(:abstraction ((:representation ff) (:representation fa)))))
- (structure: #export Monad<Private>
+ (structure: #export monad
(:~ (privatize Monad))
- (def: functor Functor<Private>)
+ (def: &functor ..functor)
(def: wrap (|>> :abstraction))
diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux
index 94330ff96..c0db18a43 100644
--- a/stdlib/source/lux/control/state.lux
+++ b/stdlib/source/lux/control/state.lux
@@ -1,28 +1,26 @@
(.module:
[lux #*
[control
- ["F" functor]
- ["A" apply]
- [monad (#+ do Monad)]]])
+ [functor (#+ Functor)]
+ [apply (#+ Apply)]
+ [monad (#+ Monad do)]]])
-## [Types]
(type: #export (State s a)
{#.doc "Stateful computations."}
(-> s [s a]))
-## [Structures]
-(structure: #export Functor<State>
- (All [s] (F.Functor (State s)))
+(structure: #export functor
+ (All [s] (Functor (State s)))
(def: (map f ma)
(function (_ state)
(let [[state' a] (ma state)]
[state' (f a)]))))
-(structure: #export Apply<State>
- (All [s] (A.Apply (State s)))
+(structure: #export apply
+ (All [s] (Apply (State s)))
- (def: functor Functor<State>)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ state)
@@ -30,10 +28,10 @@
[state'' a] (fa state')]
[state'' (f a)]))))
-(structure: #export Monad<State>
+(structure: #export monad
(All [s] (Monad (State s)))
- (def: functor Functor<State>)
+ (def: &functor ..functor)
(def: (wrap a)
(function (_ state)
@@ -44,7 +42,6 @@
(let [[state' ma] (mma state)]
(ma state')))))
-## [Values]
(def: #export get
{#.doc "Read the current state."}
(All [s] (State s s))
@@ -81,22 +78,22 @@
(All [s a] (-> s (State s a) [s a]))
(action state))
-(structure: (Functor<State'> Functor<M>)
- (All [M s] (-> (F.Functor M) (F.Functor (All [a] (-> s (M [s a]))))))
+(structure: (with-state//functor functor)
+ (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a]))))))
(def: (map f sfa)
(function (_ state)
- (:: Functor<M> map (function (_ [s a]) [s (f a)])
+ (:: functor map (function (_ [s a]) [s (f a)])
(sfa state)))))
-(structure: (Apply<State'> Monad<M>)
- (All [M s] (-> (Monad M) (A.Apply (All [a] (-> s (M [s a]))))))
+(structure: (with-state//apply monad)
+ (All [M s] (-> (Monad M) (Apply (All [a] (-> s (M [s a]))))))
- (def: functor (Functor<State'> (:: Monad<M> functor)))
+ (def: &functor (with-state//functor (:: monad &functor)))
(def: (apply sFf sFa)
(function (_ state)
- (do Monad<M>
+ (do monad
[[state f] (sFf state)
[state a] (sFa state)]
(wrap [state (f a)])))))
@@ -110,33 +107,33 @@
(All [M s a] (-> s (State' M s a) (M [s a])))
(action state))
-(structure: #export (Monad<State'> Monad<M>)
+(structure: #export (with-state monad)
{#.doc "A monad transformer to create composite stateful computations."}
(All [M s] (-> (Monad M) (Monad (State' M s))))
- (def: functor (Functor<State'> (:: Monad<M> functor)))
+ (def: &functor (with-state//functor (:: monad &functor)))
(def: (wrap a)
(function (_ state)
- (:: Monad<M> wrap [state a])))
+ (:: monad wrap [state a])))
(def: (join sMsMa)
(function (_ state)
- (do Monad<M>
+ (do monad
[[state' sMa] (sMsMa state)]
(sMa state')))))
-(def: #export (lift Monad<M> ma)
+(def: #export (lift monad ma)
{#.doc "Lift monadic values to the State' wrapper."}
(All [M s a] (-> (Monad M) (M a) (State' M s a)))
(function (_ state)
- (do Monad<M>
+ (do monad
[a ma]
(wrap [state a]))))
(def: #export (while condition body)
(All [s] (-> (State s Bit) (State s Any) (State s Any)))
- (do Monad<State>
+ (do ..monad
[execute? condition]
(if execute?
(do @
@@ -146,6 +143,6 @@
(def: #export (do-while condition body)
(All [s] (-> (State s Bit) (State s Any) (State s Any)))
- (do Monad<State>
+ (do ..monad
[_ body]
(while condition body)))
diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux
index 9aad8aca0..708f385a2 100644
--- a/stdlib/source/lux/control/thread.lux
+++ b/stdlib/source/lux/control/thread.lux
@@ -47,7 +47,7 @@
a))
(thread []))
-(structure: #export Functor<Thread>
+(structure: #export functor
(All [!] (Functor (Thread !)))
(def: (map f)
@@ -55,19 +55,19 @@
(function (_ !)
(f (fa !))))))
-(structure: #export Apply<Thread>
+(structure: #export apply
(All [!] (Apply (Thread !)))
- (def: functor Functor<Thread>)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ !)
((ff !) (fa !)))))
-(structure: #export Monad<Thread>
+(structure: #export monad
(All [!] (Monad (Thread !)))
- (def: functor Functor<Thread>)
+ (def: &functor ..functor)
(def: (wrap value)
(function (_ !)
@@ -79,7 +79,7 @@
(def: #export (update f box)
(All [a] (-> (-> a a) (All [!] (-> (Box ! a) (Thread ! a)))))
- (do Monad<Thread>
+ (do ..monad
[old (read box)
_ (write (f old) box)]
(wrap old)))
diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux
index 4007cb6cb..152bc9e71 100644
--- a/stdlib/source/lux/control/writer.lux
+++ b/stdlib/source/lux/control/writer.lux
@@ -2,39 +2,39 @@
[lux #*
[control
monoid
- ["F" functor]
- ["A" apply]
- ["." monad (#+ do Monad)]]])
+ [functor (#+ Functor)]
+ [apply (#+ Apply)]
+ ["." monad (#+ Monad do)]]])
(type: #export (Writer l a)
{#.doc "Represents a value with an associated 'log' value to record arbitrary information."}
{#log l
#value a})
-(structure: #export Functor<Writer>
+(structure: #export functor
(All [l]
- (F.Functor (Writer l)))
+ (Functor (Writer l)))
(def: (map f fa)
(let [[log datum] fa]
[log (f datum)])))
-(structure: #export (Apply<Writer> mon)
+(structure: #export (apply mon)
(All [l]
- (-> (Monoid l) (A.Apply (Writer l))))
+ (-> (Monoid l) (Apply (Writer l))))
- (def: functor Functor<Writer>)
+ (def: &functor ..functor)
(def: (apply ff fa)
(let [[log1 f] ff
[log2 a] fa]
[(:: mon compose log1 log2) (f a)])))
-(structure: #export (Monad<Writer> mon)
+(structure: #export (monad mon)
(All [l]
(-> (Monoid l) (Monad (Writer l))))
- (def: functor Functor<Writer>)
+ (def: &functor ..functor)
(def: (wrap x)
[(:: mon identity) x])
@@ -48,17 +48,17 @@
(All [l] (-> l (Writer l Any)))
[l []])
-(structure: #export (WriterT Monoid<l> Monad<M>)
+(structure: #export (with-writer Monoid<l> monad)
(All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a))))))
- (def: functor (F.compose (get@ #monad.functor Monad<M>) Functor<Writer>))
+ (def: &functor (F.compose (get@ #monad.&functor monad) ..functor))
(def: wrap
- (let [monad (Monad<Writer> Monoid<l>)]
- (|>> (:: monad wrap) (:: Monad<M> wrap))))
+ (let [monad (..monad Monoid<l>)]
+ (|>> (:: monad wrap) (:: monad wrap))))
(def: (join MlMla)
- (do Monad<M>
+ (do monad
[## TODO: Remove once new-luxc is the standard compiler.
[l1 Mla] (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2)))))
MlMla)
@@ -66,9 +66,9 @@
[l2 a] Mla]
(wrap [(:: Monoid<l> compose l1 l2) a]))))
-(def: #export (lift Monoid<l> Monad<M>)
+(def: #export (lift Monoid<l> monad)
(All [l M a] (-> (Monoid l) (Monad M) (-> (M a) (M (Writer l a)))))
(function (_ ma)
- (do Monad<M>
+ (do monad
[a ma]
(wrap [(:: Monoid<l> identity) a]))))
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux
index 8cf671429..613d923b3 100644
--- a/stdlib/source/lux/data/bit.lux
+++ b/stdlib/source/lux/data/bit.lux
@@ -7,15 +7,14 @@
[codec (#+ Codec)]]
function])
-## [Structures]
-(structure: #export _ (Equivalence Bit)
+(structure: #export equivalence (Equivalence Bit)
(def: (= x y)
(if x
y
(not y))))
-(structure: #export _ (Hash Bit)
- (def: eq Equivalence<Bit>)
+(structure: #export hash (Hash Bit)
+ (def: &equivalence ..equivalence)
(def: (hash value)
(case value
#1 1
@@ -24,14 +23,13 @@
(do-template [<name> <identity> <op>]
[(structure: #export <name> (Monoid Bit)
(def: identity <identity>)
- (def: (compose x y)
- (<op> x y)))]
+ (def: (compose x y) (<op> x y)))]
- [ Or@Monoid<Bit> #0 or]
- [And@Monoid<Bit> #1 and]
+ [ or-monoid #0 or]
+ [and-monoid #1 and]
)
-(structure: #export _ (Codec Text Bit)
+(structure: #export codec (Codec Text Bit)
(def: (encode x)
(if x
"#1"
@@ -43,7 +41,6 @@
"#0" (#.Right #0)
_ (#.Left "Wrong syntax for Bit."))))
-## [Values]
(def: #export complement
{#.doc (doc "Generates the complement of a predicate."
"That is a predicate that returns the oposite of the original predicate.")}
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 8c1b5c2b3..65ca3b0f6 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -10,7 +10,7 @@
["." product]
["." maybe]
[collection
- ["." list ("list/." Fold<List>)]]]
+ ["." list ("list/." fold)]]]
[platform
[compiler
["." host]]]])
@@ -211,7 +211,7 @@
(#.Cons (maybe.default default (read idx array))
output)))))
-(structure: #export (Equivalence<Array> Equivalence<a>)
+(structure: #export (equivalence Equivalence<a>)
(All [a] (-> (Equivalence a) (Equivalence (Array a))))
(def: (= xs ys)
(let [sxs (size xs)
@@ -231,7 +231,7 @@
#1
(list.indices sxs))))))
-(structure: #export Monoid<Array> (All [a] (Monoid (Array a)))
+(structure: #export monoid (All [a] (Monoid (Array a)))
(def: identity (new 0))
(def: (compose xs ys)
@@ -241,7 +241,7 @@
(copy sxs 0 xs 0)
(copy sxy 0 ys sxs)))))
-(structure: #export _ (Functor Array)
+(structure: #export functor (Functor Array)
(def: (map f ma)
(let [arr-size (size ma)]
(if (n/= 0 arr-size)
@@ -257,7 +257,7 @@
(list.indices arr-size))
))))
-(structure: #export _ (Fold Array)
+(structure: #export fold (Fold Array)
(def: (fold f init xs)
(let [arr-size (size xs)]
(loop [so-far init
diff --git a/stdlib/source/lux/data/collection/bits.lux b/stdlib/source/lux/data/collection/bits.lux
index 8855c0593..0837a4dbb 100644
--- a/stdlib/source/lux/data/collection/bits.lux
+++ b/stdlib/source/lux/data/collection/bits.lux
@@ -10,7 +10,7 @@
[text
format]
[collection
- ["." array (#+ Array) ("array/." Fold<Array>)]]]])
+ ["." array (#+ Array) ("array/." fold)]]]])
(type: #export Chunk I64)
@@ -156,7 +156,7 @@
[xor i64.xor]
)
-(structure: #export _ (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 b0f0920fb..21aaecf39 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -9,8 +9,8 @@
["." number
["." i64]]
[collection
- ["." list ("list/." Fold<List> Functor<List> Monoid<List>)]
- ["." array (#+ Array) ("array/." Functor<Array> Fold<Array>)]]]
+ ["." list ("list/." fold functor monoid)]
+ ["." array (#+ Array) ("array/." functor fold)]]]
])
## This implementation of Hash Array Mapped Trie (HAMT) is based on
@@ -210,7 +210,7 @@
## Produces the index of a KV-pair within a #Collisions node.
(def: (collision-index Hash<k> key colls)
(All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index)))
- (:: maybe.Monad<Maybe> map product.left
+ (:: maybe.monad map product.left
(array.find+ (function (_ idx [key' val'])
(:: Hash<k> = key key'))
colls)))
@@ -491,7 +491,7 @@
## For #Collisions nodes, do a linear scan of all the known KV-pairs.
(#Collisions _hash _colls)
- (:: maybe.Monad<Maybe> map product.right
+ (:: maybe.monad map product.right
(array.find (|>> product.left (:: Hash<k> = key))
_colls))
))
@@ -668,7 +668,7 @@
keys)))
## [Structures]
-(structure: #export (Equivalence<Dictionary> Equivalence<v>) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
+(structure: #export (equivalence Equivalence<v>) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
(def: (= test subject)
(and (n/= (size test)
(size subject))
diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux
index 25c50367b..b6cda46d1 100644
--- a/stdlib/source/lux/data/collection/dictionary/ordered.lux
+++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux
@@ -1,14 +1,14 @@
(.module:
[lux #*
[control
- [monad (#+ do Monad)]
+ [monad (#+ Monad do)]
equivalence
[order (#+ Order)]]
[data
["p" product]
["." maybe]
[collection
- [list ("list/." Monoid<List> Fold<List>)]]]
+ [list ("list/." monoid fold)]]]
["." macro
["." code]
["s" syntax (#+ syntax: Syntax)]]])
@@ -352,7 +352,7 @@
(#.Some (right-balance (get@ #key right)
(get@ #value right)
(get@ #right right>>left)
- (:: maybe.Functor<Maybe> map redden (get@ #right right)))))
+ (:: maybe.functor map redden (get@ #right right)))))
_
(error! error-message))
@@ -379,7 +379,7 @@
(get@ #value left>>right)
(#.Some (left-balance (get@ #key left)
(get@ #value left)
- (:: maybe.Functor<Maybe> map redden (get@ #left left))
+ (:: maybe.functor map redden (get@ #left left))
(get@ #left left>>right)))
(#.Some (black key value (get@ #right left>>right) ?right)))
@@ -399,7 +399,7 @@
[(#.Some left) (#.Some right)]
(case [(get@ #color left) (get@ #color right)]
[#Red #Red]
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[fused (prepend (get@ #right left) (get@ #right right))]
(case (get@ #color fused)
#Red
@@ -438,7 +438,7 @@
(get@ #right right)))
[#Black #Black]
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[fused (prepend (get@ #right left) (get@ #left right))]
(case (get@ #color fused)
#Red
@@ -524,7 +524,7 @@
(def: #export (update key transform dict)
(All [k v] (-> k (-> v v) (Dictionary k v) (Maybe (Dictionary k v))))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[old (get key dict)]
(wrap (put key (transform old) dict))))
@@ -554,7 +554,7 @@
[values v (get@ #value node')]
)
-(structure: #export (Equivalence<Dictionary> Equivalence<v>) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
+(structure: #export (equivalence Equivalence<v>) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v))))
(def: (= reference sample)
(let [Equivalence<k> (:: sample eq)]
(loop [entriesR (entries reference)
diff --git a/stdlib/source/lux/data/collection/dictionary/plist.lux b/stdlib/source/lux/data/collection/dictionary/plist.lux
index 2f4593fac..7b11ee208 100644
--- a/stdlib/source/lux/data/collection/dictionary/plist.lux
+++ b/stdlib/source/lux/data/collection/dictionary/plist.lux
@@ -2,9 +2,9 @@
[lux #*
[data
["." product]
- [text ("text/." Equivalence<Text>)]
+ [text ("text/." equivalence)]
[collection
- [list ("list/." Functor<List>)]]]])
+ [list ("list/." functor)]]]])
(type: #export (PList a)
(List [Text a]))
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index a92175d53..6d3b4cf85 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -9,16 +9,14 @@
[fold (#+ Fold)]
[predicate (#+ Predicate)]]
[data
- bit
+ ["." bit]
["." product]]])
-## [Types]
## (type: (List a)
## #Nil
## (#Cons a (List a)))
-## [Functions]
-(structure: #export _ (Fold List)
+(structure: #export fold (Fold List)
(def: (fold f init xs)
(case xs
#.Nil
@@ -27,8 +25,6 @@
(#.Cons [x xs'])
(fold f (f x init) xs'))))
-(open: "." Fold<List>)
-
(def: #export (reverse xs)
(All [a]
(-> (List a) (List a)))
@@ -36,7 +32,7 @@
#.Nil
xs))
-(def: #export (filter predicate xs)
+(def: #export (filter keep? xs)
(All [a]
(-> (Predicate a) (List a) (List a)))
(case xs
@@ -44,15 +40,22 @@
#.Nil
(#.Cons [x xs'])
- (if (predicate x)
- (#.Cons x (filter predicate xs'))
- (filter predicate xs'))))
+ (if (keep? x)
+ (#.Cons x (filter keep? xs'))
+ (filter keep? xs'))))
-(def: #export (partition predicate xs)
+(def: #export (partition satisfies? list)
{#.doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."}
(All [a] (-> (Predicate a) (List a) [(List a) (List a)]))
- [(filter predicate xs)
- (filter (complement predicate) xs)])
+ (case list
+ #.Nil
+ [#.Nil #.Nil]
+
+ (#.Cons head tail)
+ (let [[in out] (partition satisfies? tail)]
+ (if (satisfies? head)
+ [(list& head in) out]
+ [in (list& head out)]))))
(def: #export (as-pairs xs)
{#.doc (doc "Cut the list into pairs of 2."
@@ -266,8 +269,7 @@
(#.Some x)
(nth (dec i) xs'))))
-## [Structures]
-(structure: #export (Equivalence<List> Equivalence<a>)
+(structure: #export (equivalence Equivalence<a>)
(All [a] (-> (Equivalence a) (Equivalence (List a))))
(def: (= xs ys)
(case [xs ys]
@@ -282,26 +284,25 @@
#0
)))
-(structure: #export Monoid<List> (All [a]
- (Monoid (List a)))
+(structure: #export monoid (All [a] (Monoid (List a)))
(def: identity #.Nil)
(def: (compose xs ys)
(case xs
#.Nil ys
(#.Cons x xs') (#.Cons x (compose xs' ys)))))
-(open: "." Monoid<List>)
+(open: "." monoid)
-(structure: #export _ (Functor List)
+(structure: #export functor (Functor List)
(def: (map f ma)
(case ma
#.Nil #.Nil
(#.Cons a ma') (#.Cons (f a) (map f ma')))))
-(open: "." Functor<List>)
+(open: "." ..functor)
-(structure: #export _ (Apply List)
- (def: functor Functor<List>)
+(structure: #export apply (Apply List)
+ (def: &functor ..functor)
(def: (apply ff fa)
(case ff
@@ -311,15 +312,14 @@
(#.Cons f ff')
(compose (map f fa) (apply ff' fa)))))
-(structure: #export _ (Monad List)
- (def: functor Functor<List>)
+(structure: #export monad (Monad List)
+ (def: &functor ..functor)
(def: (wrap a)
(#.Cons a #.Nil))
(def: join (|>> reverse (fold compose identity))))
-## [Functions]
(def: #export (sort < xs)
(All [a] (-> (-> a a Bit) (List a) (List a)))
(case xs
@@ -387,7 +387,6 @@
(list)
(|> size dec (n/range 0))))
-## [Syntax]
(def: (identifier$ name)
(-> Text Code)
[["" 0 0] (#.Identifier "" name)])
@@ -422,7 +421,7 @@
(case tokens
(^ (list [_ (#.Nat num-lists)]))
(if (n/> 0 num-lists)
- (let [(^open ".") Functor<List>
+ (let [(^open ".") ..functor
indices (..indices num-lists)
type-vars (: (List Code) (map (|>> nat/encode identifier$) indices))
zip-type (` (All [(~+ type-vars)]
@@ -466,7 +465,7 @@
(case tokens
(^ (list [_ (#.Nat num-lists)]))
(if (n/> 0 num-lists)
- (let [(^open ".") Functor<List>
+ (let [(^open ".") ..functor
indices (..indices num-lists)
g!return-type (identifier$ "0return-type0")
g!func (identifier$ "0func0")
@@ -539,17 +538,17 @@
(def: #export (concat xss)
(All [a] (-> (List (List a)) (List a)))
- (:: Monad<List> join xss))
+ (:: ..monad join xss))
-(structure: #export (ListT Monad<M>)
+(structure: #export (with-list monad)
(All [M] (-> (Monad M) (Monad (All [a] (M (List a))))))
- (def: functor (functor.compose (get@ #monad.functor Monad<M>) Functor<List>))
+ (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
- (def: wrap (|>> (:: Monad<List> wrap) (:: Monad<M> wrap)))
+ (def: wrap (|>> (:: ..monad wrap) (:: monad wrap)))
(def: (join MlMla)
- (do Monad<M>
+ (do monad
[lMla MlMla
## TODO: Remove this version ASAP and use one below.
lla (: (($ 0) (List (List ($ 1))))
@@ -558,9 +557,9 @@
]
(wrap (concat lla)))))
-(def: #export (lift Monad<M>)
+(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (List a)))))
- (monad.lift Monad<M> (:: Monad<List> wrap)))
+ (monad.lift monad (:: ..monad wrap)))
(def: (enumerate' idx xs)
(All [a] (-> Nat (List a) (List [Nat a])))
diff --git a/stdlib/source/lux/data/collection/queue.lux b/stdlib/source/lux/data/collection/queue.lux
index 4973b925e..ce66391c8 100644
--- a/stdlib/source/lux/data/collection/queue.lux
+++ b/stdlib/source/lux/data/collection/queue.lux
@@ -2,10 +2,10 @@
[lux #*
[control
[equivalence (#+ Equivalence)]
- ["F" functor]]
+ [functor (#+ Functor)]]
[data
[collection
- ["." list ("list/." Monoid<List> Functor<List>)]]]])
+ ["." list ("list/." monoid functor)]]]])
(type: #export (Queue a)
{#front (List a)
@@ -70,12 +70,12 @@
_
(update@ #rear (|>> (#.Cons val)) queue)))
-(structure: #export (Equivalence<Queue> Equivalence<a>)
+(structure: #export (equivalence Equivalence<a>)
(All [a] (-> (Equivalence a) (Equivalence (Queue a))))
(def: (= qx qy)
- (:: (list.Equivalence<List> Equivalence<a>) = (to-list qx) (to-list qy))))
+ (:: (list.equivalence Equivalence<a>) = (to-list qx) (to-list qy))))
-(structure: #export _ (F.Functor Queue)
+(structure: #export functor (Functor Queue)
(def: (map f fa)
{#front (|> fa (get@ #front) (list/map f))
#rear (|> fa (get@ #rear) (list/map f))}))
diff --git a/stdlib/source/lux/data/collection/queue/priority.lux b/stdlib/source/lux/data/collection/queue/priority.lux
index 1af9acaab..59167d2e7 100644
--- a/stdlib/source/lux/data/collection/queue/priority.lux
+++ b/stdlib/source/lux/data/collection/queue/priority.lux
@@ -5,7 +5,8 @@
[monad (#+ do Monad)]]
[data
["." maybe]
- ["." number ("nat/." Interval<Nat>)]
+ [number
+ ["." nat ("nat/." interval)]]
[collection
[tree
["." finger (#+ Tree)]]]]])
@@ -24,7 +25,7 @@
(def: #export (peek queue)
(All [a] (-> (Queue a) (Maybe a)))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[fingers queue]
(wrap (maybe.assume (finger.search (n/= (finger.tag fingers)) fingers)))))
@@ -61,7 +62,7 @@
(def: #export (pop queue)
(All [a] (-> (Queue a) (Queue a)))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[fingers queue
#let [highest-priority (finger.tag fingers)]
node' (loop [node (get@ #finger.node fingers)]
@@ -96,7 +97,7 @@
(def: #export (push priority value queue)
(All [a] (-> Priority a (Queue a) (Queue a)))
- (let [addition {#finger.monoid number.Max@Monoid<Nat>
+ (let [addition {#finger.monoid nat.maximum
#finger.node (#finger.Leaf priority value)}]
(case queue
#.None
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index f495cf755..b3cbfedf1 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -15,8 +15,8 @@
[number
["." i64]]
[collection
- ["." list ("list/." Fold<List> Functor<List> Monoid<List>)]
- ["." array (#+ Array) ("array/." Functor<Array> Fold<Array>)]]]
+ ["." list ("list/." fold functor monoid)]
+ ["." array (#+ Array) ("array/." functor fold)]]]
[macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax: Syntax)]]])
@@ -141,7 +141,7 @@
#.None
(n/> branching-exponent level)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[base|hierarchy (array.read sub-idx hierarchy)
sub (case base|hierarchy
(#Hierarchy sub)
@@ -250,7 +250,7 @@
(def: #export (nth idx vec)
(All [a] (-> Nat (Row a) (Maybe a)))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[base (base-for idx vec)]
(array.read (branch-idx idx) base)))
@@ -297,7 +297,7 @@
(set@ #tail (|> (array.new new-tail-size)
(array.copy new-tail-size 0 old-tail 0)))))
(maybe.assume
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[new-tail (base-for (n/- 2 vec-size) vec)
#let [[level' root'] (let [init-level (get@ #level vec)]
(loop [level init-level
@@ -345,28 +345,28 @@
(wrap (list (` (from-list (list (~+ elems)))))))
## [Structures]
-(structure: #export (Equivalence<Node> Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Node a))))
+(structure: #export (node-equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Node a))))
(def: (= v1 v2)
(case [v1 v2]
[(#Base b1) (#Base b2)]
- (:: (array.Equivalence<Array> Equivalence<a>) = b1 b2)
+ (:: (array.equivalence Equivalence<a>) = b1 b2)
[(#Hierarchy h1) (#Hierarchy h2)]
- (:: (array.Equivalence<Array> (Equivalence<Node> Equivalence<a>)) = h1 h2)
+ (:: (array.equivalence (node-equivalence Equivalence<a>)) = h1 h2)
_
#0)))
-(structure: #export (Equivalence<Row> Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Row a))))
+(structure: #export (equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Row a))))
(def: (= v1 v2)
(and (n/= (get@ #size v1) (get@ #size v2))
- (let [(^open "Node/.") (Equivalence<Node> Equivalence<a>)]
+ (let [(^open "Node/.") (node-equivalence Equivalence<a>)]
(and (Node/= (#Base (get@ #tail v1))
(#Base (get@ #tail v2)))
(Node/= (#Hierarchy (get@ #root v1))
(#Hierarchy (get@ #root v2))))))))
-(structure: _ (Fold Node)
+(structure: node-fold (Fold Node)
(def: (fold f init xs)
(case xs
(#Base base)
@@ -377,21 +377,22 @@
init
hierarchy))))
-(structure: #export _ (Fold Row)
+(structure: #export fold (Fold Row)
(def: (fold f init xs)
- (let [(^open ".") Fold<Node>]
+ (let [(^open ".") node-fold]
(fold f
(fold f
init
(#Hierarchy (get@ #root xs)))
(#Base (get@ #tail xs))))))
-(structure: #export Monoid<Row> (All [a] (Monoid (Row a)))
+(structure: #export monoid (All [a] (Monoid (Row a)))
(def: identity ..empty)
+
(def: (compose xs ys)
(list/fold add xs (..to-list ys))))
-(structure: _ (Functor Node)
+(structure: node-functor (Functor Node)
(def: (map f xs)
(case xs
(#Base base)
@@ -400,40 +401,40 @@
(#Hierarchy hierarchy)
(#Hierarchy (array/map (map f) hierarchy)))))
-(structure: #export _ (Functor Row)
+(structure: #export functor (Functor Row)
(def: (map f xs)
{#level (get@ #level xs)
#size (get@ #size xs)
- #root (|> xs (get@ #root) (array/map (:: Functor<Node> map f)))
+ #root (|> xs (get@ #root) (array/map (:: node-functor map f)))
#tail (|> xs (get@ #tail) (array/map f))}))
-(structure: #export _ (Apply Row)
- (def: functor Functor<Row>)
+(structure: #export apply (Apply Row)
+ (def: &functor ..functor)
(def: (apply ff fa)
- (let [(^open ".") Functor<Row>
- (^open ".") Fold<Row>
- (^open ".") Monoid<Row>
+ (let [(^open ".") ..functor
+ (^open ".") ..fold
+ (^open ".") ..monoid
results (map (function (_ f) (map f fa))
ff)]
(fold compose identity results))))
-(structure: #export _ (Monad Row)
- (def: functor Functor<Row>)
+(structure: #export monad (Monad Row)
+ (def: &functor ..functor)
(def: wrap (|>> row))
(def: join
- (let [(^open ".") Fold<Row>
- (^open ".") Monoid<Row>]
+ (let [(^open ".") ..fold
+ (^open ".") ..monoid]
(fold (function (_ post pre) (compose pre post)) identity))))
## TODO: This definition of 'reverse' shouldn't work correctly.
## Investigate if/why it does.
(def: #export reverse
(All [a] (-> (Row a) (Row a)))
- (let [(^open ".") Fold<Row>
- (^open ".") Monoid<Row>]
+ (let [(^open ".") ..fold
+ (^open ".") ..monoid]
(fold add identity)))
(do-template [<name> <array> <init> <op>]
diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux
index 06209f4d6..30b2bf46e 100644
--- a/stdlib/source/lux/data/collection/sequence.lux
+++ b/stdlib/source/lux/data/collection/sequence.lux
@@ -12,14 +12,12 @@
[data
bit
[collection
- [list ("list/." Monad<List>)]]]])
+ [list ("list/." monad)]]]])
-## [Types]
(type: #export (Sequence a)
{#.doc "An infinite sequence of values."}
(Cont [a (Sequence a)]))
-## [Utils]
(def: (cycle' x xs init full)
(All [a]
(-> a (List a) a (List a) (Sequence a)))
@@ -27,7 +25,6 @@
#.Nil (pending [x (cycle' init full init full)])
(#.Cons x' xs') (pending [x (cycle' x' xs' init full)])))
-## [Functions]
(def: #export (iterate f x)
{#.doc "Create a sequence by applying a function to a value, and to its result, on and on..."}
(All [a]
@@ -116,20 +113,18 @@
(All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)]))
[(filter p xs) (filter (complement p) xs)])
-## [Structures]
-(structure: #export _ (Functor Sequence)
+(structure: #export functor (Functor Sequence)
(def: (map f fa)
(let [[h t] (continuation.run fa)]
(pending [(f h) (map f t)]))))
-(structure: #export _ (CoMonad Sequence)
- (def: functor Functor<Sequence>)
+(structure: #export comonad (CoMonad Sequence)
+ (def: &functor ..functor)
(def: unwrap head)
(def: (split wa)
(let [[head tail] (continuation.run wa)]
(pending [wa (split tail)]))))
-## [Pattern-matching]
(syntax: #export (^sequence& {patterns (s.form (p.many s.any))}
body
{branches (p.some s.any)})
diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux
index 6de27eb24..01a588cc1 100644
--- a/stdlib/source/lux/data/collection/set.lux
+++ b/stdlib/source/lux/data/collection/set.lux
@@ -7,7 +7,7 @@
[data
[collection
["dict" dictionary (#+ Dictionary)]
- ["." list ("list/." Fold<List>)]]]
+ ["." list ("list/." fold)]]]
[type
abstract]])
@@ -53,18 +53,18 @@
(:abstraction (dict.select (dict.keys (:representation filter))
(:representation base))))
- (structure: #export Equivalence<Set> (All [a] (Equivalence (Set a)))
+ (structure: #export equivalence (All [a] (Equivalence (Set a)))
(def: (= reference sample)
- (let [[Hash<a> _] (:representation reference)]
- (:: (list.Equivalence<List> (get@ #hash.eq Hash<a>)) =
+ (let [[hash _] (:representation reference)]
+ (:: (list.equivalence (get@ #hash.&equivalence hash)) =
(..to-list reference) (..to-list sample)))))
- (structure: #export Hash<Set> (All [a] (Hash (Set a)))
- (def: eq ..Equivalence<Set>)
+ (structure: #export hash (All [a] (Hash (Set a)))
+ (def: &equivalence ..equivalence)
(def: (hash set)
- (let [[Hash<a> _] (:representation set)]
- (list/fold (function (_ elem acc) (n/+ (:: Hash<a> hash elem) acc))
+ (let [[hash _] (:representation set)]
+ (list/fold (function (_ elem acc) (n/+ (:: hash hash elem) acc))
0
(..to-list set)))))
)
@@ -73,9 +73,9 @@
(All [a] (-> (Set a) Bit))
(|>> ..size (n/= 0)))
-(def: #export (from-list Hash<a> xs)
+(def: #export (from-list hash elements)
(All [a] (-> (Hash a) (List a) (Set a)))
- (list/fold ..add (..new Hash<a>) xs))
+ (list/fold ..add (..new hash) elements))
(def: #export (sub? super sub)
(All [a] (-> (Set a) (Set a) Bit))
diff --git a/stdlib/source/lux/data/collection/set/multi.lux b/stdlib/source/lux/data/collection/set/multi.lux
index d152c8506..de770e30a 100644
--- a/stdlib/source/lux/data/collection/set/multi.lux
+++ b/stdlib/source/lux/data/collection/set/multi.lux
@@ -10,7 +10,7 @@
[////
["." maybe]]
[///
- ["." list ("list/." Fold<List>)]
+ ["." list ("list/." fold)]
["." dictionary (#+ Dictionary)]]
["." //])
@@ -115,7 +115,7 @@
dictionary.keys
(//.from-list Hash<a>))))
- (structure: #export Equivalence<Set> (All [a] (Equivalence (Set a)))
+ (structure: #export equivalence (All [a] (Equivalence (Set a)))
(def: (= (^:representation reference) (^:representation sample))
(and (n/= (dictionary.size reference)
(dictionary.size sample))
@@ -127,8 +127,8 @@
(maybe.default 0)
(n/= count))))))))
- (structure: #export Hash<Set> (All [a] (Hash (Set a)))
- (def: eq ..Equivalence<Set>)
+ (structure: #export hash (All [a] (Hash (Set a)))
+ (def: &equivalence ..equivalence)
(def: (hash (^:representation set))
(let [[Hash<a> _] set]
diff --git a/stdlib/source/lux/data/collection/set/ordered.lux b/stdlib/source/lux/data/collection/set/ordered.lux
index 02b0307f9..a16a42ead 100644
--- a/stdlib/source/lux/data/collection/set/ordered.lux
+++ b/stdlib/source/lux/data/collection/set/ordered.lux
@@ -5,7 +5,7 @@
[order (#+ Order)]]
[data
[collection
- ["." list ("list/." Fold<List>)]
+ ["." list ("list/." fold)]
[dictionary
["//" ordered]]]]
[type
@@ -74,9 +74,9 @@
(list.filter (|>> (..member? param) not))
(..from-list (get@ #//.order (:representation subject)))))
- (structure: #export Equivalence<Set> (All [a] (Equivalence (Set a)))
+ (structure: #export equivalence (All [a] (Equivalence (Set a)))
(def: (= reference sample)
- (:: (list.Equivalence<List> (:: (:representation sample) eq))
+ (:: (list.equivalence (:: (:representation sample) eq))
= (..to-list reference) (..to-list sample))))
)
diff --git a/stdlib/source/lux/data/collection/tree/rose.lux b/stdlib/source/lux/data/collection/tree/rose.lux
index fc25f414f..18ab2bf44 100644
--- a/stdlib/source/lux/data/collection/tree/rose.lux
+++ b/stdlib/source/lux/data/collection/tree/rose.lux
@@ -8,7 +8,7 @@
fold]
[data
[collection
- ["." list ("list/." Monad<List> Fold<List>)]]]
+ ["." list ("list/." monad fold)]]]
["." macro
["." code]
["s" syntax (#+ syntax: Syntax)]]])
@@ -57,18 +57,18 @@
#children (list (~+ (list/map recur children)))})))))))
## [Structs]
-(structure: #export (Equivalence<Tree> Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
+(structure: #export (equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
(def: (= tx ty)
(and (:: Equivalence<a> = (get@ #value tx) (get@ #value ty))
- (:: (list.Equivalence<List> (Equivalence<Tree> Equivalence<a>)) = (get@ #children tx) (get@ #children ty)))))
+ (:: (list.equivalence (equivalence Equivalence<a>)) = (get@ #children tx) (get@ #children ty)))))
-(structure: #export _ (Functor Tree)
+(structure: #export functor (Functor Tree)
(def: (map f fa)
{#value (f (get@ #value fa))
#children (list/map (map f)
(get@ #children fa))}))
-(structure: #export _ (Fold Tree)
+(structure: #export fold (Fold Tree)
(def: (fold f init tree)
(list/fold (function (_ tree' init') (fold f init' tree'))
(f (get@ #value tree)
diff --git a/stdlib/source/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/lux/data/collection/tree/rose/zipper.lux
index f9380577b..e5d16a07a 100644
--- a/stdlib/source/lux/data/collection/tree/rose/zipper.lux
+++ b/stdlib/source/lux/data/collection/tree/rose/zipper.lux
@@ -4,14 +4,14 @@
functor
comonad]
[data
- ["." maybe ("maybe/." Monad<Maybe>)]
+ ["." maybe ("maybe/." monad)]
[collection
- ["." list ("list/." Functor<List> Fold<List> Monoid<List>)]
+ ["." list ("list/." functor fold monoid)]
["." stack (#+ Stack)]]]
["." macro
["." code]
- ["s" syntax (#+ syntax: Syntax)]]]
- ["." // (#+ Tree) ("tree/." Functor<Tree>)])
+ ["s" syntax (#+ Syntax syntax:)]]]
+ ["." // (#+ Tree) ("tree/." functor)])
## Adapted from the clojure.zip namespace in the Clojure standard library.
@@ -214,7 +214,7 @@
[insert-right #rights]
)
-(structure: #export _ (Functor Zipper)
+(structure: #export functor (Functor Zipper)
(def: (map f fa)
{#parent (|> fa (get@ #parent) (maybe/map (map f)))
#lefts (|> fa (get@ #lefts) (list/map (tree/map f)))
@@ -222,8 +222,8 @@
#node (tree/map f (get@ #node fa))}))
## TODO: Add again once new-luxc becomes the standard compiler.
-## (structure: #export _ (CoMonad Zipper)
-## (def: functor Functor<Zipper>)
+## (structure: #export comonad (CoMonad Zipper)
+## (def: &functor ..functor)
## (def: unwrap (get@ [#node #//.value]))
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux
index 0c96f46c4..e0de8ac88 100644
--- a/stdlib/source/lux/data/color.lux
+++ b/stdlib/source/lux/data/color.lux
@@ -3,9 +3,10 @@
[control
[equivalence (#+ Equivalence)]]
[data
- [number ("rev/." Interval<Rev>)]
+ [number
+ [rev ("rev/." interval)]]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
["." math]
[type
abstract]])
@@ -55,7 +56,7 @@
(-> Color RGB)
(|>> :representation))
- (structure: #export _ (Equivalence Color)
+ (structure: #export equivalence (Equivalence Color)
(def: (= reference sample)
(let [[rr rg rb] (:representation reference)
[sr sg sb] (:representation sample)]
diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux
index 134220215..2c8d01fcd 100644
--- a/stdlib/source/lux/data/env.lux
+++ b/stdlib/source/lux/data/env.lux
@@ -1,18 +1,19 @@
(.module:
[lux #*
- [control ["F" functor]
+ [control
+ [functor (#+ Functor)]
comonad]])
(type: #export (Env e a)
{#env e
#value a})
-(structure: #export Functor<Env> (All [e] (F.Functor (Env e)))
+(structure: #export functor (All [e] (Functor (Env e)))
(def: (map f fa)
(update@ #value f fa)))
-(structure: #export CoMonad<Env> (All [e] (CoMonad (Env e)))
- (def: functor Functor<Env>)
+(structure: #export comonad (All [e] (CoMonad (Env e)))
+ (def: &functor ..functor)
(def: unwrap (get@ #value))
diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux
index fc30718af..98f05869f 100644
--- a/stdlib/source/lux/data/error.lux
+++ b/stdlib/source/lux/data/error.lux
@@ -1,17 +1,15 @@
(.module:
[lux #*
[control
- ["F" functor]
- ["A" apply]
- ["M" monad (#+ do Monad)]]])
+ ["." functor (#+ Functor)]
+ [apply (#+ Apply)]
+ ["." monad (#+ Monad do)]]])
-## [Types]
(type: #export (Error a)
(#Failure Text)
(#Success a))
-## [Structures]
-(structure: #export _ (F.Functor Error)
+(structure: #export functor (Functor Error)
(def: (map f ma)
(case ma
(#Failure msg)
@@ -20,8 +18,8 @@
(#Success datum)
(#Success (f datum)))))
-(structure: #export _ (A.Apply Error)
- (def: functor Functor<Error>)
+(structure: #export apply (Apply Error)
+ (def: &functor ..functor)
(def: (apply ff fa)
(case ff
@@ -37,8 +35,8 @@
(#Failure msg))
))
-(structure: #export _ (Monad Error)
- (def: functor Functor<Error>)
+(structure: #export monad (Monad Error)
+ (def: &functor ..functor)
(def: (wrap a)
(#Success a))
@@ -51,15 +49,16 @@
(#Success ma)
ma)))
-(structure: #export (ErrorT Monad<M>)
+(structure: #export (with-error monad)
+ ## TODO: Replace (All [a] (M (Error a))) with (functor.Then M Error)
(All [M] (-> (Monad M) (Monad (All [a] (M (Error a))))))
- (def: functor (F.compose (get@ #M.functor Monad<M>) Functor<Error>))
+ (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
- (def: wrap (|>> (:: Monad<Error> wrap) (:: Monad<M> wrap)))
+ (def: wrap (|>> (:: ..monad wrap) (:: monad wrap)))
(def: (join MeMea)
- (do Monad<M>
+ (do monad
[eMea MeMea]
(case eMea
(#Failure error)
@@ -68,16 +67,16 @@
(#Success Mea)
Mea))))
-(def: #export (lift Monad<M>)
+(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
- (M.lift Monad<M> (:: Monad<Error> wrap)))
+ (monad.lift monad (:: ..monad wrap)))
(def: #export (succeed value)
(All [a] (-> a (Error a)))
(#Success value))
(def: #export (fail message)
- (All [a] (-> Text (Error a)))
+ (-> Text Error)
(#Failure message))
(def: #export (assume error)
@@ -92,10 +91,10 @@
(macro: #export (default tokens compiler)
{#.doc (doc "Allows you to provide a default value that will be used"
"if a (Error x) value turns out to be #Failure."
- (is? +10
- (default +20 (#Success +10)))
- (is? +20
- (default +20 (#Failure "KABOOM!"))))}
+ (= "foo"
+ (default "foo" (#Success "bar")))
+ (= "foo"
+ (default "foo" (#Failure "KABOOM!"))))}
(case tokens
(^ (list else error))
(#Success [compiler (list (` (case (~ error)
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index 7c6d463b3..834dbcbe9 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -4,19 +4,20 @@
[monoid (#+ Monoid)]
["." fold]
[monad (#+ do Monad)]
- ["." parser (#+ Parser) ("parser/." Functor<Parser>)]
+ ["." parser (#+ Parser) ("parser/." functor)]
["ex" exception (#+ exception:)]
[equivalence (#+ Equivalence)]]
[data
["." error (#+ Error)]
- ["." number
- ["." i64]]
+ [number
+ ["." i64]
+ ["." frac]]
[text
["." encoding]
[format (#+ %n)]]
[collection
["." list]
- ["." row (#+ Row) ("row/." Functor<Row>)]]]
+ ["." row (#+ Row) ("row/." functor)]]]
[type (#+ :share)]
[world
["." binary (#+ Binary)]]])
@@ -52,7 +53,7 @@
Mutation
[0 (function (_ offset data) data)])
-(structure: #export _ (Monoid Mutation)
+(structure: #export monoid (Monoid Mutation)
(def: identity
..no-op)
@@ -98,7 +99,6 @@
(let [[valueS valueT] ((get@ #writer format) value)]
(|> valueS binary.create (valueT 0))))
-## Primitives
(do-template [<name> <size> <read> <write>]
[(def: #export <name>
(Format (I64 Any))
@@ -122,10 +122,9 @@
[bits/64 size/64 binary.read/64 binary.write/64]
)
-## Combinators
(def: #export (or leftB rightB)
(All [l r] (-> (Format l) (Format r) (Format (| l r))))
- {#reader (do parser.Monad<Parser>
+ {#reader (do parser.monad
[flag (get@ #reader bits/8)]
(case flag
0 (:: @ map (|>> #.Left) (get@ #reader leftB))
@@ -213,19 +212,19 @@
(def: #export frac
(Format Frac)
(let [(^slots [#reader #writer]) ..bits/64]
- {#reader (:: parser.Monad<Parser> map number.bits-to-frac reader)
- #writer (|>> number.frac-to-bits writer)}))
+ {#reader (:: parser.monad map frac.bits-to-frac reader)
+ #writer (|>> frac.frac-to-bits writer)}))
(do-template [<name> <bits> <size> <write>]
[(def: #export <name>
(Format Binary)
(let [mask (..mask <size>)]
- {#reader (do parser.Monad<Parser>
+ {#reader (do parser.monad
[size (:coerce (Reader Nat)
## TODO: Remove coercion.
(get@ #reader <bits>))]
(function (_ [offset binary])
- (do error.Monad<Error>
+ (do error.monad
[#let [end (n/+ size offset)]
output (binary.slice offset (.dec end) binary)]
(wrap [[end binary] output]))))
@@ -234,7 +233,7 @@
[(n/+ <size> size)
(function (_ offset binary)
(error.assume
- (do error.Monad<Error>
+ (do error.monad
[_ (<write> offset size binary)]
(binary.copy size 0 value (n/+ <size> offset) binary))))]))}))]
@@ -248,7 +247,7 @@
[(def: #export <name>
(Format Text)
(let [(^open "binary/.") <binary>]
- {#reader (do parser.Monad<Parser>
+ {#reader (do parser.monad
[utf8 binary/reader]
(parser.lift (encoding.from-utf8 utf8)))
#writer (|>> encoding.to-utf8 binary/writer)}))]
@@ -264,7 +263,7 @@
(do-template [<name> <with-offset> <bits> <size> <write>]
[(def: #export (<with-offset> extra-count valueF)
(All [v] (-> Nat (Format v) (Format (Row v))))
- {#reader (do parser.Monad<Parser>
+ {#reader (do parser.monad
[count (|> (get@ #reader <bits>)
## TODO: Remove coercion.
(:coerce (Reader Nat))
@@ -276,11 +275,11 @@
{(Row v)
row.empty})]
(if (n/< count index)
- (do parser.Monad<Parser>
+ (do parser.monad
[value (get@ #reader valueF)]
(recur (.inc index)
(row.add value output)))
- (:: parser.Monad<Parser> wrap output))))
+ (:: parser.monad wrap output))))
#writer (function (_ value)
(let [original-count (row.size value)
capped-count (i64.and (..mask <size>)
@@ -288,17 +287,17 @@
value (if (n/= original-count capped-count)
value
(|> value row.to-list (list.take capped-count) row.from-list))
- (^open "mutation/.") ..Monoid<Mutation>
+ (^open "mutation/.") ..monoid
[size mutation] (|> value
(row/map (get@ #writer valueF))
- (:: row.Fold<Row> fold
+ (:: row.fold fold
(function (_ post pre)
(mutation/compose pre post))
mutation/identity))]
[(n/+ <size> size)
(function (_ offset binary)
(error.assume
- (do error.Monad<Error>
+ (do error.monad
[_ (<write> offset (n/+ extra-count capped-count) binary)]
(wrap (mutation (n/+ <size> offset) binary)))))]))})
diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux
index 715489072..a89675393 100644
--- a/stdlib/source/lux/data/format/context.lux
+++ b/stdlib/source/lux/data/format/context.lux
@@ -22,7 +22,7 @@
(def: #export empty
Context
- (dictionary.new text.Hash<Text>))
+ (dictionary.new text.hash))
(def: #export (property name)
(-> Text (Property Text))
diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux
index 3623a2f5d..4dcd01b05 100644
--- a/stdlib/source/lux/data/format/css.lux
+++ b/stdlib/source/lux/data/format/css.lux
@@ -2,12 +2,13 @@
[lux (#- and)
[data
["." maybe]
- ["." number]
+ [number
+ ["." nat]]
["." text
format
["." encoding (#+ Encoding)]]
[collection
- [list ("list/." Functor<List>)]]]
+ [list ("list/." functor)]]]
[type
abstract]
[world
@@ -27,6 +28,8 @@
Text
+ (def: #export css (-> (CSS Any) Text) (|>> :representation))
+
(def: #export empty (CSS Common) (:abstraction ""))
(def: #export (rule selector style)
@@ -44,8 +47,8 @@
(-> Font (CSS Special))
(let [with-unicode (case (get@ #/font.unicode-range font)
(#.Some unicode-range)
- (let [unicode-range' (format "U+" (:: number.Hex@Codec<Text,Nat> encode (get@ #/font.start unicode-range))
- "-" (:: number.Hex@Codec<Text,Nat> encode (get@ #/font.end unicode-range)))]
+ (let [unicode-range' (format "U+" (:: nat.hex encode (get@ #/font.start unicode-range))
+ "-" (:: nat.hex encode (get@ #/font.end unicode-range)))]
(list ["unicode-range" unicode-range']))
#.None
@@ -104,7 +107,7 @@
(|> css
:representation
(text.split-all-with ..css-separator)
- (list/map (|>> (format (/selector.selector (combinator selector (/selector.tag ""))))))
+ (list/map (|>> (format (/selector.selector (|> selector (combinator (/selector.tag "")))))))
(text.join-with ..css-separator)
:abstraction))
diff --git a/stdlib/source/lux/data/format/css/value.lux b/stdlib/source/lux/data/format/css/value.lux
index 0d1c773be..e9e6ccfbe 100644
--- a/stdlib/source/lux/data/format/css/value.lux
+++ b/stdlib/source/lux/data/format/css/value.lux
@@ -4,11 +4,12 @@
["." color]
["." product]
["." maybe]
- ["." number]
+ [number
+ ["." rev]]
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
[type
abstract]
[macro
@@ -828,7 +829,7 @@
(..apply "rgba" (list (%n red)
(%n green)
(%n blue)
- (if (r/= (:: number.Interval<Rev> top) alpha)
+ (if (r/= (:: rev.interval top) alpha)
"1.0"
(format "0" (%r alpha)))))))
diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux
index 4adb63b7a..73820c6c8 100644
--- a/stdlib/source/lux/data/format/html.lux
+++ b/stdlib/source/lux/data/format/html.lux
@@ -6,15 +6,18 @@
["." text
format]
[collection
- [list ("list/." Functor<List> Fold<List>)]]]
+ [list ("list/." functor fold)]]]
["." function]
[type
abstract]
+ [macro
+ ["." template]]
[world
[net (#+ URL)]]]
[//
- ["." css (#+ CSS)
- ["." selector]]
+ [css
+ ["." selector]
+ ["." style (#+ Style)]]
["." xml (#+ XML)]])
(type: #export Tag selector.Tag)
@@ -93,24 +96,25 @@
[Document Document']
)
- (abstract: #export (Element' brand) {} Any)
- (type: #export Element (HTML (Element' Any)))
+ (do-template [<super> <super-raw> <sub>+]
+ [(abstract: #export (<super-raw> brand) {} Any)
+ (type: #export <super> (HTML (<super-raw> Any)))
- (abstract: #export Content' {} Any)
- (type: #export Content (HTML (Element' Content')))
+ (`` (do-template [<sub> <sub-raw>]
+ [(abstract: #export <sub-raw> {} Any)
+ (type: #export <sub> (HTML (<super-raw> <sub-raw>)))]
- (abstract: #export Image' {} Any)
- (type: #export Image (HTML (Element' Image')))
+ (~~ (template.splice <sub>+))))]
- (abstract: #export (Media' brand) {} Any)
- (type: #export Media (HTML (Media' Any)))
+ [Element Element'
+ [[Content Content']
+ [Image Image']]]
- (abstract: #export Source' {} Any)
- (type: #export Source (HTML (Media' Source')))
+ [Media Media'
+ [[Source Source']
+ [Track Track']]]
+ )
- (abstract: #export Track' {} Any)
- (type: #export Track (HTML (Media' Track')))
-
(def: #export html
(-> Document Text)
(|>> :representation))
@@ -176,8 +180,8 @@
(..simple "base" full)))
(def: #export style
- (-> CSS Meta)
- (..raw "style" (list)))
+ (-> Style Meta)
+ (|>> style.inline (..raw "style" (list))))
(def: #export (script attributes inline)
(-> Attributes (Maybe Script) Meta)
@@ -210,7 +214,7 @@
(def: #export (svg attributes content)
(-> Attributes XML Element)
(|> content
- (:: xml.Codec<Text,XML> encode)
+ (:: xml.codec encode)
(..raw "svg" attributes)))
(type: #export Coord
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index edafe3178..a4aad7c83 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -2,10 +2,10 @@
"For more information, please see: http://www.json.org/")}
[lux #*
[control
- ["." monad (#+ do Monad)]
+ ["." monad (#+ Monad do)]
[equivalence (#+ Equivalence)]
codec
- ["p" parser ("parser/." Monad<Parser>)]
+ ["p" parser ("parser/." monad)]
["ex" exception (#+ exception:)]]
[data
["." bit]
@@ -13,14 +13,15 @@
["." error (#+ Error)]
["." sum]
["." product]
- ["." number ("frac/." Codec<Text,Frac>) ("nat/." Codec<Text,Nat>)]
- ["." text ("text/." Equivalence<Text> Monoid<Text>)
+ [number
+ ["." frac ("frac/." decimal)]]
+ ["." text ("text/." equivalence monoid)
["l" lexer]]
[collection
- ["." list ("list/." Fold<List> Monad<List>)]
- ["." row (#+ Row row) ("row/." Monad<Row>)]
+ ["." list ("list/." fold monad)]
+ ["." row (#+ Row row) ("row/." monad)]
["." dictionary (#+ Dictionary)]]]
- ["." macro (#+ Monad<Meta> with-gensyms)
+ ["." macro (#+ monad with-gensyms)
["s" syntax (#+ syntax:)]
["." code]]])
@@ -61,7 +62,7 @@
(json ["this" "is" "an" "array"])
(json {"this" "is"
"an" "object"}))}
- (let [(^open ".") Monad<Meta>
+ (let [(^open ".") ..monad
wrapper (function (_ x) (` (..json (~ x))))]
(case token
(^template [<ast-tag> <ctor> <json-tag>]
@@ -78,7 +79,7 @@
(wrap (list (` (: JSON (#Array (row (~+ (list/map wrapper members))))))))
[_ (#.Record pairs)]
- (do Monad<Meta>
+ (do ..monad
[pairs' (monad.map @
(function (_ [slot value])
(case slot
@@ -88,7 +89,7 @@
_
(macro.fail "Wrong syntax for JSON object.")))
pairs)]
- (wrap (list (` (: JSON (#Object (dictionary.from-list text.Hash<Text> (list (~+ pairs')))))))))
+ (wrap (list (` (: JSON (#Object (dictionary.from-list text.hash (list (~+ pairs')))))))))
_
(wrap (list token))
@@ -150,7 +151,7 @@
[get-object #Object Object "objects"]
)
-(structure: #export _ (Equivalence JSON)
+(structure: #export equivalence (Equivalence JSON)
(def: (= x y)
(case [x y]
[#Null #Null]
@@ -159,16 +160,16 @@
(^template [<tag> <struct>]
[(<tag> x') (<tag> y')]
(:: <struct> = x' y'))
- ([#Boolean bit.Equivalence<Bit>]
- [#Number number.Equivalence<Frac>]
- [#String text.Equivalence<Text>])
+ ([#Boolean bit.equivalence]
+ [#Number frac.equivalence]
+ [#String text.equivalence])
[(#Array xs) (#Array ys)]
(and (n/= (row.size xs) (row.size ys))
(list/fold (function (_ idx prev)
(and prev
(maybe.default #0
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[x' (row.nth idx xs)
y' (row.nth idx ys)]
(wrap (= x' y'))))))
@@ -203,7 +204,7 @@
[(def: <name> (-> <type> Text) <codec>)]
[show-boolean Boolean encode-boolean]
- [show-number Number (:: number.Codec<Text,Frac> encode)]
+ [show-number Number (:: frac.decimal encode)]
[show-string String text.encode])
(def: (show-array show-json elems)
@@ -281,7 +282,7 @@
[(def: #export <name>
{#.doc (code.text ($_ text/compose "Reads a JSON value as " <desc> "."))}
(Reader <type>)
- (do p.Monad<Parser>
+ (do p.monad
[head any]
(case head
(<tag> value)
@@ -300,7 +301,7 @@
[(def: #export (<test> test)
{#.doc (code.text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))}
(-> <type> (Reader Bit))
- (do p.Monad<Parser>
+ (do p.monad
[head any]
(case head
(<tag> value)
@@ -312,7 +313,7 @@
(def: #export (<check> test)
{#.doc (code.text ($_ text/compose "Ensures a JSON value is a " <desc> "."))}
(-> <type> (Reader Any))
- (do p.Monad<Parser>
+ (do p.monad
[head any]
(case head
(<tag> value)
@@ -323,9 +324,9 @@
_
(fail ($_ text/compose "JSON value is not a " <desc> ".")))))]
- [boolean? boolean! Bit bit.Equivalence<Bit> encode-boolean #Boolean "boolean"]
- [number? number! Frac number.Equivalence<Frac> (:: number.Codec<Text,Frac> encode) #Number "number"]
- [string? string! Text text.Equivalence<Text> text.encode #String "string"]
+ [boolean? boolean! Bit bit.equivalence encode-boolean #Boolean "boolean"]
+ [number? number! Frac frac.equivalence (:: frac.decimal encode) #Number "number"]
+ [string? string! Text text.equivalence text.encode #String "string"]
)
(def: #export (nullable parser)
@@ -336,7 +337,7 @@
(def: #export (array parser)
{#.doc "Parses a JSON array."}
(All [a] (-> (Reader a) (Reader a)))
- (do p.Monad<Parser>
+ (do p.monad
[head any]
(case head
(#Array values)
@@ -358,7 +359,7 @@
(def: #export (object parser)
{#.doc "Parses a JSON object. Use this with the 'field' combinator."}
(All [a] (-> (Reader a) (Reader a)))
- (do p.Monad<Parser>
+ (do p.monad
[head any]
(case head
(#Object kvs)
@@ -398,7 +399,7 @@
(#error.Failure error)
(#error.Failure error))
- (do error.Monad<Error>
+ (do error.monad
[[inputs'' output] (recur inputs')]
(wrap [(list& (#String key) value inputs'')
output])))
@@ -423,14 +424,14 @@
(def: null~
(l.Lexer Null)
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this "null")]
(wrap [])))
(do-template [<name> <token> <value>]
[(def: <name>
(l.Lexer Boolean)
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this <token>)]
(wrap <value>)))]
@@ -444,7 +445,7 @@
(def: number~
(l.Lexer Number)
- (do p.Monad<Parser>
+ (do p.monad
[signed? (l.this? "-")
digits (l.many l.decimal)
decimals (p.default "0"
@@ -486,7 +487,7 @@
(l.Lexer String)
(<| (l.enclosed [text.double-quote text.double-quote])
(loop [_ []])
- (do p.Monad<Parser>
+ (do p.monad
[chars (l.some (l.none-of (text/compose "\" text.double-quote)))
stop l.peek])
(if (text/= "\" stop)
@@ -498,7 +499,7 @@
(def: (kv~ json~)
(-> (-> Any (l.Lexer JSON)) (l.Lexer [String JSON]))
- (do p.Monad<Parser>
+ (do p.monad
[key string~
_ space~
_ (l.this ":")
@@ -509,7 +510,7 @@
(do-template [<name> <type> <open> <close> <elem-parser> <prep>]
[(def: (<name> json~)
(-> (-> Any (l.Lexer JSON)) (l.Lexer <type>))
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this <open>)
_ space~
elems (p.sep-by data-sep <elem-parser>)
@@ -518,13 +519,13 @@
(wrap (<prep> elems))))]
[array~ Array "[" "]" (json~ []) row.from-list]
- [object~ Object "{" "}" (kv~ json~) (dictionary.from-list text.Hash<Text>)]
+ [object~ Object "{" "}" (kv~ json~) (dictionary.from-list text.hash)]
)
(def: (json~' _)
(-> Any (l.Lexer JSON))
($_ p.or null~ boolean~ number~ string~ (array~ json~') (object~ json~')))
-(structure: #export _ (Codec Text JSON)
+(structure: #export codec (Codec Text JSON)
(def: encode show-json)
(def: decode (function (_ input) (l.run input (json~' [])))))
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index e1cbda0db..56d603331 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -4,23 +4,24 @@
monad
[equivalence (#+ Equivalence)]
codec
- ["p" parser ("parser/." Monad<Parser>)]
+ ["p" parser ("parser/." monad)]
["ex" exception (#+ exception:)]]
[data
- ["." number]
["." error (#+ Error)]
["." product]
- ["." name ("name/." Equivalence<Name> Codec<Text,Name>)]
- ["." text ("text/." Equivalence<Text> Monoid<Text>)
+ ["." name ("name/." equivalence codec)]
+ [number
+ ["." int]]
+ ["." text ("text/." equivalence monoid)
["l" lexer]]
[collection
- ["." list ("list/." Monad<List>)]
+ ["." list ("list/." monad)]
["d" dictionary]]]])
(type: #export Tag Name)
(type: #export Attrs (d.Dictionary Name Text))
-(def: #export attrs Attrs (d.new name.Hash<Name>))
+(def: #export attrs Attrs (d.new name.hash))
(type: #export #rec XML
(#Text Text)
@@ -37,14 +38,14 @@
(def: xml-unicode-escape-char^
(l.Lexer Text)
- (|> (do p.Monad<Parser>
+ (|> (do p.monad
[hex? (p.maybe (l.this "x"))
code (case hex?
#.None
- (p.codec number.Codec<Text,Int> (l.many l.decimal))
+ (p.codec int.decimal (l.many l.decimal))
(#.Some _)
- (p.codec number.Hex@Codec<Text,Int> (l.many l.hexadecimal)))]
+ (p.codec int.decimal (l.many l.hexadecimal)))]
(wrap (|> code .nat text.from-code)))
(p.before (l.this ";"))
(p.after (l.this "&#"))))
@@ -61,7 +62,7 @@
(def: xml-identifier
(l.Lexer Text)
- (do p.Monad<Parser>
+ (do p.monad
[head (p.either (l.one-of "_")
l.alpha)
tail (l.some (p.either (l.one-of "_.-")
@@ -70,7 +71,7 @@
(def: namespaced-symbol^
(l.Lexer Name)
- (do p.Monad<Parser>
+ (do p.monad
[first-part xml-identifier
?second-part (<| p.maybe (p.after (l.this ":")) xml-identifier)]
(case ?second-part
@@ -97,7 +98,7 @@
(def: attrs^
(l.Lexer Attrs)
- (<| (:: p.Monad<Parser> map (d.from-list name.Hash<Name>))
+ (<| (:: p.monad map (d.from-list name.hash))
p.some
(p.and (spaced^ attr-name^))
(p.after (l.this "="))
@@ -105,7 +106,7 @@
(def: (close-tag^ expected)
(-> Tag (l.Lexer []))
- (do p.Monad<Parser>
+ (do p.monad
[actual (|> tag^
spaced^
(p.after (l.this "/"))
@@ -149,14 +150,14 @@
(function (_ node^)
(p.either text^
(spaced^
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this "<")
tag (spaced^ tag^)
attrs (spaced^ attrs^)
- #let [no-children^ (do p.Monad<Parser>
+ #let [no-children^ (do p.monad
[_ (l.this "/>")]
(wrap (#Node tag attrs (list))))
- with-children^ (do p.Monad<Parser>
+ with-children^ (do p.monad
[_ (l.this ">")
children (p.some node^)
_ (close-tag^ tag)]
@@ -222,11 +223,11 @@
(text.join-with ""))
"</" tag ">")))))))
-(structure: #export _ (Codec Text XML)
+(structure: #export codec (Codec Text XML)
(def: encode write)
(def: decode read))
-(structure: #export _ (Equivalence XML)
+(structure: #export equivalence (Equivalence XML)
(def: (= reference sample)
(case [reference sample]
[(#Text reference/value) (#Text sample/value)]
@@ -235,7 +236,7 @@
[(#Node reference/tag reference/attrs reference/children)
(#Node sample/tag sample/attrs sample/children)]
(and (name/= reference/tag sample/tag)
- (:: (d.Equivalence<Dictionary> text.Equivalence<Text>) = reference/attrs sample/attrs)
+ (:: (d.equivalence text.equivalence) = reference/attrs sample/attrs)
(n/= (list.size reference/children)
(list.size sample/children))
(|> (list.zip2 reference/children sample/children)
@@ -258,7 +259,7 @@
(exception: #export (unconsumed-inputs {inputs (List XML)})
(|> inputs
- (list/map (:: Codec<Text,XML> encode))
+ (list/map (:: ..codec encode))
(text.join-with blank-line)))
(def: #export text
@@ -337,7 +338,7 @@
(ex.throw unexpected-input [])
(#Node _tag _attrs _children)
- (do error.Monad<Error>
+ (do error.monad
[output (run' _children reader)]
(wrap [tail output]))))))
diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux
index 7a41cb69f..6f1fc60ef 100644
--- a/stdlib/source/lux/data/identity.lux
+++ b/stdlib/source/lux/data/identity.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
[control
- ["F" functor]
- ["A" apply]
+ [functor (#+ Functor)]
+ [apply (#+ Apply)]
["M" monad #*]
["CM" comonad #*]]])
@@ -11,20 +11,20 @@
a)
## [Structures]
-(structure: #export _ (F.Functor Identity)
+(structure: #export functor (Functor Identity)
(def: map id))
-(structure: #export _ (A.Apply Identity)
- (def: functor Functor<Identity>)
+(structure: #export apply (Apply Identity)
+ (def: &functor ..functor)
(def: (apply ff fa)
(ff fa)))
-(structure: #export _ (Monad Identity)
- (def: functor Functor<Identity>)
+(structure: #export monad (Monad Identity)
+ (def: &functor ..functor)
(def: wrap id)
(def: join id))
-(structure: #export _ (CoMonad Identity)
- (def: functor Functor<Identity>)
+(structure: #export comonad (CoMonad Identity)
+ (def: &functor ..functor)
(def: unwrap id)
(def: split id))
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index 66fac2989..c8f5746b1 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -36,16 +36,16 @@
(with-gensyms [g!_]
(wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr))))))))
-(structure: #export _ (Functor Lazy)
+(structure: #export functor (Functor Lazy)
(def: (map f fa)
(freeze (f (thaw fa)))))
-(structure: #export _ (Apply Lazy)
- (def: functor Functor<Lazy>)
+(structure: #export apply (Apply Lazy)
+ (def: &functor ..functor)
(def: (apply ff fa)
(freeze ((thaw ff) (thaw fa)))))
-(structure: #export _ (Monad Lazy)
- (def: functor Functor<Lazy>)
+(structure: #export monad (Monad Lazy)
+ (def: &functor ..functor)
(def: wrap (|>> freeze))
(def: join thaw))
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index d0dfe1886..5b780e999 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -4,30 +4,32 @@
[monoid (#+ Monoid)]
["." functor (#+ Functor)]
[apply (#+ Apply)]
- ["." monad (#+ do Monad)]
+ ["." monad (#+ Monad do)]
[equivalence (#+ Equivalence)]]])
-## [Types]
## (type: (Maybe a)
## #.None
## (#.Some a))
-## [Structures]
-(structure: #export Monoid<Maybe> (All [a] (Monoid (Maybe a)))
+(structure: #export monoid (All [a] (Monoid (Maybe a)))
(def: identity #.None)
- (def: (compose xs ys)
- (case xs
- #.None ys
- (#.Some x) (#.Some x))))
+
+ (def: (compose mx my)
+ (case mx
+ #.None
+ my
+
+ (#.Some x)
+ (#.Some x))))
-(structure: #export _ (Functor Maybe)
+(structure: #export functor (Functor Maybe)
(def: (map f ma)
(case ma
#.None #.None
(#.Some a) (#.Some (f a)))))
-(structure: #export _ (Apply Maybe)
- (def: functor Functor<Maybe>)
+(structure: #export apply (Apply Maybe)
+ (def: &functor ..functor)
(def: (apply ff fa)
(case [ff fa]
@@ -37,38 +39,41 @@
_
#.None)))
-(structure: #export _ (Monad Maybe)
- (def: functor Functor<Maybe>)
+(structure: #export monad (Monad Maybe)
+ (def: &functor ..functor)
(def: (wrap x)
(#.Some x))
(def: (join mma)
(case mma
- #.None #.None
- (#.Some xs) xs)))
+ #.None
+ #.None
+
+ (#.Some mx)
+ mx)))
-(structure: #export (Equivalence<Maybe> Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Maybe a))))
+(structure: #export (equivalence a-equivalence) (All [a] (-> (Equivalence a) (Equivalence (Maybe a))))
(def: (= mx my)
(case [mx my]
[#.None #.None]
#1
[(#.Some x) (#.Some y)]
- (:: Equivalence<a> = x y)
+ (:: a-equivalence = x y)
_
#0)))
-(structure: #export (MaybeT Monad<M>)
+(structure: #export (with-maybe monad)
(All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
- (def: functor (functor.compose (get@ #monad.functor Monad<M>) Functor<Maybe>))
+ (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
- (def: wrap (|>> (:: Monad<Maybe> wrap) (:: Monad<M> wrap)))
+ (def: wrap (|>> (:: ..monad wrap) (:: monad wrap)))
(def: (join MmMma)
- (do Monad<M>
+ (do monad
[mMma MmMma]
(case mMma
#.None
@@ -77,9 +82,9 @@
(#.Some Mma)
Mma))))
-(def: #export (lift Monad<M>)
+(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
- (monad.lift Monad<M> (:: Monad<Maybe> wrap)))
+ (monad.lift monad (:: ..monad wrap)))
(macro: #export (default tokens state)
{#.doc (doc "Allows you to provide a default value that will be used"
diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux
index 0129bc5cc..5ecea23ba 100644
--- a/stdlib/source/lux/data/name.lux
+++ b/stdlib/source/lux/data/name.lux
@@ -5,7 +5,7 @@
[codec (#+ Codec)]
hash]
[data
- ["." text ("text/." Monoid<Text> Hash<Text>)]]])
+ ["." text ("text/." monoid hash)]]])
## [Types]
## (type: Name
@@ -22,12 +22,12 @@
)
## [Structures]
-(structure: #export _ (Equivalence Name)
+(structure: #export equivalence (Equivalence Name)
(def: (= [xmodule xname] [ymodule yname])
(and (text/= xmodule ymodule)
(text/= xname yname))))
-(structure: #export _ (Codec Text Name)
+(structure: #export codec (Codec Text Name)
(def: (encode [module short])
(case module
"" short
@@ -46,8 +46,8 @@
_
(#.Left (text/compose "Invalid format for Name: " input))))))
-(structure: #export _ (Hash Name)
- (def: eq Equivalence<Name>)
+(structure: #export hash (Hash Name)
+ (def: &equivalence ..equivalence)
(def: (hash [module name])
(n/+ (text/hash module) (text/hash name))))
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index f297f2788..9e658bd52 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -1,670 +1,15 @@
-(.module: {#.doc "Implementations of common structures for Lux's primitive number types."}
+(.module:
[lux #*
[control
- number
- [monoid (#+ Monoid)]
- [equivalence (#+ Equivalence)]
- hash
- ["." order (#+ Order)]
- enum
- interval
[codec (#+ Codec)]]
[data
["." error (#+ Error)]
- ["." maybe]
- ["." text (#+ Char)]
- [collection
- ["." array (#+ Array)]]]
- ["." function]
- ["." math]]
+ ["." text]]]
[/
- ["." i64]])
-
-(do-template [<type> <test>]
- [(structure: #export _ (Equivalence <type>)
- (def: = <test>))]
-
- [ Nat n/=]
- [ Int i/=]
- [ Rev r/=]
- [Frac f/=]
- )
-
-(do-template [<type> <eq> <lt> <lte> <gt> <gte>]
- [(structure: #export _ (Order <type>)
- (def: eq <eq>)
- (def: < <lt>)
- (def: <= <lte>)
- (def: > <gt>)
- (def: >= <gte>))]
-
- [ Nat Equivalence<Nat> n/< n/<= n/> n/>=]
- [ Int Equivalence<Int> i/< i/<= i/> i/>=]
- [Rev Equivalence<Rev> r/< r/<= r/> r/>=]
- [Frac Equivalence<Frac> f/< f/<= f/> f/>=]
- )
-
-(do-template [<type> <order> <succ> <pred>]
- [(structure: #export _ (Enum <type>)
- (def: order <order>)
- (def: succ <succ>)
- (def: pred <pred>))]
-
- [Nat Order<Nat> inc dec]
- [Int Order<Int> inc dec]
- [Frac Order<Frac> (f/+ ("lux frac smallest")) (f/- ("lux frac smallest"))]
- [Rev Order<Rev> inc dec]
- )
-
-(do-template [<type> <enum> <top> <bottom>]
- [(structure: #export _ (Interval <type>)
- (def: enum <enum>)
- (def: top <top>)
- (def: bottom <bottom>))]
-
- [ Nat Enum<Nat> (:coerce Nat -1) 0]
- [ Int Enum<Int> +9_223_372_036_854_775_807 -9_223_372_036_854_775_808]
- [Frac Enum<Frac> ("lux frac max") ("lux frac min")]
- [ Rev Enum<Rev> (:coerce Rev -1) (:coerce Rev 0)]
- )
-
-(structure: #export _ (Number Nat)
- (def: + n/+)
- (def: - n/-)
- (def: * n/*)
- (def: / n//)
- (def: % n/%)
- (def: (negate value) (n/- (:: Interval<Nat> top) value))
- (def: abs function.identity)
- (def: (signum x)
- (case x
- 0 0
- _ 1))
- )
-
-(do-template [<type> <order> <+> <-> <*> </> <%> <=> <<> <0> <1> <-1>]
- [(structure: #export _ (Number <type>)
- (def: + <+>)
- (def: - <->)
- (def: * <*>)
- (def: / </>)
- (def: % <%>)
- (def: negate (<*> <-1>))
- (def: (abs x)
- (if (<<> <0> x)
- (<*> <-1> x)
- x))
- (def: (signum x)
- (cond (<=> <0> x) <0>
- (<<> <0> x) <-1>
- ## else
- <1>))
- )]
-
- [ Int Order<Int> i/+ i/- i/* i// i/% i/= i/< +0 +1 -1]
- [Frac Order<Frac> f/+ f/- f/* f// f/% f/= f/< +0.0 +1.0 -1.0]
- )
-
-(structure: #export _ (Number Rev)
- (def: + r/+)
- (def: - r/-)
- (def: * r/*)
- (def: / r//)
- (def: % r/%)
- (def: (negate x) (r/- x (:coerce Rev -1)))
- (def: abs function.identity)
- (def: (signum x)
- (:coerce Rev -1)))
-
-(do-template [<name> <type> <identity> <compose>]
- [(structure: #export <name> (Monoid <type>)
- (def: identity <identity>)
- (def: compose <compose>))]
-
- [ Add@Monoid<Nat> Nat 0 n/+]
- [ Mul@Monoid<Nat> Nat 1 n/*]
- [ Max@Monoid<Nat> Nat (:: Interval<Nat> bottom) n/max]
- [ Min@Monoid<Nat> Nat (:: Interval<Nat> top) n/min]
- [ Add@Monoid<Int> Int +0 i/+]
- [ Mul@Monoid<Int> Int +1 i/*]
- [ Max@Monoid<Int> Int (:: Interval<Int> bottom) i/max]
- [ Min@Monoid<Int> Int (:: Interval<Int> top) i/min]
- [Add@Monoid<Frac> Frac +0.0 f/+]
- [Mul@Monoid<Frac> Frac +1.0 f/*]
- [Max@Monoid<Frac> Frac (:: Interval<Frac> bottom) f/max]
- [Min@Monoid<Frac> Frac (:: Interval<Frac> top) f/min]
- [ Add@Monoid<Rev> Rev (:: Interval<Rev> bottom) r/+]
- [ Mul@Monoid<Rev> Rev (:: Interval<Rev> top) r/*]
- [ Max@Monoid<Rev> Rev (:: Interval<Rev> bottom) r/max]
- [ Min@Monoid<Rev> Rev (:: Interval<Rev> top) r/min]
- )
-
-(do-template [<name> <numerator> <doc>]
- [(def: #export <name>
- {#.doc <doc>}
- Frac
- (f// +0.0 <numerator>))]
-
- [not-a-number +0.0 "Not a number."]
- [positive-infinity +1.0 "Positive infinity."]
- [negative-infinity -1.0 "Negative infinity."]
- )
-
-(def: #export (not-a-number? number)
- {#.doc "Tests whether a frac is actually not-a-number."}
- (-> Frac Bit)
- (not (f/= number number)))
-
-(def: #export (frac? value)
- (-> Frac Bit)
- (not (or (not-a-number? value)
- (f/= positive-infinity value)
- (f/= negative-infinity value))))
-
-(do-template [<type> <encoder> <decoder> <error>]
- [(structure: #export _ (Codec Text <type>)
- (def: (encode x)
- (<encoder> [x]))
-
- (def: (decode input)
- (case (<decoder> [input])
- (#.Some value)
- (#error.Success value)
-
- #.None
- (#error.Failure <error>))))]
-
- [Frac "lux frac encode" "lux frac decode" "Could not decode Frac"]
- )
-
-(def: (get-char! full idx)
- (-> Text Nat Char)
- ("lux text char" full idx))
-
-(def: (binary-character value)
- (-> Nat (Maybe Text))
- (case value
- 0 (#.Some "0")
- 1 (#.Some "1")
- _ #.None))
-
-(def: (binary-value digit)
- (-> Char (Maybe Nat))
- (case digit
- (^ (char "0")) (#.Some 0)
- (^ (char "1")) (#.Some 1)
- _ #.None))
-
-(def: (octal-character value)
- (-> Nat (Maybe Text))
- (case value
- 0 (#.Some "0")
- 1 (#.Some "1")
- 2 (#.Some "2")
- 3 (#.Some "3")
- 4 (#.Some "4")
- 5 (#.Some "5")
- 6 (#.Some "6")
- 7 (#.Some "7")
- _ #.None))
-
-(def: (octal-value digit)
- (-> Char (Maybe Nat))
- (case digit
- (^ (char "0")) (#.Some 0)
- (^ (char "1")) (#.Some 1)
- (^ (char "2")) (#.Some 2)
- (^ (char "3")) (#.Some 3)
- (^ (char "4")) (#.Some 4)
- (^ (char "5")) (#.Some 5)
- (^ (char "6")) (#.Some 6)
- (^ (char "7")) (#.Some 7)
- _ #.None))
-
-(def: (decimal-character value)
- (-> Nat (Maybe Text))
- (case value
- 0 (#.Some "0")
- 1 (#.Some "1")
- 2 (#.Some "2")
- 3 (#.Some "3")
- 4 (#.Some "4")
- 5 (#.Some "5")
- 6 (#.Some "6")
- 7 (#.Some "7")
- 8 (#.Some "8")
- 9 (#.Some "9")
- _ #.None))
-
-(def: (decimal-value digit)
- (-> Char (Maybe Nat))
- (case digit
- (^ (char "0")) (#.Some 0)
- (^ (char "1")) (#.Some 1)
- (^ (char "2")) (#.Some 2)
- (^ (char "3")) (#.Some 3)
- (^ (char "4")) (#.Some 4)
- (^ (char "5")) (#.Some 5)
- (^ (char "6")) (#.Some 6)
- (^ (char "7")) (#.Some 7)
- (^ (char "8")) (#.Some 8)
- (^ (char "9")) (#.Some 9)
- _ #.None))
-
-(def: (hexadecimal-character value)
- (-> Nat (Maybe Text))
- (case value
- 0 (#.Some "0")
- 1 (#.Some "1")
- 2 (#.Some "2")
- 3 (#.Some "3")
- 4 (#.Some "4")
- 5 (#.Some "5")
- 6 (#.Some "6")
- 7 (#.Some "7")
- 8 (#.Some "8")
- 9 (#.Some "9")
- 10 (#.Some "A")
- 11 (#.Some "B")
- 12 (#.Some "C")
- 13 (#.Some "D")
- 14 (#.Some "E")
- 15 (#.Some "F")
- _ #.None))
-
-(def: (hexadecimal-value digit)
- (-> Char (Maybe Nat))
- (case digit
- (^ (char "0")) (#.Some 0)
- (^ (char "1")) (#.Some 1)
- (^ (char "2")) (#.Some 2)
- (^ (char "3")) (#.Some 3)
- (^ (char "4")) (#.Some 4)
- (^ (char "5")) (#.Some 5)
- (^ (char "6")) (#.Some 6)
- (^ (char "7")) (#.Some 7)
- (^ (char "8")) (#.Some 8)
- (^ (char "9")) (#.Some 9)
- (^or (^ (char "a")) (^ (char "A"))) (#.Some 10)
- (^or (^ (char "b")) (^ (char "B"))) (#.Some 11)
- (^or (^ (char "c")) (^ (char "C"))) (#.Some 12)
- (^or (^ (char "d")) (^ (char "D"))) (#.Some 13)
- (^or (^ (char "e")) (^ (char "E"))) (#.Some 14)
- (^or (^ (char "f")) (^ (char "F"))) (#.Some 15)
- _ #.None))
-
-(do-template [<struct> <base> <to-character> <to-value> <error>]
- [(structure: #export <struct> (Codec Text Nat)
- (def: (encode value)
- (loop [input value
- output ""]
- (let [digit (maybe.assume (<to-character> (n/% <base> input)))
- output' ("lux text concat" digit output)
- input' (n// <base> input)]
- (if (n/= 0 input')
- output'
- (recur input' output')))))
-
- (def: (decode repr)
- (let [input-size ("lux text size" repr)]
- (if (n/> 0 input-size)
- (loop [idx 0
- output 0]
- (if (n/< input-size idx)
- (case (<to-value> (get-char! repr idx))
- #.None
- (#error.Failure ("lux text concat" <error> repr))
-
- (#.Some digit-value)
- (recur (inc idx)
- (|> output (n/* <base>) (n/+ digit-value))))
- (#error.Success output)))
- (#error.Failure ("lux text concat" <error> repr))))))]
-
- [Binary@Codec<Text,Nat> 2 binary-character binary-value "Invalid binary syntax for Nat: "]
- [Octal@Codec<Text,Nat> 8 octal-character octal-value "Invalid octal syntax for Nat: "]
- [_ 10 decimal-character decimal-value "Invalid syntax for Nat: "]
- [Hex@Codec<Text,Nat> 16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
- )
-
-(def: (int/sign!! value)
- (-> Int Text)
- (if (i/< +0 value)
- "-"
- "+"))
-
-(def: (int/sign?? representation)
- (-> Text (Maybe Int))
- (case (get-char! representation 0)
- (^ (char "-"))
- (#.Some -1)
-
- (^ (char "+"))
- (#.Some +1)
-
- _
- #.None))
-
-(def: (int-decode-loop input-size repr sign <base> <to-value> <error>)
- (-> Nat Text Int Int (-> Char (Maybe Nat)) Text (Error Int))
- (loop [idx 1
- output +0]
- (if (n/< input-size idx)
- (case (<to-value> (get-char! repr idx))
- #.None
- (#error.Failure <error>)
-
- (#.Some digit-value)
- (recur (inc idx)
- (|> output (i/* <base>) (i/+ (.int digit-value)))))
- (#error.Success (i/* sign output)))))
-
-(do-template [<struct> <base> <to-character> <to-value> <error>]
- [(structure: #export <struct> (Codec Text Int)
- (def: (encode value)
- (if (i/= +0 value)
- "+0"
- (loop [input (|> value (i// <base>) (:: Number<Int> abs))
- output (|> value (i/% <base>) (:: Number<Int> abs) .nat
- <to-character>
- maybe.assume)]
- (if (i/= +0 input)
- ("lux text concat" (int/sign!! value) output)
- (let [digit (maybe.assume (<to-character> (.nat (i/% <base> input))))]
- (recur (i// <base> input)
- ("lux text concat" digit output)))))))
-
- (def: (decode repr)
- (let [input-size ("lux text size" repr)]
- (if (n/> 1 input-size)
- (case (int/sign?? repr)
- (#.Some sign)
- (int-decode-loop input-size repr sign <base> <to-value> <error>)
-
- #.None
- (#error.Failure <error>))
- (#error.Failure <error>)))))]
-
- [Binary@Codec<Text,Int> +2 binary-character binary-value "Invalid binary syntax for Int: "]
- [Octal@Codec<Text,Int> +8 octal-character octal-value "Invalid octal syntax for Int: "]
- [_ +10 decimal-character decimal-value "Invalid syntax for Int: "]
- [Hex@Codec<Text,Int> +16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Int: "]
- )
-
-(def: (de-prefix input)
- (-> Text Text)
- ("lux text clip" input 1 ("lux text size" input)))
-
-(do-template [<struct> <nat> <char-bit-size> <error>]
- [(with-expansions [<error-output> (as-is (#error.Failure ("lux text concat" <error> repr)))]
- (structure: #export <struct> (Codec Text Rev)
- (def: (encode value)
- (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value)))
- max-num-chars (n// <char-bit-size> 64)
- raw-size ("lux text size" raw-output)
- zero-padding (loop [zeroes-left (n/- raw-size max-num-chars)
- output ""]
- (if (n/= 0 zeroes-left)
- output
- (recur (dec zeroes-left)
- ("lux text concat" "0" output))))
- padded-output ("lux text concat" zero-padding raw-output)]
- ("lux text concat" "." padded-output)))
-
- (def: (decode repr)
- (let [repr-size ("lux text size" repr)]
- (if (n/>= 2 repr-size)
- (case ("lux text char" repr 0)
- (^ (char "."))
- (case (:: <nat> decode (de-prefix repr))
- (#error.Success output)
- (#error.Success (:coerce Rev output))
-
- _
- <error-output>)
-
- _
- <error-output>)
- <error-output>)))))]
-
- [Binary@Codec<Text,Rev> Binary@Codec<Text,Nat> 1 "Invalid binary syntax: "]
- [Octal@Codec<Text,Rev> Octal@Codec<Text,Nat> 3 "Invalid octal syntax: "]
- [Hex@Codec<Text,Rev> Hex@Codec<Text,Nat> 4 "Invalid hexadecimal syntax: "]
- )
-
-(do-template [<struct> <int> <base> <char-set> <error>]
- [(structure: #export <struct> (Codec Text Frac)
- (def: (encode value)
- (let [whole (frac-to-int value)
- whole-part (:: <int> encode whole)
- decimal (:: Number<Frac> abs (f/% +1.0 value))
- decimal-part (if (f/= +0.0 decimal)
- ".0"
- (loop [dec-left decimal
- output ""]
- (if (f/= +0.0 dec-left)
- ("lux text concat" "." output)
- (let [shifted (f/* <base> dec-left)
- digit-idx (|> shifted (f/% <base>) frac-to-int .nat)]
- (recur (f/% +1.0 shifted)
- ("lux text concat" output ("lux text clip" <char-set> digit-idx (inc digit-idx))))))))]
- ("lux text concat" whole-part decimal-part)))
-
- (def: (decode repr)
- (case ("lux text index" repr "." 0)
- (#.Some split-index)
- (let [whole-part ("lux text clip" repr 0 split-index)
- decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))]
- (case [(:: <int> decode whole-part)
- (:: <int> decode decimal-part)]
- (^multi [(#error.Success whole) (#error.Success decimal)]
- (i/>= +0 decimal))
- (let [sign (if (i/< +0 whole)
- -1.0
- +1.0)
- div-power (loop [muls-left ("lux text size" decimal-part)
- output +1.0]
- (if (n/= 0 muls-left)
- output
- (recur (dec muls-left)
- (f/* <base> output))))
- adjusted-decimal (|> decimal int-to-frac (f// div-power))
- dec-rev (case (:: Hex@Codec<Text,Rev> decode ("lux text concat" "." decimal-part))
- (#error.Success dec-rev)
- dec-rev
-
- (#error.Failure error)
- (error! error))]
- (#error.Success (f/+ (int-to-frac whole)
- (f/* sign adjusted-decimal))))
-
- _
- (#error.Failure ("lux text concat" <error> repr))))
-
- _
- (#error.Failure ("lux text concat" <error> repr)))))]
-
- [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> +2.0 "01" "Invalid binary syntax: "]
- )
-
-(def: (segment-digits chunk-size digits)
- (-> Nat Text (List Text))
- (case digits
- ""
- (list)
-
- _
- (let [num-digits ("lux text size" digits)]
- (if (n/<= chunk-size num-digits)
- (list digits)
- (let [boundary (n/- chunk-size num-digits)
- chunk ("lux text clip" digits boundary num-digits)
- remaining ("lux text clip" digits 0 boundary)]
- (list& chunk (segment-digits chunk-size remaining)))))))
-
-(def: (bin-segment-to-hex input)
- (-> Text Text)
- (case input
- "0000" "0"
- "0001" "1"
- "0010" "2"
- "0011" "3"
- "0100" "4"
- "0101" "5"
- "0110" "6"
- "0111" "7"
- "1000" "8"
- "1001" "9"
- "1010" "A"
- "1011" "B"
- "1100" "C"
- "1101" "D"
- "1110" "E"
- "1111" "F"
- _ (undefined)))
-
-(def: (hex-segment-to-bin input)
- (-> Text Text)
- (case input
- "0" "0000"
- "1" "0001"
- "2" "0010"
- "3" "0011"
- "4" "0100"
- "5" "0101"
- "6" "0110"
- "7" "0111"
- "8" "1000"
- "9" "1001"
- (^or "a" "A") "1010"
- (^or "b" "B") "1011"
- (^or "c" "C") "1100"
- (^or "d" "D") "1101"
- (^or "e" "E") "1110"
- (^or "f" "F") "1111"
- _ (undefined)))
-
-(def: (bin-segment-to-octal input)
- (-> Text Text)
- (case input
- "000" "0"
- "001" "1"
- "010" "2"
- "011" "3"
- "100" "4"
- "101" "5"
- "110" "6"
- "111" "7"
- _ (undefined)))
-
-(def: (octal-segment-to-bin input)
- (-> Text Text)
- (case input
- "0" "000"
- "1" "001"
- "2" "010"
- "3" "011"
- "4" "100"
- "5" "101"
- "6" "110"
- "7" "111"
- _ (undefined)))
-
-(def: (map f xs)
- (All [a b] (-> (-> a b) (List a) (List b)))
- (case xs
- #.Nil
- #.Nil
-
- (#.Cons x xs')
- (#.Cons (f x) (map f xs'))))
-
-(def: (re-join-chunks xs)
- (-> (List Text) Text)
- (case xs
- #.Nil
- ""
-
- (#.Cons x xs')
- ("lux text concat" x (re-join-chunks xs'))))
-
-(do-template [<from> <from-translator> <to> <to-translator> <base-bits>]
- [(def: (<from> on-left? input)
- (-> Bit Text Text)
- (let [max-num-chars (n// <base-bits> 64)
- input-size ("lux text size" input)
- zero-padding (let [num-digits-that-need-padding (n/% <base-bits> input-size)]
- (if (n/= 0 num-digits-that-need-padding)
- ""
- (loop [zeroes-left (n/- num-digits-that-need-padding
- <base-bits>)
- output ""]
- (if (n/= 0 zeroes-left)
- output
- (recur (dec zeroes-left)
- ("lux text concat" "0" output))))))
- padded-input (if on-left?
- ("lux text concat" zero-padding input)
- ("lux text concat" input zero-padding))]
- (|> padded-input
- (segment-digits <base-bits>)
- (map <from-translator>)
- re-join-chunks)))
-
- (def: <to>
- (-> Text Text)
- (|>> (segment-digits 1)
- (map <to-translator>)
- re-join-chunks))]
-
- [binary-to-hex bin-segment-to-hex hex-to-binary hex-segment-to-bin 4]
- [binary-to-octal bin-segment-to-octal octal-to-binary octal-segment-to-bin 3]
- )
-
-(do-template [<struct> <error> <from> <to>]
- [(structure: #export <struct> (Codec Text Frac)
- (def: (encode value)
- (let [sign (:: Number<Frac> signum value)
- raw-bin (:: Binary@Codec<Text,Frac> encode value)
- dot-idx (maybe.assume ("lux text index" raw-bin "." 0))
- whole-part ("lux text clip" raw-bin
- (if (f/= -1.0 sign) 1 0)
- dot-idx)
- decimal-part ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin))
- hex-output (|> (<from> #0 decimal-part)
- ("lux text concat" ".")
- ("lux text concat" (<from> #1 whole-part))
- ("lux text concat" (if (f/= -1.0 sign) "-" "")))]
- hex-output))
-
- (def: (decode repr)
- (let [sign (case ("lux text index" repr "-" 0)
- (#.Some 0)
- -1.0
-
- _
- +1.0)]
- (case ("lux text index" repr "." 0)
- (#.Some split-index)
- (let [whole-part ("lux text clip" repr 1 split-index)
- decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))
- as-binary (|> (<to> decimal-part)
- ("lux text concat" ".")
- ("lux text concat" (<to> whole-part))
- ("lux text concat" (if (f/= -1.0 sign) "-" "+")))]
- (case (:: Binary@Codec<Text,Frac> decode as-binary)
- (#error.Failure _)
- (#error.Failure ("lux text concat" <error> repr))
-
- output
- output))
-
- _
- (#error.Failure ("lux text concat" <error> repr))))))]
-
- [Octal@Codec<Text,Frac> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary]
- [Hex@Codec<Text,Frac> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary]
- )
+ ["/." nat]
+ ["/." int]
+ ["/." rev]
+ ["/." frac]])
(macro: (encoding-doc tokens state)
(case tokens
@@ -725,301 +70,13 @@
_
(#error.Failure <error>)))]
- [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Rev> Binary@Codec<Text,Frac>
+ [bin /nat.binary /int.binary /rev.binary /frac.binary
"Invalid binary syntax."
(encoding-doc "binary" (bin "+11001001") (bin "+11_00_10_01"))]
- [oct Octal@Codec<Text,Nat> Octal@Codec<Text,Int> Octal@Codec<Text,Rev> Octal@Codec<Text,Frac>
+ [oct /nat.octal /int.octal /rev.octal /frac.octal
"Invalid octal syntax."
(encoding-doc "octal" (oct "+615243") (oct "+615_243"))]
- [hex Hex@Codec<Text,Nat> Hex@Codec<Text,Int> Hex@Codec<Text,Rev> Hex@Codec<Text,Frac>
+ [hex /nat.hex /int.hex /rev.hex /frac.hex
"Invalid hexadecimal syntax."
(encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead_BEEF"))]
)
-
-## The following code allows one to encode/decode Rev numbers as text.
-## This is not a simple algorithm, and it requires subverting the Rev
-## abstraction a bit.
-## It takes into account the fact that Rev numbers are represented by
-## Lux as 64-bit integers.
-## A valid way to model them is as Lux's Nat type.
-## This is a somewhat hackish way to do things, but it allows one to
-## write the encoding/decoding algorithm once, in pure Lux, rather
-## than having to implement it on the compiler for every platform
-## targeted by Lux.
-(type: Digits (Array Nat))
-
-(def: (make-digits _)
- (-> Any Digits)
- (array.new i64.width))
-
-(def: (digits-get idx digits)
- (-> Nat Digits Nat)
- (|> digits (array.read idx) (maybe.default 0)))
-
-(def: digits-put
- (-> Nat Nat Digits Digits)
- array.write)
-
-(def: (prepend left right)
- (-> Text Text Text)
- ("lux text concat" left right))
-
-(def: (digits-times-5! idx output)
- (-> Nat Digits Digits)
- (loop [idx idx
- carry 0
- output output]
- (if (i/>= +0 (:coerce Int idx))
- (let [raw (|> (digits-get idx output)
- (n/* 5)
- (n/+ carry))]
- (recur (dec idx)
- (n// 10 raw)
- (digits-put idx (n/% 10 raw) output)))
- output)))
-
-(def: (digits-power power)
- (-> Nat Digits)
- (loop [times power
- output (|> (make-digits [])
- (digits-put power 1))]
- (if (i/>= +0 (:coerce Int times))
- (recur (dec times)
- (digits-times-5! power output))
- output)))
-
-(def: (digits-to-text digits)
- (-> Digits Text)
- (loop [idx (dec i64.width)
- all-zeroes? #1
- output ""]
- (if (i/>= +0 (:coerce Int idx))
- (let [digit (digits-get idx digits)]
- (if (and (n/= 0 digit)
- all-zeroes?)
- (recur (dec idx) #1 output)
- (recur (dec idx)
- #0
- ("lux text concat"
- (:: Codec<Text,Int> encode (:coerce Int digit))
- output))))
- (if all-zeroes?
- "0"
- output))))
-
-(def: (digits-add param subject)
- (-> Digits Digits Digits)
- (loop [idx (dec i64.width)
- carry 0
- output (make-digits [])]
- (if (i/>= +0 (:coerce Int idx))
- (let [raw ($_ n/+
- carry
- (digits-get idx param)
- (digits-get idx subject))]
- (recur (dec idx)
- (n// 10 raw)
- (digits-put idx (n/% 10 raw) output)))
- output)))
-
-(def: (text-to-digits input)
- (-> Text (Maybe Digits))
- (let [length ("lux text size" input)]
- (if (n/<= i64.width length)
- (loop [idx 0
- output (make-digits [])]
- (if (n/< length idx)
- (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0)
- #.None
- #.None
-
- (#.Some digit)
- (recur (inc idx)
- (digits-put idx digit output)))
- (#.Some output)))
- #.None)))
-
-(def: (digits-lt param subject)
- (-> Digits Digits Bit)
- (loop [idx 0]
- (and (n/< i64.width idx)
- (let [pd (digits-get idx param)
- sd (digits-get idx subject)]
- (if (n/= pd sd)
- (recur (inc idx))
- (n/< pd sd))))))
-
-(def: (digits-sub-once! idx param subject)
- (-> Nat Nat Digits Digits)
- (let [sd (digits-get idx subject)]
- (if (n/>= param sd)
- (digits-put idx (n/- param sd) subject)
- (let [diff (|> sd
- (n/+ 10)
- (n/- param))]
- (|> subject
- (digits-put idx diff)
- (digits-sub-once! (dec idx) 1))))))
-
-(def: (digits-sub! param subject)
- (-> Digits Digits Digits)
- (loop [idx (dec i64.width)
- output subject]
- (if (i/>= +0 (.int idx))
- (recur (dec idx)
- (digits-sub-once! idx (digits-get idx param) output))
- output)))
-
-(structure: #export _ (Codec Text Rev)
- (def: (encode input)
- (let [input (:coerce Nat input)
- last-idx (dec i64.width)]
- (if (n/= 0 input)
- ".0"
- (loop [idx last-idx
- digits (make-digits [])]
- (if (i/>= +0 (:coerce Int idx))
- (if (i64.set? idx input)
- (let [digits' (digits-add (digits-power (n/- idx last-idx))
- digits)]
- (recur (dec idx)
- digits'))
- (recur (dec idx)
- digits))
- ("lux text concat" "." (digits-to-text digits))
- )))))
-
- (def: (decode input)
- (let [length ("lux text size" input)
- dotted? (case ("lux text index" input "." 0)
- (#.Some 0)
- #1
-
- _
- #0)]
- (if (and dotted?
- (n/<= (inc i64.width) length))
- (case (text-to-digits ("lux text clip" input 1 length))
- (#.Some digits)
- (loop [digits digits
- idx 0
- output 0]
- (if (n/< i64.width idx)
- (let [power (digits-power idx)]
- (if (digits-lt power digits)
- ## Skip power
- (recur digits (inc idx) output)
- (recur (digits-sub! power digits)
- (inc idx)
- (i64.set (n/- idx (dec i64.width)) output))))
- (#error.Success (:coerce Rev output))))
-
- #.None
- (#error.Failure ("lux text concat" "Wrong syntax for Rev: " input)))
- (#error.Failure ("lux text concat" "Wrong syntax for Rev: " input))))
- ))
-
-(def: (log2 input)
- (-> Frac Frac)
- (f// (math.log +2.0)
- (math.log input)))
-
-(def: double-bias Nat 1023)
-
-(def: mantissa-size Nat 52)
-(def: exponent-size Nat 11)
-
-(def: #export (frac-to-bits input)
- (-> Frac I64)
- (i64 (cond (not-a-number? input)
- (hex "7FF7FFFFFFFFFFFF")
-
- (f/= positive-infinity input)
- (hex "7FF0000000000000")
-
- (f/= negative-infinity input)
- (hex "FFF0000000000000")
-
- (f/= +0.0 input)
- (let [reciprocal (f// input +1.0)]
- (if (f/= positive-infinity reciprocal)
- ## Positive zero
- (hex "0000000000000000")
- ## Negative zero
- (hex "8000000000000000")))
-
- ## else
- (let [sign (:: Number<Frac> signum input)
- input (:: Number<Frac> abs input)
- exponent (math.floor (log2 input))
- exponent-mask (|> 1 (i64.left-shift exponent-size) dec)
- mantissa (|> input
- ## Normalize
- (f// (math.pow exponent +2.0))
- ## Make it int-equivalent
- (f/* (math.pow +52.0 +2.0)))
- sign-bit (if (f/= -1.0 sign) 1 0)
- exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (i64.and exponent-mask))
- mantissa-bits (|> mantissa frac-to-int .nat)]
- ($_ i64.or
- (i64.left-shift 63 sign-bit)
- (i64.left-shift mantissa-size exponent-bits)
- (i64.clear mantissa-size mantissa-bits)))
- )))
-
-(do-template [<getter> <mask> <size> <offset>]
- [(def: <mask> (|> 1 (i64.left-shift <size>) dec (i64.left-shift <offset>)))
- (def: (<getter> input)
- (-> (I64 Any) I64)
- (|> input (i64.and <mask>) (i64.logical-right-shift <offset>) i64))]
-
- [mantissa mantissa-mask mantissa-size 0]
- [exponent exponent-mask exponent-size mantissa-size]
- [sign sign-mask 1 (n/+ exponent-size mantissa-size)]
- )
-
-(def: #export (bits-to-frac input)
- (-> (I64 Any) Frac)
- (let [S (sign input)
- E (exponent input)
- M (mantissa input)]
- (cond (n/= (hex "7FF") E)
- (if (n/= 0 M)
- (if (n/= 0 S)
- positive-infinity
- negative-infinity)
- not-a-number)
-
- (and (n/= 0 E) (n/= 0 M))
- (if (n/= 0 S)
- +0.0
- (f/* -1.0 +0.0))
-
- ## else
- (let [normalized (|> M (i64.set mantissa-size)
- .int int-to-frac
- (f// (math.pow +52.0 +2.0)))
- power (math.pow (|> E (n/- double-bias)
- .int int-to-frac)
- +2.0)
- shifted (f/* power
- normalized)]
- (if (n/= 0 S)
- shifted
- (f/* -1.0 shifted))))))
-
-(structure: #export _ (Hash Nat)
- (def: eq Equivalence<Nat>)
- (def: hash function.identity))
-
-(structure: #export _ (Hash Int)
- (def: eq Equivalence<Int>)
- (def: hash .nat))
-
-(structure: #export _ (Hash Frac)
- (def: eq Equivalence<Frac>)
- (def: hash frac-to-bits))
-
-(structure: #export _ (Hash Rev)
- (def: eq Equivalence<Rev>)
- (def: hash (|>> (:coerce Nat))))
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index aeefa03d6..a7993dcaf 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -5,14 +5,15 @@
[equivalence (#+ Equivalence)]
number
codec
- ["M" monad (#+ do Monad)]
+ ["M" monad (#+ Monad do)]
["p" parser]]
[data
["." maybe]
- ["." number ("frac/." Number<Frac>)]
- [text ("text/." Monoid<Text>)]
+ [number
+ ["." frac ("frac/." number)]]
+ [text ("text/." monoid)]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
["." macro
["." code]
["s" syntax (#+ syntax: Syntax)]]])
@@ -37,8 +38,8 @@
(def: #export zero Complex (complex +0.0 +0.0))
(def: #export (not-a-number? complex)
- (or (number.not-a-number? (get@ #real complex))
- (number.not-a-number? (get@ #imaginary complex))))
+ (or (frac.not-a-number? (get@ #real complex))
+ (frac.not-a-number? (get@ #imaginary complex))))
(def: #export (= param input)
(-> Complex Complex Bit)
@@ -59,7 +60,7 @@
[- f/-]
)
-(structure: #export _ (Equivalence Complex)
+(structure: #export equivalence (Equivalence Complex)
(def: = ..=))
(def: #export negate
@@ -190,7 +191,7 @@
(frac/abs real))))
))))
-(structure: #export _ (Number Complex)
+(structure: #export number (Number Complex)
(def: + ..+)
(def: - ..-)
(def: * ..*)
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
new file mode 100644
index 000000000..a2bd659b0
--- /dev/null
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -0,0 +1,441 @@
+(.module:
+ [lux #*
+ [control
+ [hash (#+ Hash)]
+ [number (#+ Number)]
+ [enum (#+ Enum)]
+ [interval (#+ Interval)]
+ [monoid (#+ Monoid)]
+ [equivalence (#+ Equivalence)]
+ ["." order (#+ Order)]
+ [codec (#+ Codec)]]
+ [data
+ ["." error (#+ Error)]
+ ["." maybe]]
+ ["." math]]
+ [//
+ ["//." i64]
+ ["//." nat]
+ ["//." int]
+ ["//." rev]])
+
+(structure: #export equivalence (Equivalence Frac)
+ (def: = f/=))
+
+(structure: #export order (Order Frac)
+ (def: &equivalence ..equivalence)
+ (def: < f/<)
+ (def: <= f/<=)
+ (def: > f/>)
+ (def: >= f/>=))
+
+(structure: #export enum (Enum Frac)
+ (def: &order ..order)
+ (def: succ (f/+ ("lux frac smallest")))
+ (def: pred (f/- ("lux frac smallest"))))
+
+(structure: #export interval (Interval Frac)
+ (def: &enum ..enum)
+ (def: top ("lux frac max"))
+ (def: bottom ("lux frac min")))
+
+(structure: #export number (Number Frac)
+ (def: + f/+)
+ (def: - f/-)
+ (def: * f/*)
+ (def: / f//)
+ (def: % f/%)
+ (def: negate (f/* -1.0))
+ (def: (abs x)
+ (if (f/< +0.0 x)
+ (f/* -1.0 x)
+ x))
+ (def: (signum x)
+ (cond (f/= +0.0 x) +0.0
+ (f/< +0.0 x) -1.0
+ ## else
+ +1.0))
+ )
+
+(do-template [<name> <compose> <identity>]
+ [(structure: #export <name> (Monoid Frac)
+ (def: identity <identity>)
+ (def: compose <compose>))]
+
+ [addition f/+ +0.0]
+ [multiplication f/* +1.0]
+ [maximum f/max (:: ..interval bottom)]
+ [minimum f/min (:: ..interval top)]
+ )
+
+(do-template [<name> <numerator> <doc>]
+ [(def: #export <name>
+ {#.doc <doc>}
+ Frac
+ (f// +0.0 <numerator>))]
+
+ [not-a-number +0.0 "Not a number."]
+ [positive-infinity +1.0 "Positive infinity."]
+ [negative-infinity -1.0 "Negative infinity."]
+ )
+
+(def: #export (not-a-number? number)
+ {#.doc "Tests whether a frac is actually not-a-number."}
+ (-> Frac Bit)
+ (not (f/= number number)))
+
+(def: #export (frac? value)
+ (-> Frac Bit)
+ (not (or (not-a-number? value)
+ (f/= positive-infinity value)
+ (f/= negative-infinity value))))
+
+(structure: #export decimal (Codec Text Frac)
+ (def: (encode x)
+ ("lux frac encode" [x]))
+
+ (def: (decode input)
+ (case ("lux frac decode" [input])
+ (#.Some value)
+ (#error.Success value)
+
+ #.None
+ (#error.Failure "Could not decode Frac"))))
+
+(do-template [<struct> <int> <base> <char-set> <error>]
+ [(structure: #export <struct> (Codec Text Frac)
+ (def: (encode value)
+ (let [whole (frac-to-int value)
+ whole-part (:: <int> encode whole)
+ decimal (:: ..number abs (f/% +1.0 value))
+ decimal-part (if (f/= +0.0 decimal)
+ ".0"
+ (loop [dec-left decimal
+ output ""]
+ (if (f/= +0.0 dec-left)
+ ("lux text concat" "." output)
+ (let [shifted (f/* <base> dec-left)
+ digit-idx (|> shifted (f/% <base>) frac-to-int .nat)]
+ (recur (f/% +1.0 shifted)
+ ("lux text concat" output ("lux text clip" <char-set> digit-idx (inc digit-idx))))))))]
+ ("lux text concat" whole-part decimal-part)))
+
+ (def: (decode repr)
+ (case ("lux text index" repr "." 0)
+ (#.Some split-index)
+ (let [whole-part ("lux text clip" repr 0 split-index)
+ decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))]
+ (case [(:: <int> decode whole-part)
+ (:: <int> decode decimal-part)]
+ (^multi [(#error.Success whole) (#error.Success decimal)]
+ (i/>= +0 decimal))
+ (let [sign (if (i/< +0 whole)
+ -1.0
+ +1.0)
+ div-power (loop [muls-left ("lux text size" decimal-part)
+ output +1.0]
+ (if (n/= 0 muls-left)
+ output
+ (recur (dec muls-left)
+ (f/* <base> output))))
+ adjusted-decimal (|> decimal int-to-frac (f// div-power))
+ dec-rev (case (:: //rev.hex decode ("lux text concat" "." decimal-part))
+ (#error.Success dec-rev)
+ dec-rev
+
+ (#error.Failure error)
+ (error! error))]
+ (#error.Success (f/+ (int-to-frac whole)
+ (f/* sign adjusted-decimal))))
+
+ _
+ (#error.Failure ("lux text concat" <error> repr))))
+
+ _
+ (#error.Failure ("lux text concat" <error> repr)))))]
+
+ [binary //int.binary +2.0 "01" "Invalid binary syntax: "]
+ )
+
+(def: (segment-digits chunk-size digits)
+ (-> Nat Text (List Text))
+ (case digits
+ ""
+ (list)
+
+ _
+ (let [num-digits ("lux text size" digits)]
+ (if (n/<= chunk-size num-digits)
+ (list digits)
+ (let [boundary (n/- chunk-size num-digits)
+ chunk ("lux text clip" digits boundary num-digits)
+ remaining ("lux text clip" digits 0 boundary)]
+ (list& chunk (segment-digits chunk-size remaining)))))))
+
+(def: (bin-segment-to-hex input)
+ (-> Text Text)
+ (case input
+ "0000" "0"
+ "0001" "1"
+ "0010" "2"
+ "0011" "3"
+ "0100" "4"
+ "0101" "5"
+ "0110" "6"
+ "0111" "7"
+ "1000" "8"
+ "1001" "9"
+ "1010" "A"
+ "1011" "B"
+ "1100" "C"
+ "1101" "D"
+ "1110" "E"
+ "1111" "F"
+ _ (undefined)))
+
+(def: (hex-segment-to-bin input)
+ (-> Text Text)
+ (case input
+ "0" "0000"
+ "1" "0001"
+ "2" "0010"
+ "3" "0011"
+ "4" "0100"
+ "5" "0101"
+ "6" "0110"
+ "7" "0111"
+ "8" "1000"
+ "9" "1001"
+ (^or "a" "A") "1010"
+ (^or "b" "B") "1011"
+ (^or "c" "C") "1100"
+ (^or "d" "D") "1101"
+ (^or "e" "E") "1110"
+ (^or "f" "F") "1111"
+ _ (undefined)))
+
+(def: (bin-segment-to-octal input)
+ (-> Text Text)
+ (case input
+ "000" "0"
+ "001" "1"
+ "010" "2"
+ "011" "3"
+ "100" "4"
+ "101" "5"
+ "110" "6"
+ "111" "7"
+ _ (undefined)))
+
+(def: (octal-segment-to-bin input)
+ (-> Text Text)
+ (case input
+ "0" "000"
+ "1" "001"
+ "2" "010"
+ "3" "011"
+ "4" "100"
+ "5" "101"
+ "6" "110"
+ "7" "111"
+ _ (undefined)))
+
+(def: (map f xs)
+ (All [a b] (-> (-> a b) (List a) (List b)))
+ (case xs
+ #.Nil
+ #.Nil
+
+ (#.Cons x xs')
+ (#.Cons (f x) (map f xs'))))
+
+(def: (re-join-chunks xs)
+ (-> (List Text) Text)
+ (case xs
+ #.Nil
+ ""
+
+ (#.Cons x xs')
+ ("lux text concat" x (re-join-chunks xs'))))
+
+(do-template [<from> <from-translator> <to> <to-translator> <base-bits>]
+ [(def: (<from> on-left? input)
+ (-> Bit Text Text)
+ (let [max-num-chars (n// <base-bits> 64)
+ input-size ("lux text size" input)
+ zero-padding (let [num-digits-that-need-padding (n/% <base-bits> input-size)]
+ (if (n/= 0 num-digits-that-need-padding)
+ ""
+ (loop [zeroes-left (n/- num-digits-that-need-padding
+ <base-bits>)
+ output ""]
+ (if (n/= 0 zeroes-left)
+ output
+ (recur (dec zeroes-left)
+ ("lux text concat" "0" output))))))
+ padded-input (if on-left?
+ ("lux text concat" zero-padding input)
+ ("lux text concat" input zero-padding))]
+ (|> padded-input
+ (segment-digits <base-bits>)
+ (map <from-translator>)
+ re-join-chunks)))
+
+ (def: <to>
+ (-> Text Text)
+ (|>> (segment-digits 1)
+ (map <to-translator>)
+ re-join-chunks))]
+
+ [binary-to-hex bin-segment-to-hex hex-to-binary hex-segment-to-bin 4]
+ [binary-to-octal bin-segment-to-octal octal-to-binary octal-segment-to-bin 3]
+ )
+
+(do-template [<struct> <error> <from> <to>]
+ [(structure: #export <struct> (Codec Text Frac)
+ (def: (encode value)
+ (let [sign (:: ..number signum value)
+ raw-bin (:: ..binary encode value)
+ dot-idx (maybe.assume ("lux text index" raw-bin "." 0))
+ whole-part ("lux text clip" raw-bin
+ (if (f/= -1.0 sign) 1 0)
+ dot-idx)
+ decimal-part ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin))
+ hex-output (|> (<from> #0 decimal-part)
+ ("lux text concat" ".")
+ ("lux text concat" (<from> #1 whole-part))
+ ("lux text concat" (if (f/= -1.0 sign) "-" "")))]
+ hex-output))
+
+ (def: (decode repr)
+ (let [sign (case ("lux text index" repr "-" 0)
+ (#.Some 0)
+ -1.0
+
+ _
+ +1.0)]
+ (case ("lux text index" repr "." 0)
+ (#.Some split-index)
+ (let [whole-part ("lux text clip" repr 1 split-index)
+ decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))
+ as-binary (|> (<to> decimal-part)
+ ("lux text concat" ".")
+ ("lux text concat" (<to> whole-part))
+ ("lux text concat" (if (f/= -1.0 sign) "-" "+")))]
+ (case (:: ..binary decode as-binary)
+ (#error.Failure _)
+ (#error.Failure ("lux text concat" <error> repr))
+
+ output
+ output))
+
+ _
+ (#error.Failure ("lux text concat" <error> repr))))))]
+
+ [octal "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary]
+ [hex "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary]
+ )
+
+(def: (log2 input)
+ (-> Frac Frac)
+ (f// (math.log +2.0)
+ (math.log input)))
+
+(def: double-bias Nat 1023)
+
+(def: mantissa-size Nat 52)
+(def: exponent-size Nat 11)
+
+(do-template [<hex> <name>]
+ [(def: <name> (|> <hex> (:: //nat.hex decode) error.assume .i64))]
+
+ ["7FF7FFFFFFFFFFFF" not-a-number-bits]
+ ["7FF0000000000000" positive-infinity-bits]
+ ["FFF0000000000000" negative-infinity-bits]
+ ["0000000000000000" positive-zero-bits]
+ ["8000000000000000" negative-zero-bits]
+ ["7FF" special-exponent-bits]
+ )
+
+(def: #export (frac-to-bits input)
+ (-> Frac I64)
+ (i64 (cond (not-a-number? input)
+ ..not-a-number-bits
+
+ (f/= positive-infinity input)
+ ..positive-infinity-bits
+
+ (f/= negative-infinity input)
+ ..negative-infinity-bits
+
+ (f/= +0.0 input)
+ (let [reciprocal (f// input +1.0)]
+ (if (f/= positive-infinity reciprocal)
+ ## Positive zero
+ ..positive-zero-bits
+ ## Negative zero
+ ..negative-zero-bits))
+
+ ## else
+ (let [sign (:: ..number signum input)
+ input (:: ..number abs input)
+ exponent (math.floor (log2 input))
+ exponent-mask (|> 1 (//i64.left-shift exponent-size) dec)
+ mantissa (|> input
+ ## Normalize
+ (f// (math.pow exponent +2.0))
+ ## Make it int-equivalent
+ (f/* (math.pow +52.0 +2.0)))
+ sign-bit (if (f/= -1.0 sign) 1 0)
+ exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (//i64.and exponent-mask))
+ mantissa-bits (|> mantissa frac-to-int .nat)]
+ ($_ //i64.or
+ (//i64.left-shift 63 sign-bit)
+ (//i64.left-shift mantissa-size exponent-bits)
+ (//i64.clear mantissa-size mantissa-bits)))
+ )))
+
+(do-template [<getter> <mask> <size> <offset>]
+ [(def: <mask> (|> 1 (//i64.left-shift <size>) dec (//i64.left-shift <offset>)))
+ (def: (<getter> input)
+ (-> (I64 Any) I64)
+ (|> input (//i64.and <mask>) (//i64.logical-right-shift <offset>) i64))]
+
+ [mantissa mantissa-mask mantissa-size 0]
+ [exponent exponent-mask exponent-size mantissa-size]
+ [sign sign-mask 1 (n/+ exponent-size mantissa-size)]
+ )
+
+(def: #export (bits-to-frac input)
+ (-> (I64 Any) Frac)
+ (let [S (sign input)
+ E (exponent input)
+ M (mantissa input)]
+ (cond (n/= ..special-exponent-bits E)
+ (if (n/= 0 M)
+ (if (n/= 0 S)
+ ..positive-infinity
+ ..negative-infinity)
+ ..not-a-number)
+
+ (and (n/= 0 E) (n/= 0 M))
+ (if (n/= 0 S)
+ +0.0
+ (f/* -1.0 +0.0))
+
+ ## else
+ (let [normalized (|> M (//i64.set mantissa-size)
+ .int int-to-frac
+ (f// (math.pow +52.0 +2.0)))
+ power (math.pow (|> E (n/- double-bias)
+ .int int-to-frac)
+ +2.0)
+ shifted (f/* power
+ normalized)]
+ (if (n/= 0 S)
+ shifted
+ (f/* -1.0 shifted))))))
+
+(structure: #export hash (Hash Frac)
+ (def: &equivalence ..equivalence)
+ (def: hash frac-to-bits))
diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux
new file mode 100644
index 000000000..1047b68f9
--- /dev/null
+++ b/stdlib/source/lux/data/number/int.lux
@@ -0,0 +1,134 @@
+(.module:
+ [lux #*
+ [control
+ [hash (#+ Hash)]
+ [number (#+ Number)]
+ [enum (#+ Enum)]
+ [interval (#+ Interval)]
+ [monoid (#+ Monoid)]
+ [equivalence (#+ Equivalence)]
+ ["." order (#+ Order)]
+ [codec (#+ Codec)]]
+ [data
+ ["." error (#+ Error)]
+ ["." maybe]
+ [text (#+ Char)]]]
+ [//
+ ["." nat]])
+
+(structure: #export equivalence (Equivalence Int)
+ (def: = i/=))
+
+(structure: #export order (Order Int)
+ (def: &equivalence ..equivalence)
+ (def: < i/<)
+ (def: <= i/<=)
+ (def: > i/>)
+ (def: >= i/>=))
+
+(structure: #export enum (Enum Int)
+ (def: &order ..order)
+ (def: succ inc)
+ (def: pred dec))
+
+(structure: #export interval (Interval Int)
+ (def: &enum ..enum)
+ (def: top +9_223_372_036_854_775_807)
+ (def: bottom -9_223_372_036_854_775_808))
+
+(structure: #export number (Number Int)
+ (def: + i/+)
+ (def: - i/-)
+ (def: * i/*)
+ (def: / i//)
+ (def: % i/%)
+ (def: negate (i/* -1))
+ (def: (abs x)
+ (if (i/< +0 x)
+ (i/* -1 x)
+ x))
+ (def: (signum x)
+ (cond (i/= +0 x) +0
+ (i/< +0 x) -1
+ ## else
+ +1))
+ )
+
+(do-template [<name> <compose> <identity>]
+ [(structure: #export <name> (Monoid Int)
+ (def: identity <identity>)
+ (def: compose <compose>))]
+
+ [addition i/+ +0]
+ [multiplication i/* +1]
+ [maximum i/max (:: ..interval bottom)]
+ [minimum i/min (:: ..interval top)]
+ )
+
+(def: (int/sign!! value)
+ (-> Int Text)
+ (if (i/< +0 value)
+ "-"
+ "+"))
+
+(def: (int/sign?? representation)
+ (-> Text (Maybe Int))
+ (case ("lux text char" representation 0)
+ (^ (char "-"))
+ (#.Some -1)
+
+ (^ (char "+"))
+ (#.Some +1)
+
+ _
+ #.None))
+
+(def: (int-decode-loop input-size repr sign <base> <to-value> <error>)
+ (-> Nat Text Int Int (-> Char (Maybe Nat)) Text (Error Int))
+ (loop [idx 1
+ output +0]
+ (if (n/< input-size idx)
+ (case (<to-value> ("lux text char" repr idx))
+ #.None
+ (#error.Failure <error>)
+
+ (#.Some digit-value)
+ (recur (inc idx)
+ (|> output (i/* <base>) (i/+ (.int digit-value)))))
+ (#error.Success (i/* sign output)))))
+
+(do-template [<struct> <base> <to-character> <to-value> <error>]
+ [(structure: #export <struct> (Codec Text Int)
+ (def: (encode value)
+ (if (i/= +0 value)
+ "+0"
+ (loop [input (|> value (i// <base>) (:: ..number abs))
+ output (|> value (i/% <base>) (:: ..number abs) .nat
+ <to-character>
+ maybe.assume)]
+ (if (i/= +0 input)
+ ("lux text concat" (int/sign!! value) output)
+ (let [digit (maybe.assume (<to-character> (.nat (i/% <base> input))))]
+ (recur (i// <base> input)
+ ("lux text concat" digit output)))))))
+
+ (def: (decode repr)
+ (let [input-size ("lux text size" repr)]
+ (if (n/> 1 input-size)
+ (case (int/sign?? repr)
+ (#.Some sign)
+ (int-decode-loop input-size repr sign <base> <to-value> <error>)
+
+ #.None
+ (#error.Failure <error>))
+ (#error.Failure <error>)))))]
+
+ [binary +2 nat.binary-character nat.binary-value "Invalid binary syntax for Int: "]
+ [octal +8 nat.octal-character nat.octal-value "Invalid octal syntax for Int: "]
+ [decimal +10 nat.decimal-character nat.decimal-value "Invalid syntax for Int: "]
+ [hex +16 nat.hexadecimal-character nat.hexadecimal-value "Invalid hexadecimal syntax for Int: "]
+ )
+
+(structure: #export hash (Hash Int)
+ (def: &equivalence ..equivalence)
+ (def: hash .nat))
diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux
new file mode 100644
index 000000000..9e249b207
--- /dev/null
+++ b/stdlib/source/lux/data/number/nat.lux
@@ -0,0 +1,211 @@
+(.module:
+ [lux #*
+ [control
+ [hash (#+ Hash)]
+ [number (#+ Number)]
+ [enum (#+ Enum)]
+ [interval (#+ Interval)]
+ [monoid (#+ Monoid)]
+ [equivalence (#+ Equivalence)]
+ [codec (#+ Codec)]
+ ["." order (#+ Order)]]
+ [data
+ ["." error (#+ Error)]
+ ["." maybe]
+ ["." text (#+ Char)]]
+ ["." function]])
+
+(structure: #export equivalence (Equivalence Nat)
+ (def: = n/=))
+
+(structure: #export order (Order Nat)
+ (def: &equivalence ..equivalence)
+ (def: < n/<)
+ (def: <= n/<=)
+ (def: > n/>)
+ (def: >= n/>=))
+
+(structure: #export enum (Enum Nat)
+ (def: &order ..order)
+ (def: succ inc)
+ (def: pred dec))
+
+(structure: #export interval (Interval Nat)
+ (def: &enum ..enum)
+ (def: top (.nat -1))
+ (def: bottom 0))
+
+(structure: #export number (Number Nat)
+ (def: + n/+)
+ (def: - n/-)
+ (def: * n/*)
+ (def: / n//)
+ (def: % n/%)
+ (def: (negate value) (n/- (:: ..interval top) value))
+ (def: abs function.identity)
+ (def: (signum x)
+ (case x
+ 0 0
+ _ 1))
+ )
+
+(do-template [<name> <compose> <identity>]
+ [(structure: #export <name> (Monoid Nat)
+ (def: identity <identity>)
+ (def: compose <compose>))]
+
+ [addition n/+ 0]
+ [multiplication n/* 1]
+ [maximum n/max (:: ..interval bottom)]
+ [minimum n/min (:: ..interval top)]
+ )
+
+(def: #export (binary-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ 0 (#.Some "0")
+ 1 (#.Some "1")
+ _ #.None))
+
+(def: #export (binary-value digit)
+ (-> Char (Maybe Nat))
+ (case digit
+ (^ (char "0")) (#.Some 0)
+ (^ (char "1")) (#.Some 1)
+ _ #.None))
+
+(def: #export (octal-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ 0 (#.Some "0")
+ 1 (#.Some "1")
+ 2 (#.Some "2")
+ 3 (#.Some "3")
+ 4 (#.Some "4")
+ 5 (#.Some "5")
+ 6 (#.Some "6")
+ 7 (#.Some "7")
+ _ #.None))
+
+(def: #export (octal-value digit)
+ (-> Char (Maybe Nat))
+ (case digit
+ (^ (char "0")) (#.Some 0)
+ (^ (char "1")) (#.Some 1)
+ (^ (char "2")) (#.Some 2)
+ (^ (char "3")) (#.Some 3)
+ (^ (char "4")) (#.Some 4)
+ (^ (char "5")) (#.Some 5)
+ (^ (char "6")) (#.Some 6)
+ (^ (char "7")) (#.Some 7)
+ _ #.None))
+
+(def: #export (decimal-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ 0 (#.Some "0")
+ 1 (#.Some "1")
+ 2 (#.Some "2")
+ 3 (#.Some "3")
+ 4 (#.Some "4")
+ 5 (#.Some "5")
+ 6 (#.Some "6")
+ 7 (#.Some "7")
+ 8 (#.Some "8")
+ 9 (#.Some "9")
+ _ #.None))
+
+(def: #export (decimal-value digit)
+ (-> Char (Maybe Nat))
+ (case digit
+ (^ (char "0")) (#.Some 0)
+ (^ (char "1")) (#.Some 1)
+ (^ (char "2")) (#.Some 2)
+ (^ (char "3")) (#.Some 3)
+ (^ (char "4")) (#.Some 4)
+ (^ (char "5")) (#.Some 5)
+ (^ (char "6")) (#.Some 6)
+ (^ (char "7")) (#.Some 7)
+ (^ (char "8")) (#.Some 8)
+ (^ (char "9")) (#.Some 9)
+ _ #.None))
+
+(def: #export (hexadecimal-character value)
+ (-> Nat (Maybe Text))
+ (case value
+ 0 (#.Some "0")
+ 1 (#.Some "1")
+ 2 (#.Some "2")
+ 3 (#.Some "3")
+ 4 (#.Some "4")
+ 5 (#.Some "5")
+ 6 (#.Some "6")
+ 7 (#.Some "7")
+ 8 (#.Some "8")
+ 9 (#.Some "9")
+ 10 (#.Some "A")
+ 11 (#.Some "B")
+ 12 (#.Some "C")
+ 13 (#.Some "D")
+ 14 (#.Some "E")
+ 15 (#.Some "F")
+ _ #.None))
+
+(def: #export (hexadecimal-value digit)
+ (-> Char (Maybe Nat))
+ (case digit
+ (^ (char "0")) (#.Some 0)
+ (^ (char "1")) (#.Some 1)
+ (^ (char "2")) (#.Some 2)
+ (^ (char "3")) (#.Some 3)
+ (^ (char "4")) (#.Some 4)
+ (^ (char "5")) (#.Some 5)
+ (^ (char "6")) (#.Some 6)
+ (^ (char "7")) (#.Some 7)
+ (^ (char "8")) (#.Some 8)
+ (^ (char "9")) (#.Some 9)
+ (^or (^ (char "a")) (^ (char "A"))) (#.Some 10)
+ (^or (^ (char "b")) (^ (char "B"))) (#.Some 11)
+ (^or (^ (char "c")) (^ (char "C"))) (#.Some 12)
+ (^or (^ (char "d")) (^ (char "D"))) (#.Some 13)
+ (^or (^ (char "e")) (^ (char "E"))) (#.Some 14)
+ (^or (^ (char "f")) (^ (char "F"))) (#.Some 15)
+ _ #.None))
+
+(do-template [<struct> <base> <to-character> <to-value> <error>]
+ [(structure: #export <struct> (Codec Text Nat)
+ (def: (encode value)
+ (loop [input value
+ output ""]
+ (let [digit (maybe.assume (<to-character> (n/% <base> input)))
+ output' ("lux text concat" digit output)
+ input' (n// <base> input)]
+ (if (n/= 0 input')
+ output'
+ (recur input' output')))))
+
+ (def: (decode repr)
+ (let [input-size ("lux text size" repr)]
+ (if (n/> 0 input-size)
+ (loop [idx 0
+ output 0]
+ (if (n/< input-size idx)
+ (case (<to-value> ("lux text char" repr idx))
+ #.None
+ (#error.Failure ("lux text concat" <error> repr))
+
+ (#.Some digit-value)
+ (recur (inc idx)
+ (|> output (n/* <base>) (n/+ digit-value))))
+ (#error.Success output)))
+ (#error.Failure ("lux text concat" <error> repr))))))]
+
+ [binary 2 binary-character binary-value "Invalid binary syntax for Nat: "]
+ [octal 8 octal-character octal-value "Invalid octal syntax for Nat: "]
+ [decimal 10 decimal-character decimal-value "Invalid syntax for Nat: "]
+ [hex 16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
+ )
+
+(structure: #export hash (Hash Nat)
+ (def: &equivalence ..equivalence)
+ (def: hash function.identity))
diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index 1447040e6..773baef15 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -1,4 +1,4 @@
-(.module: {#.doc "Rational arithmetic."}
+(.module: {#.doc "Rational numbers."}
[lux #*
[control
[equivalence (#+ Equivalence)]
@@ -11,14 +11,15 @@
["." error]
["." product]
["." maybe]
- [number ("nat/." Codec<Text,Nat>)]
- ["." text ("text/." Monoid<Text>)
+ [number
+ [nat ("nat/." decimal)]]
+ ["." text ("text/." monoid)
format]]
["." function]
["." math]
["." macro
["." code]
- ["s" syntax (#+ syntax: Syntax)]]])
+ ["s" syntax (#+ Syntax syntax:)]]])
(type: #export Ratio
{#numerator Nat
@@ -103,17 +104,17 @@
[max >]
)
-(structure: #export _ (Equivalence Ratio)
+(structure: #export equivalence (Equivalence Ratio)
(def: = ..=))
-(structure: #export _ (Order Ratio)
- (def: eq Equivalence<Ratio>)
+(structure: #export order (Order Ratio)
+ (def: &equivalence ..equivalence)
(def: < ..<)
(def: <= ..<=)
(def: > ..>)
(def: >= ..>=))
-(structure: #export _ (Number Ratio)
+(structure: #export number (Number Ratio)
(def: + ..+)
(def: - ..-)
(def: * ..*)
@@ -133,14 +134,14 @@
(-> Nat Text)
(|>> nat/encode (text.split 1) maybe.assume product.right))
-(structure: #export _ (Codec Text Ratio)
+(structure: #export codec (Codec Text Ratio)
(def: (encode (^slots [#numerator #denominator]))
($_ text/compose (part-encode numerator) separator (part-encode denominator)))
(def: (decode input)
(case (text.split-with separator input)
(#.Some [num denom])
- (do error.Monad<Error>
+ (do error.monad
[numerator (nat/decode num)
denominator (nat/decode denom)]
(wrap (normalize {#numerator numerator
diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux
new file mode 100644
index 000000000..dbfb5a93a
--- /dev/null
+++ b/stdlib/source/lux/data/number/rev.lux
@@ -0,0 +1,291 @@
+(.module:
+ [lux #*
+ [control
+ [hash (#+ Hash)]
+ [number (#+ Number)]
+ [enum (#+ Enum)]
+ [interval (#+ Interval)]
+ [monoid (#+ Monoid)]
+ [equivalence (#+ Equivalence)]
+ ["." order (#+ Order)]
+ [codec (#+ Codec)]]
+ [data
+ ["." error (#+ Error)]
+ ["." maybe]
+ [collection
+ ["." array (#+ Array)]]]
+ ["." function]]
+ [//
+ ["//." i64]
+ ["//." nat]
+ ["//." int]])
+
+(structure: #export equivalence (Equivalence Rev)
+ (def: = r/=))
+
+(structure: #export order (Order Rev)
+ (def: &equivalence ..equivalence)
+ (def: < r/<)
+ (def: <= r/<=)
+ (def: > r/>)
+ (def: >= r/>=))
+
+(structure: #export enum (Enum Rev)
+ (def: &order ..order)
+ (def: succ inc)
+ (def: pred dec))
+
+(structure: #export interval (Interval Rev)
+ (def: &enum ..enum)
+ (def: top (.rev -1))
+ (def: bottom (.rev 0)))
+
+(structure: #export number (Number Rev)
+ (def: + r/+)
+ (def: - r/-)
+ (def: * r/*)
+ (def: / r//)
+ (def: % r/%)
+ (def: (negate x) (r/- x (:coerce Rev -1)))
+ (def: abs function.identity)
+ (def: (signum x)
+ (:coerce Rev -1)))
+
+(do-template [<name> <compose> <identity>]
+ [(structure: #export <name> (Monoid Rev)
+ (def: identity <identity>)
+ (def: compose <compose>))]
+
+ [addition r/+ (:: interval bottom)]
+ [multiplication r/* (:: interval top)]
+ [maximum r/max (:: interval bottom)]
+ [minimum r/min (:: interval top)]
+ )
+
+(def: (de-prefix input)
+ (-> Text Text)
+ ("lux text clip" input 1 ("lux text size" input)))
+
+(do-template [<struct> <nat> <char-bit-size> <error>]
+ [(with-expansions [<error-output> (as-is (#error.Failure ("lux text concat" <error> repr)))]
+ (structure: #export <struct> (Codec Text Rev)
+ (def: (encode value)
+ (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value)))
+ max-num-chars (n// <char-bit-size> 64)
+ raw-size ("lux text size" raw-output)
+ zero-padding (loop [zeroes-left (n/- raw-size max-num-chars)
+ output ""]
+ (if (n/= 0 zeroes-left)
+ output
+ (recur (dec zeroes-left)
+ ("lux text concat" "0" output))))
+ padded-output ("lux text concat" zero-padding raw-output)]
+ ("lux text concat" "." padded-output)))
+
+ (def: (decode repr)
+ (let [repr-size ("lux text size" repr)]
+ (if (n/>= 2 repr-size)
+ (case ("lux text char" repr 0)
+ (^ (char "."))
+ (case (:: <nat> decode (de-prefix repr))
+ (#error.Success output)
+ (#error.Success (:coerce Rev output))
+
+ _
+ <error-output>)
+
+ _
+ <error-output>)
+ <error-output>)))))]
+
+ [binary //nat.binary 1 "Invalid binary syntax: "]
+ [octal //nat.octal 3 "Invalid octal syntax: "]
+ [hex //nat.hex 4 "Invalid hexadecimal syntax: "]
+ )
+
+## The following code allows one to encode/decode Rev numbers as text.
+## This is not a simple algorithm, and it requires subverting the Rev
+## abstraction a bit.
+## It takes into account the fact that Rev numbers are represented by
+## Lux as 64-bit integers.
+## A valid way to model them is as Lux's Nat type.
+## This is a somewhat hackish way to do things, but it allows one to
+## write the encoding/decoding algorithm once, in pure Lux, rather
+## than having to implement it on the compiler for every platform
+## targeted by Lux.
+(type: Digits (Array Nat))
+
+(def: (make-digits _)
+ (-> Any Digits)
+ (array.new //i64.width))
+
+(def: (digits-get idx digits)
+ (-> Nat Digits Nat)
+ (|> digits (array.read idx) (maybe.default 0)))
+
+(def: digits-put
+ (-> Nat Nat Digits Digits)
+ array.write)
+
+(def: (prepend left right)
+ (-> Text Text Text)
+ ("lux text concat" left right))
+
+(def: (digits-times-5! idx output)
+ (-> Nat Digits Digits)
+ (loop [idx idx
+ carry 0
+ output output]
+ (if (i/>= +0 (.int idx))
+ (let [raw (|> (digits-get idx output)
+ (n/* 5)
+ (n/+ carry))]
+ (recur (dec idx)
+ (n// 10 raw)
+ (digits-put idx (n/% 10 raw) output)))
+ output)))
+
+(def: (digits-power power)
+ (-> Nat Digits)
+ (loop [times power
+ output (|> (make-digits [])
+ (digits-put power 1))]
+ (if (i/>= +0 (.int times))
+ (recur (dec times)
+ (digits-times-5! power output))
+ output)))
+
+(def: (digits-to-text digits)
+ (-> Digits Text)
+ (loop [idx (dec //i64.width)
+ all-zeroes? #1
+ output ""]
+ (if (i/>= +0 (.int idx))
+ (let [digit (digits-get idx digits)]
+ (if (and (n/= 0 digit)
+ all-zeroes?)
+ (recur (dec idx) #1 output)
+ (recur (dec idx)
+ #0
+ ("lux text concat"
+ (:: //int.decimal encode (.int digit))
+ output))))
+ (if all-zeroes?
+ "0"
+ output))))
+
+(def: (digits-add param subject)
+ (-> Digits Digits Digits)
+ (loop [idx (dec //i64.width)
+ carry 0
+ output (make-digits [])]
+ (if (i/>= +0 (.int idx))
+ (let [raw ($_ n/+
+ carry
+ (digits-get idx param)
+ (digits-get idx subject))]
+ (recur (dec idx)
+ (n// 10 raw)
+ (digits-put idx (n/% 10 raw) output)))
+ output)))
+
+(def: (text-to-digits input)
+ (-> Text (Maybe Digits))
+ (let [length ("lux text size" input)]
+ (if (n/<= //i64.width length)
+ (loop [idx 0
+ output (make-digits [])]
+ (if (n/< length idx)
+ (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0)
+ #.None
+ #.None
+
+ (#.Some digit)
+ (recur (inc idx)
+ (digits-put idx digit output)))
+ (#.Some output)))
+ #.None)))
+
+(def: (digits-lt param subject)
+ (-> Digits Digits Bit)
+ (loop [idx 0]
+ (and (n/< //i64.width idx)
+ (let [pd (digits-get idx param)
+ sd (digits-get idx subject)]
+ (if (n/= pd sd)
+ (recur (inc idx))
+ (n/< pd sd))))))
+
+(def: (digits-sub-once! idx param subject)
+ (-> Nat Nat Digits Digits)
+ (let [sd (digits-get idx subject)]
+ (if (n/>= param sd)
+ (digits-put idx (n/- param sd) subject)
+ (let [diff (|> sd
+ (n/+ 10)
+ (n/- param))]
+ (|> subject
+ (digits-put idx diff)
+ (digits-sub-once! (dec idx) 1))))))
+
+(def: (digits-sub! param subject)
+ (-> Digits Digits Digits)
+ (loop [idx (dec //i64.width)
+ output subject]
+ (if (i/>= +0 (.int idx))
+ (recur (dec idx)
+ (digits-sub-once! idx (digits-get idx param) output))
+ output)))
+
+(structure: #export decimal (Codec Text Rev)
+ (def: (encode input)
+ (let [input (:coerce Nat input)
+ last-idx (dec //i64.width)]
+ (if (n/= 0 input)
+ ".0"
+ (loop [idx last-idx
+ digits (make-digits [])]
+ (if (i/>= +0 (.int idx))
+ (if (//i64.set? idx input)
+ (let [digits' (digits-add (digits-power (n/- idx last-idx))
+ digits)]
+ (recur (dec idx)
+ digits'))
+ (recur (dec idx)
+ digits))
+ ("lux text concat" "." (digits-to-text digits))
+ )))))
+
+ (def: (decode input)
+ (let [length ("lux text size" input)
+ dotted? (case ("lux text index" input "." 0)
+ (#.Some 0)
+ #1
+
+ _
+ #0)]
+ (if (and dotted?
+ (n/<= (inc //i64.width) length))
+ (case (text-to-digits ("lux text clip" input 1 length))
+ (#.Some digits)
+ (loop [digits digits
+ idx 0
+ output 0]
+ (if (n/< //i64.width idx)
+ (let [power (digits-power idx)]
+ (if (digits-lt power digits)
+ ## Skip power
+ (recur digits (inc idx) output)
+ (recur (digits-sub! power digits)
+ (inc idx)
+ (//i64.set (n/- idx (dec //i64.width)) output))))
+ (#error.Success (:coerce Rev output))))
+
+ #.None
+ (#error.Failure ("lux text concat" "Wrong syntax for Rev: " input)))
+ (#error.Failure ("lux text concat" "Wrong syntax for Rev: " input))))
+ ))
+
+(structure: #export hash (Hash Rev)
+ (def: &equivalence ..equivalence)
+ (def: hash .nat))
diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux
index 4cacb8329..69ad7d734 100644
--- a/stdlib/source/lux/data/store.lux
+++ b/stdlib/source/lux/data/store.lux
@@ -1,7 +1,7 @@
(.module:
[lux #*
[control
- ["F" functor]
+ [functor (#+ Functor)]
comonad]
[type
implicit]])
@@ -15,14 +15,14 @@
{#cursor (get@ #cursor wa)
#peek (function (_ s) (f (set@ #cursor s wa)))})
-(structure: #export Functor<Store> (All [s] (F.Functor (Store s)))
+(structure: #export functor (All [s] (Functor (Store s)))
(def: (map f fa)
(extend (function (_ store)
(f (:: store peek (:: store cursor))))
fa)))
-(structure: #export CoMonad<Store> (All [s] (CoMonad (Store s)))
- (def: functor Functor<Store>)
+(structure: #export comonad (All [s] (CoMonad (Store s)))
+ (def: &functor ..functor)
(def: (unwrap wa) (::: peek (::: cursor)))
@@ -41,5 +41,5 @@
(|> store (::: split) (peeks change)))
(def: #export (experiment Functor<f> change store)
- (All [f s a] (-> (F.Functor f) (-> s (f s)) (Store s a) (f a)))
+ (All [f s a] (-> (Functor f) (-> s (f s)) (Store s a) (f a)))
(:: Functor<f> map (::: peek) (change (::: cursor))))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 777c7da22..921e7c96c 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -12,7 +12,7 @@
[number
["." i64]]
[collection
- ["." list ("list/." Fold<List>)]]]
+ ["." list ("list/." fold)]]]
[platform
[compiler
["." host]]]])
@@ -135,7 +135,7 @@
(def: #export (split-with token sample)
(-> Text Text (Maybe [Text Text]))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[index (index-of token sample)
[pre post'] (split index sample)
[_ post] (split (size token) post')]
@@ -156,7 +156,7 @@
(def: #export (replace-once pattern value template)
(-> Text Text Text Text)
(<| (maybe.default template)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[[pre post] (split-with pattern template)]
(wrap ($_ "lux text concat" pre value post)))))
@@ -169,12 +169,12 @@
#.None
template))
-(structure: #export _ (Equivalence Text)
+(structure: #export equivalence (Equivalence Text)
(def: (= test subject)
("lux text =" subject test)))
-(structure: #export _ (Order Text)
- (def: eq Equivalence<Text>)
+(structure: #export order (Order Text)
+ (def: &equivalence ..equivalence)
(def: (< test subject)
("lux text <" subject test))
@@ -191,13 +191,14 @@
("lux text =" test subject)))
)
-(structure: #export _ (Monoid Text)
+(structure: #export monoid (Monoid Text)
(def: identity "")
+
(def: (compose left right)
("lux text concat" left right)))
-(structure: #export _ (Hash Text)
- (def: eq Equivalence<Text>)
+(structure: #export hash (Hash Text)
+ (def: &equivalence ..equivalence)
(def: (hash input)
(`` (for {(~~ (static host.jvm))
@@ -220,7 +221,7 @@
(def: #export concat
(-> (List Text) Text)
- (let [(^open ".") Monoid<Text>]
+ (let [(^open ".") ..monoid]
(|>> list.reverse (list/fold compose identity))))
(def: #export (join-with sep texts)
@@ -236,7 +237,7 @@
(def: #export (enclose [left right] content)
{#.doc "Surrounds the given content text with left and right side additions."}
(-> [Text Text] Text Text)
- (let [(^open ".") Monoid<Text>]
+ (let [(^open ".") ..monoid]
($_ "lux text concat" left content right)))
(def: #export (enclose' boundary content)
diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux
index 02b0001d0..9534f1e3e 100644
--- a/stdlib/source/lux/data/text/buffer.lux
+++ b/stdlib/source/lux/data/text/buffer.lux
@@ -5,7 +5,7 @@
[text
format]
[collection
- ["." row (#+ Row) ("row/." Fold<Row>)]]]
+ ["." row (#+ Row) ("row/." fold)]]]
[compiler
["_" host]]
[type
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 234a639f2..ca0c7b151 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -6,13 +6,17 @@
[data
["." bit]
["." name]
- ["." number]
+ [number
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
["." text]
[format
["." xml]
["." json]]
[collection
- [list ("list/." Monad<List>)]]]
+ [list ("list/." monad)]]]
[time
["." instant]
["." duration]
@@ -40,22 +44,22 @@
(Format <type>)
<formatter>)]
- [%b Bit (:: bit.Codec<Text,Bit> encode)]
- [%n Nat (:: number.Codec<Text,Nat> encode)]
- [%i Int (:: number.Codec<Text,Int> encode)]
- [%r Rev (:: number.Codec<Text,Rev> encode)]
- [%f Frac (:: number.Codec<Text,Frac> encode)]
+ [%b Bit (:: bit.codec encode)]
+ [%n Nat (:: nat.decimal encode)]
+ [%i Int (:: int.decimal encode)]
+ [%r Rev (:: rev.decimal encode)]
+ [%f Frac (:: frac.decimal encode)]
[%t Text text.encode]
- [%name Name (:: name.Codec<Text,Name> encode)]
+ [%name Name (:: name.codec encode)]
[%code Code code.to-text]
[%type Type type.to-text]
- [%bin Nat (:: number.Binary@Codec<Text,Nat> encode)]
- [%oct Nat (:: number.Octal@Codec<Text,Nat> encode)]
- [%hex Nat (:: number.Hex@Codec<Text,Nat> encode)]
- [%xml xml.XML (:: xml.Codec<Text,XML> encode)]
- [%json json.JSON (:: json.Codec<Text,JSON> encode)]
+ [%bin Nat (:: nat.binary encode)]
+ [%oct Nat (:: nat.octal encode)]
+ [%hex Nat (:: nat.hex encode)]
+ [%xml xml.XML (:: xml.codec encode)]
+ [%json json.JSON (:: json.codec encode)]
[%instant instant.Instant instant.to-text]
- [%date date.Date (:: date.Codec<Text,Date> encode)]
+ [%date date.Date (:: date.codec encode)]
)
(def: #export %duration
@@ -71,7 +75,7 @@
(def: #export (%mod modular)
(All [m] (Format (modular.Mod m)))
(let [[_ modulus] (modular.un-mod modular)]
- (:: (modular.Codec<Text,Mod> modulus) encode modular)))
+ (:: (modular.codec modulus) encode modular)))
(def: #export (%list formatter)
(All [a] (-> (Format a) (Format (List a))))
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 9ecbb99c7..b5b0434e4 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -8,12 +8,13 @@
["." product]
["." maybe]
["." error (#+ Error)]
- [number ("nat/." Codec<Text,Nat>)]
+ [number
+ [nat ("nat/." decimal)]]
[collection
- ["." list ("list/." Fold<List>)]]]
+ ["." list ("list/." fold)]]]
[macro
["." code]]]
- ["." // ("text/." Monoid<Text>)])
+ ["." // ("text/." monoid)])
(type: #export Offset Nat)
@@ -55,7 +56,7 @@
(def: (with-slices lexer)
(-> (Lexer (List Slice)) (Lexer Slice))
- (do p.Monad<Parser>
+ (do p.monad
[offset ..offset
slices lexer]
(wrap (list/fold (function (_ [slice::basis slice::distance]
@@ -160,7 +161,7 @@
(def: #export (range bottom top)
{#.doc "Only lex characters within a range."}
(-> Nat Nat (Lexer Text))
- (do p.Monad<Parser>
+ (do p.monad
[char any
#let [char' (maybe.assume (//.nth 0 char))]
_ (p.assert ($_ text/compose "Character is not within range: " (//.from-code bottom) "-" (//.from-code top))
@@ -262,14 +263,14 @@
(def: #export (and left right)
(-> (Lexer Text) (Lexer Text) (Lexer Text))
- (do p.Monad<Parser>
+ (do p.monad
[=left left
=right right]
(wrap ($_ text/compose =left =right))))
(def: #export (and! left right)
(-> (Lexer Slice) (Lexer Slice) (Lexer Slice))
- (do p.Monad<Parser>
+ (do p.monad
[[left::basis left::distance] left
[right::basis right::distance] right]
(wrap [left::basis ("lux i64 +" left::distance right::distance)])))
@@ -278,7 +279,7 @@
[(def: #export (<name> lexer)
{#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " characters as a single continuous text."))}
(-> (Lexer Text) (Lexer Text))
- (|> lexer <base> (:: p.Monad<Parser> map //.concat)))]
+ (|> lexer <base> (:: p.monad map //.concat)))]
[some p.some "some"]
[many p.many "many"]
@@ -298,7 +299,7 @@
[(def: #export (<name> amount lexer)
{#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " N characters."))}
(-> Nat (Lexer Text) (Lexer Text))
- (|> lexer (<base> amount) (:: p.Monad<Parser> map //.concat)))]
+ (|> lexer (<base> amount) (:: p.monad map //.concat)))]
[exactly p.exactly "exactly"]
[at-most p.at-most "at most"]
@@ -319,7 +320,7 @@
(def: #export (between from to lexer)
{#.doc "Lex between N and M characters."}
(-> Nat Nat (Lexer Text) (Lexer Text))
- (|> lexer (p.between from to) (:: p.Monad<Parser> map //.concat)))
+ (|> lexer (p.between from to) (:: p.monad map //.concat)))
(def: #export (between! from to lexer)
{#.doc "Lex between N and M characters."}
@@ -345,7 +346,7 @@
(def: #export (slice lexer)
(-> (Lexer Slice) (Lexer Text))
- (do p.Monad<Parser>
+ (do p.monad
[[basis distance] lexer]
(function (_ (^@ input [offset tape]))
(case (//.clip basis ("lux i64 +" basis distance) tape)
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 22aa4c87c..9b2abb52e 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -2,14 +2,14 @@
[lux #*
[control
monad
- ["p" parser ("parser/." Monad<Parser>)]]
+ ["p" parser ("parser/." monad)]]
[data
["." product]
["." error]
["." maybe]
- ["." number (#+ hex) ("int/." Codec<Text,Int>)]
+ ["." number (#+ hex) ("int/." codec)]
[collection
- ["." list ("list/." Fold<List> Monad<List>)]]]
+ ["." list ("list/." fold monad)]]]
["." macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax:)]]]
@@ -24,7 +24,7 @@
(def: escaped-char^
(l.Lexer Text)
- (do p.Monad<Parser>
+ (do p.monad
[? (l.this? "\")]
(if ?
l.any
@@ -32,7 +32,7 @@
(def: (refine^ refinement^ base^)
(All [a] (-> (l.Lexer a) (l.Lexer Text) (l.Lexer Text)))
- (do p.Monad<Parser>
+ (do p.monad
[output base^
_ (l.local output refinement^)]
(wrap output)))
@@ -48,7 +48,7 @@
(def: (join-text^ part^)
(-> (l.Lexer (List Text)) (l.Lexer Text))
- (do p.Monad<Parser>
+ (do p.monad
[parts part^]
(wrap (//.join-with "" parts))))
@@ -58,7 +58,7 @@
(def: name-part^
(l.Lexer Text)
- (do p.Monad<Parser>
+ (do p.monad
[head (refine^ (l.not l.decimal)
name-char^)
tail (l.some name-char^)]
@@ -74,13 +74,13 @@
(def: (re-var^ current-module)
(-> Text (l.Lexer Code))
- (do p.Monad<Parser>
+ (do p.monad
[name (l.enclosed ["\@<" ">"] (name^ current-module))]
(wrap (` (: (l.Lexer Text) (~ (code.identifier name)))))))
(def: re-range^
(l.Lexer Code)
- (do p.Monad<Parser>
+ (do p.monad
[from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))
_ (l.this "-")
to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))]
@@ -88,19 +88,19 @@
(def: re-char^
(l.Lexer Code)
- (do p.Monad<Parser>
+ (do p.monad
[char escaped-char^]
(wrap (` ((~! ..copy) (~ (code.text char)))))))
(def: re-options^
(l.Lexer Code)
- (do p.Monad<Parser>
+ (do p.monad
[options (l.many escaped-char^)]
(wrap (` (l.one-of (~ (code.text options)))))))
(def: re-user-class^'
(l.Lexer Code)
- (do p.Monad<Parser>
+ (do p.monad
[negate? (p.maybe (l.this "^"))
parts (p.many ($_ p.either
re-range^
@@ -111,7 +111,7 @@
(def: re-user-class^
(l.Lexer Code)
- (do p.Monad<Parser>
+ (do p.monad
[_ (wrap [])
init re-user-class^'
rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))]
@@ -149,7 +149,7 @@
(def: re-system-class^
(l.Lexer Code)
- (do p.Monad<Parser>
+ (do p.monad
[]
($_ p.either
(p.after (l.this ".") (wrap (` l.any)))
@@ -184,15 +184,15 @@
(def: number^
(l.Lexer Nat)
(|> (l.many l.decimal)
- (p.codec number.Codec<Text,Nat>)))
+ (p.codec number.codec)))
(def: re-back-reference^
(l.Lexer Code)
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[_ (l.this "\")
id number^]
(wrap (` ((~! ..copy) (~ (code.identifier ["" (int/encode (.int id))]))))))
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this "\k<")
captured-name name-part^
_ (l.this ">")]
@@ -209,7 +209,7 @@
(def: (re-simple-quantified^ current-module)
(-> Text (l.Lexer Code))
- (do p.Monad<Parser>
+ (do p.monad
[base (re-simple^ current-module)
quantifier (l.one-of "?*+")]
(case quantifier
@@ -226,7 +226,7 @@
(def: (re-counted-quantified^ current-module)
(-> Text (l.Lexer Code))
- (do p.Monad<Parser>
+ (do p.monad
[base (re-simple^ current-module)]
(l.enclosed ["{" "}"]
($_ p.either
@@ -265,7 +265,7 @@
(-> Text (l.Lexer [Re-Group Code]))
Text
(l.Lexer [Nat Code]))
- (do p.Monad<Parser>
+ (do p.monad
[parts (p.many (p.or (re-complex^ current-module)
(re-scoped^ current-module)))
#let [g!total (code.identifier ["" "0total"])
@@ -279,7 +279,7 @@
[idx
names
(list& (list g!temp complex
- (' #let) (` [(~ g!total) (:: (~! //.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))]))
+ (' #let) (` [(~ g!total) (:: (~! //.monoid) (~' compose) (~ g!total) (~ g!temp))]))
steps)]
(#.Right [(#Capturing [?name num-captures]) scoped])
@@ -295,7 +295,7 @@
[idx!
(list& name! names)
(list& (list name! scoped
- (' #let) (` [(~ g!total) (:: (~! //.Monoid<Text>) (~' compose) (~ g!total) (~ access))]))
+ (' #let) (` [(~ g!total) (:: (~! //.monoid) (~' compose) (~ g!total) (~ access))]))
steps)])
)))
[+0
@@ -305,7 +305,7 @@
(wrap [(if capturing?
(list.size names)
0)
- (` (do p.Monad<Parser>
+ (` (do p.monad
[(~ (' #let)) [(~ g!total) ""]
(~+ (|> steps list.reverse list/join))]
((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))])
@@ -313,7 +313,7 @@
(def: (unflatten^ lexer)
(-> (l.Lexer Text) (l.Lexer [Text Any]))
- (p.and lexer (:: p.Monad<Parser> wrap [])))
+ (p.and lexer (:: p.monad wrap [])))
(def: (|||^ left right)
(All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer [Text (| l r)])))
@@ -356,7 +356,7 @@
(-> Text (l.Lexer [Re-Group Code]))
Text
(l.Lexer [Nat Code]))
- (do p.Monad<Parser>
+ (do p.monad
[#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
head sub^
tail (p.some (p.after (l.this "|") sub^))
@@ -374,22 +374,22 @@
(def: (re-scoped^ current-module)
(-> Text (l.Lexer [Re-Group Code]))
($_ p.either
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this "(?:")
[_ scoped] (re-alternative^ #0 re-scoped^ current-module)
_ (l.this ")")]
(wrap [#Non-Capturing scoped]))
- (do p.Monad<Parser>
+ (do p.monad
[complex (re-complex^ current-module)]
(wrap [#Non-Capturing complex]))
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this "(?<")
captured-name name-part^
_ (l.this ">")
[num-captures pattern] (re-alternative^ #1 re-scoped^ current-module)
_ (l.this ")")]
(wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern]))
- (do p.Monad<Parser>
+ (do p.monad
[_ (l.this "(")
[num-captures pattern] (re-alternative^ #1 re-scoped^ current-module)
_ (l.this ")")]
@@ -397,7 +397,7 @@
(def: (regex^ current-module)
(-> Text (l.Lexer Code))
- (:: p.Monad<Parser> map product.right (re-alternative^ #1 re-scoped^ current-module)))
+ (:: p.monad map product.right (re-alternative^ #1 re-scoped^ current-module)))
## [Syntax]
(syntax: #export (regex {pattern s.text})
diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux
index 4cc1f66bc..cc783e177 100644
--- a/stdlib/source/lux/data/text/unicode.lux
+++ b/stdlib/source/lux/data/text/unicode.lux
@@ -4,29 +4,29 @@
["." interval (#+ Interval)]
[monoid (#+ Monoid)]]
[data
- ["." number (#+ hex) ("nat/." Interval<Nat>)]
+ [number (#+ hex)
+ ["." nat ("nat/." interval)]]
[collection
["." list]
[tree
["." finger (#+ Tree)]]]]
[type
- abstract]])
-
-(type: #export Char Nat)
+ abstract]]
+ [// (#+ Char)])
(abstract: #export Segment
{}
(Interval Char)
- (def: empty (:abstraction (interval.between number.Enum<Nat> nat/top nat/bottom)))
+ (def: empty (:abstraction (interval.between nat.enum nat/top nat/bottom)))
- (structure: _ (Monoid Segment)
+ (structure: monoid (Monoid Segment)
(def: identity ..empty)
(def: (compose left right)
(let [left (:representation left)
right (:representation right)]
(:abstraction
- (interval.between number.Enum<Nat>
+ (interval.between nat.enum
(n/min (:: left bottom)
(:: right bottom))
(n/max (:: left top)
@@ -34,7 +34,7 @@
(def: #export (segment start end)
(-> Char Char Segment)
- (:abstraction (interval.between number.Enum<Nat> (n/min start end) (n/max start end))))
+ (:abstraction (interval.between nat.enum (n/min start end) (n/max start end))))
(do-template [<name> <slot>]
[(def: #export <name>
@@ -192,20 +192,20 @@
(def: (singleton segment)
(-> Segment Set)
- {#finger.monoid Monoid<Segment>
+ {#finger.monoid ..monoid
#finger.node (#finger.Leaf segment [])})
(def: #export (set segments)
(-> (List Segment) Set)
(case segments
(^ (list))
- (..singleton (:: Monoid<Segment> identity))
+ (..singleton (:: ..monoid identity))
(^ (list singleton))
(..singleton singleton)
(^ (list left right))
- (..singleton (:: Monoid<Segment> compose left right))
+ (..singleton (:: ..monoid compose left right))
_
(let [[sides extra] (n//% 2 (list.size segments))
diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux
index 36d5acdf0..055d1758c 100644
--- a/stdlib/source/lux/data/trace.lux
+++ b/stdlib/source/lux/data/trace.lux
@@ -10,12 +10,12 @@
{#monoid (Monoid t)
#trace (-> t a)})
-(structure: #export Functor<Trace> (All [t] (Functor (Trace t)))
+(structure: #export functor (All [t] (Functor (Trace t)))
(def: (map f fa)
(update@ #trace (compose f) fa)))
-(structure: #export CoMonad<Trace> (All [t] (CoMonad (Trace t)))
- (def: functor Functor<Trace>)
+(structure: #export comonad (All [t] (CoMonad (Trace t)))
+ (def: &functor ..functor)
(def: (unwrap wa)
((get@ #trace wa)
diff --git a/stdlib/source/lux/function.lux b/stdlib/source/lux/function.lux
index ca6ebb73e..65202e361 100644
--- a/stdlib/source/lux/function.lux
+++ b/stdlib/source/lux/function.lux
@@ -34,6 +34,6 @@
(-> (-> a b c) (-> b a c)))
(function (_ x y) (f y x)))
-(structure: #export Monoid<Function> (All [a] (Monoid (-> a a)))
+(structure: #export monoid (All [a] (Monoid (-> a a)))
(def: identity ..identity)
(def: compose ..compose))
diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux
index 0302064b3..eb6123ef8 100644
--- a/stdlib/source/lux/host.js.lux
+++ b/stdlib/source/lux/host.js.lux
@@ -5,7 +5,7 @@
["p" parser]]
[data
[collection
- [list #* ("list/." Fold<List>)]]]
+ [list #* ("list/." fold)]]]
[macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax: Syntax)]]])
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 6da77945f..7c27c9f63 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -8,16 +8,16 @@
["." maybe]
["." product]
["." error (#+ Error)]
- [bit ("bit/." Codec<Text,Bit>)]
+ [bit ("bit/." codec)]
number
- ["." text ("text/." Equivalence<Text> Monoid<Text>)
+ ["." text ("text/." equivalence monoid)
format]
[collection
["." array (#+ Array)]
- ["." list ("list/." Monad<List> Fold<List> Monoid<List>)]]]
+ ["." list ("list/." monad fold monoid)]]]
["." function]
- ["." type ("type/." Equivalence<Type>)]
- ["." macro (#+ with-gensyms Functor<Meta> Monad<Meta>)
+ ["." type ("type/." equivalence)]
+ ["." macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax: Syntax)]]
["." io]])
@@ -25,10 +25,8 @@
(do-template [<name> <op> <from> <to>]
[(def: #export (<name> value)
{#.doc (doc "Type converter."
- "From:"
- <from>
- "To:"
- <to>)}
+ (: <to>
+ (<name> (: <from> foo))))}
(-> (primitive <from>) (primitive <to>))
(<op> value))]
@@ -352,7 +350,7 @@
(def: (get-import name imports)
(-> Text Class-Imports (Maybe Text))
- (:: maybe.Functor<Maybe> map product.right
+ (:: maybe.functor map product.right
(list.find (|>> product.left (text/= name))
imports)))
@@ -364,7 +362,7 @@
(-> Lux Class-Imports)
(case (macro.run compiler
(: (Meta Class-Imports)
- (do Monad<Meta>
+ (do macro.monad
[current-module macro.current-module-name
definitions (macro.definitions current-module)]
(wrap (list/fold (: (-> [Text Definition] Class-Imports Class-Imports)
@@ -465,7 +463,7 @@
(def: (qualify imports name)
(-> Class-Imports Text Text)
- (if (list.member? text.Equivalence<Text> java/lang/* name)
+ (if (list.member? text.equivalence java/lang/* name)
(format "java/lang/" name)
(maybe.default name (get-import name imports))))
@@ -517,21 +515,21 @@
(def: (make-get-const-parser class-name field-name)
(-> Text Text (Syntax Code))
- (do p.Monad<Parser>
+ (do p.monad
[#let [dotted-name (format "::" field-name)]
_ (s.this (code.identifier ["" dotted-name]))]
(wrap (`' ((~ (code.text (format "jvm getstatic" ":" class-name ":" field-name))))))))
(def: (make-get-var-parser class-name field-name)
(-> Text Text (Syntax Code))
- (do p.Monad<Parser>
+ (do p.monad
[#let [dotted-name (format "::" field-name)]
_ (s.this (code.identifier ["" dotted-name]))]
(wrap (`' ((~ (code.text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this)))))
(def: (make-put-var-parser class-name field-name)
(-> Text Text (Syntax Code))
- (do p.Monad<Parser>
+ (do p.monad
[#let [dotted-name (format "::" field-name)]
[_ _ value] (: (Syntax [Any Any Code])
(s.form ($_ p.and (s.this (' :=)) (s.this (code.identifier ["" dotted-name])) s.any)))]
@@ -577,7 +575,7 @@
(def: (make-constructor-parser params class-name arg-decls)
(-> (List Type-Paramameter) Text (List ArgDecl) (Syntax Code))
- (do p.Monad<Parser>
+ (do p.monad
[args (: (Syntax (List Code))
(s.form (p.after (s.this (' ::new!))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
@@ -587,7 +585,7 @@
(def: (make-static-method-parser params class-name method-name arg-decls)
(-> (List Type-Paramameter) Text Text (List ArgDecl) (Syntax Code))
- (do p.Monad<Parser>
+ (do p.monad
[#let [dotted-name (format "::" method-name "!")]
args (: (Syntax (List Code))
(s.form (p.after (s.this (code.identifier ["" dotted-name]))
@@ -599,7 +597,7 @@
(do-template [<name> <jvm-op>]
[(def: (<name> params class-name method-name arg-decls)
(-> (List Type-Paramameter) Text Text (List ArgDecl) (Syntax Code))
- (do p.Monad<Parser>
+ (do p.monad
[#let [dotted-name (format "::" method-name "!")]
args (: (Syntax (List Code))
(s.form (p.after (s.this (code.identifier ["" dotted-name]))
@@ -634,13 +632,13 @@
## Syntaxes
(def: (full-class-name^ imports)
(-> Class-Imports (Syntax Text))
- (do p.Monad<Parser>
+ (do p.monad
[name s.local-identifier]
(wrap (qualify imports name))))
(def: privacy-modifier^
(Syntax PrivacyModifier)
- (let [(^open ".") p.Monad<Parser>]
+ (let [(^open ".") p.monad]
($_ p.or
(s.this (' #public))
(s.this (' #private))
@@ -649,7 +647,7 @@
(def: inheritance-modifier^
(Syntax InheritanceModifier)
- (let [(^open ".") p.Monad<Parser>]
+ (let [(^open ".") p.monad]
($_ p.or
(s.this (' #final))
(s.this (' #abstract))
@@ -668,21 +666,21 @@
(def: (generic-type^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax GenericType))
($_ p.either
- (do p.Monad<Parser>
+ (do p.monad
[_ (s.this (' ?))]
(wrap (#GenericWildcard #.None)))
- (s.tuple (do p.Monad<Parser>
+ (s.tuple (do p.monad
[_ (s.this (' ?))
bound-kind bound-kind^
bound (generic-type^ imports type-vars)]
(wrap (#GenericWildcard (#.Some [bound-kind bound])))))
- (do p.Monad<Parser>
+ (do p.monad
[name (full-class-name^ imports)
_ (assert-no-periods name)]
- (if (list.member? text.Equivalence<Text> (list/map product.left type-vars) name)
+ (if (list.member? text.equivalence (list/map product.left type-vars) name)
(wrap (#GenericTypeVar name))
(wrap (#GenericClass name (list)))))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[name (s.this (' Array))
component (generic-type^ imports type-vars)]
(case component
@@ -700,21 +698,21 @@
_
(wrap (#GenericArray component)))))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[name (full-class-name^ imports)
_ (assert-no-periods name)
params (p.some (generic-type^ imports type-vars))
_ (p.assert (format name " cannot be a type-parameter!")
- (not (list.member? text.Equivalence<Text> (list/map product.left type-vars) name)))]
+ (not (list.member? text.equivalence (list/map product.left type-vars) name)))]
(wrap (#GenericClass name params))))
))
(def: (type-param^ imports)
(-> Class-Imports (Syntax Type-Paramameter))
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[param-name s.local-identifier]
(wrap [param-name (list)]))
- (s.tuple (do p.Monad<Parser>
+ (s.tuple (do p.monad
[param-name s.local-identifier
_ (s.this (' <))
bounds (p.many (generic-type^ imports (list)))]
@@ -726,11 +724,11 @@
(def: (class-decl^ imports)
(-> Class-Imports (Syntax Class-Declaration))
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[name (full-class-name^ imports)
_ (assert-no-periods name)]
(wrap [name (list)]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[name (full-class-name^ imports)
_ (assert-no-periods name)
params (p.some (type-param^ imports))]
@@ -739,11 +737,11 @@
(def: (super-class-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax Super-Class-Decl))
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[name (full-class-name^ imports)
_ (assert-no-periods name)]
(wrap [name (list)]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[name (full-class-name^ imports)
_ (assert-no-periods name)
params (p.some (generic-type^ imports type-vars))]
@@ -755,7 +753,7 @@
(def: (annotation^ imports)
(-> Class-Imports (Syntax Annotation))
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[ann-name (full-class-name^ imports)]
(wrap [ann-name (list)]))
(s.form (p.and (full-class-name^ imports)
@@ -763,31 +761,31 @@
(def: (annotations^' imports)
(-> Class-Imports (Syntax (List Annotation)))
- (do p.Monad<Parser>
+ (do p.monad
[_ (s.this (' #ann))]
(s.tuple (p.some (annotation^ imports)))))
(def: (annotations^ imports)
(-> Class-Imports (Syntax (List Annotation)))
- (do p.Monad<Parser>
+ (do p.monad
[anns?? (p.maybe (annotations^' imports))]
(wrap (maybe.default (list) anns??))))
(def: (throws-decl'^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax (List GenericType)))
- (do p.Monad<Parser>
+ (do p.monad
[_ (s.this (' #throws))]
(s.tuple (p.some (generic-type^ imports type-vars)))))
(def: (throws-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax (List GenericType)))
- (do p.Monad<Parser>
+ (do p.monad
[exs? (p.maybe (throws-decl'^ imports type-vars))]
(wrap (maybe.default (list) exs?))))
(def: (method-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration MethodDecl]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[tvars (p.default (list) (type-params^ imports))
name s.local-identifier
anns (annotations^ imports)
@@ -804,18 +802,18 @@
($_ p.or
(s.this (' #volatile))
(s.this (' #final))
- (:: p.Monad<Parser> wrap [])))
+ (:: p.monad wrap [])))
(def: (field-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration FieldDecl]))
- (p.either (s.form (do p.Monad<Parser>
+ (p.either (s.form (do p.monad
[_ (s.this (' #const))
name s.local-identifier
anns (annotations^ imports)
type (generic-type^ imports type-vars)
body s.any]
(wrap [[name #PublicPM anns] (#ConstantField [type body])])))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[pm privacy-modifier^
sm state-modifier^
name s.local-identifier
@@ -842,7 +840,7 @@
(def: (constructor-method^ imports class-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration Method-Definition]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[pm privacy-modifier^
strict-fp? (s.this? (' #strict))
method-vars (p.default (list) (type-params^ imports))
@@ -860,7 +858,7 @@
(def: (virtual-method-def^ imports class-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration Method-Definition]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[pm privacy-modifier^
strict-fp? (s.this? (' #strict))
final? (s.this? (' #final))
@@ -879,7 +877,7 @@
(def: (overriden-method-def^ imports)
(-> Class-Imports (Syntax [Member-Declaration Method-Definition]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[strict-fp? (s.this? (' #strict))
owner-class (class-decl^ imports)
method-vars (p.default (list) (type-params^ imports))
@@ -897,7 +895,7 @@
(def: (static-method-def^ imports)
(-> Class-Imports (Syntax [Member-Declaration Method-Definition]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[pm privacy-modifier^
strict-fp? (s.this? (' #strict))
_ (s.this (' #static))
@@ -916,7 +914,7 @@
(def: (abstract-method-def^ imports)
(-> Class-Imports (Syntax [Member-Declaration Method-Definition]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[pm privacy-modifier^
_ (s.this (' #abstract))
method-vars (p.default (list) (type-params^ imports))
@@ -933,7 +931,7 @@
(def: (native-method-def^ imports)
(-> Class-Imports (Syntax [Member-Declaration Method-Definition]))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[pm privacy-modifier^
_ (s.this (' #native))
method-vars (p.default (list) (type-params^ imports))
@@ -964,17 +962,17 @@
(def: class-kind^
(Syntax Class-Kind)
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[_ (s.this (' #class))]
(wrap #Class))
- (do p.Monad<Parser>
+ (do p.monad
[_ (s.this (' #interface))]
(wrap #Interface))
))
(def: import-member-alias^
(Syntax (Maybe Text))
- (p.maybe (do p.Monad<Parser>
+ (p.maybe (do p.monad
[_ (s.this (' #as))]
s.local-identifier)))
@@ -994,11 +992,11 @@
(def: (import-member-decl^ imports owner-vars)
(-> Class-Imports (List Type-Paramameter) (Syntax Import-Member-Declaration))
($_ p.either
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[_ (s.this (' #enum))
enum-members (p.some s.local-identifier)]
(wrap (#EnumDecl enum-members))))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[tvars (p.default (list) (type-params^ imports))
_ (s.this (' new))
?alias import-member-alias^
@@ -1016,7 +1014,7 @@
#import-member-io? io?}
{}]))
))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[kind (: (Syntax ImportMethodKind)
(p.or (s.this (' #static))
(wrap [])))
@@ -1039,7 +1037,7 @@
{#import-method-name name
#import-method-return return
}]))))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[static? (s.this? (' #static))
name s.local-identifier
?prim-mode (p.maybe primitive-mode^)
@@ -1207,7 +1205,7 @@
(code.to-text (pre-walk-replace replacer body)))))
(#OverridenMethod strict-fp? class-decl type-vars arg-decls return-type body exs)
- (let [super-replacer (parser->replacer (s.form (do p.Monad<Parser>
+ (let [super-replacer (parser->replacer (s.form (do p.monad
[_ (s.this (' ::super!))
args (s.tuple (p.exactly (list.size arg-decls) s.any))
#let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ (list)))
@@ -1324,7 +1322,7 @@
"(::new! []) for calling the class's constructor."
"(::resolve! container [value]) for calling the 'resolve' method."
)}
- (do Monad<Meta>
+ (do macro.monad
[current-module macro.current-module-name
#let [fully-qualified-class-name (format (sanitize current-module) "." full-class-name)
field-parsers (list/map (field->parser fully-qualified-class-name) fields)
@@ -1522,7 +1520,7 @@
(case member
(^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
(let [(^slots [#import-member-tvars #import-member-args]) commons]
- (do Monad<Meta>
+ (do macro.monad
[arg-inputs (monad.map @
(: (-> [Bit GenericType] (Meta [Bit Code]))
(function (_ [maybe? _])
@@ -1542,7 +1540,7 @@
(wrap [arg-inputs arg-classes arg-types])))
_
- (:: Monad<Meta> wrap [(list) (list) (list)])))
+ (:: macro.monad wrap [(list) (list) (list)])))
(def: (decorate-return-maybe member return-term)
(-> Import-Member-Declaration Code Code)
@@ -1628,7 +1626,7 @@
(list/map type-param->type-arg))]
(case member
(#EnumDecl enum-members)
- (do Monad<Meta>
+ (do macro.monad
[#let [enum-type (: Code
(case class-tvars
#.Nil
@@ -1648,7 +1646,7 @@
(wrap (list/map getter-interop enum-members)))
(#ConstructorDecl [commons _])
- (do Monad<Meta>
+ (do macro.monad
[#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
jvm-extension (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes)))
jvm-interop (|> (` ((~ jvm-extension)
@@ -1696,7 +1694,7 @@
((~' wrap) (.list (.` (~ jvm-interop))))))))))
(#FieldAccessDecl fad)
- (do Monad<Meta>
+ (do macro.monad
[#let [(^open ".") fad
base-gtype (class->type import-field-mode type-params import-field-type)
classC (class-decl-type$ class)
@@ -1757,7 +1755,7 @@
method-prefix (if long-name?
full-name
(short-class-name full-name))]
- (do Monad<Meta>
+ (do macro.monad
[=args (member-def-arg-bindings type-params class member)]
(member-def-interop type-params kind class =args member method-prefix))))
@@ -1774,7 +1772,7 @@
(let [class-name (sanitize class-name)]
(case (load-class class-name)
(#.Right class)
- (:: Monad<Meta> wrap (if (interface? class)
+ (:: macro.monad wrap (if (interface? class)
#Interface
#Class))
@@ -1835,7 +1833,7 @@
(java/util/List::size [] my-list)
Character$UnicodeScript::LATIN
)}
- (do Monad<Meta>
+ (do macro.monad
[kind (class-kind class-decl)
=members (monad.map @ (member-import$ (product.right class-decl) long-name? kind class-decl) members)]
(wrap (list& (class-import$ long-name? class-decl) (list/join =members)))))
@@ -1869,10 +1867,10 @@
(def: (type->class-name type)
(-> Type (Meta Text))
(if (type/= Any type)
- (:: Monad<Meta> wrap "java.lang.Object")
+ (:: macro.monad wrap "java.lang.Object")
(case type
(#.Primitive name params)
- (:: Monad<Meta> wrap name)
+ (:: macro.monad wrap name)
(#.Apply A F)
(case (type.apply (list A) F)
@@ -1893,7 +1891,7 @@
(array-read 10 my-array))}
(case array
[_ (#.Identifier array-name)]
- (do Monad<Meta>
+ (do macro.monad
[array-type (macro.find-type array-name)
array-jvm-type (type->class-name array-type)]
(case array-jvm-type
@@ -1922,7 +1920,7 @@
(array-write 10 my-object my-array))}
(case array
[_ (#.Identifier array-name)]
- (do Monad<Meta>
+ (do macro.monad
[array-type (macro.find-type array-name)
array-jvm-type (type->class-name array-type)]
(case array-jvm-type
@@ -1957,7 +1955,7 @@
"Afterwards, closes all resources (assumed to be subclasses of java.io.Closeable), and returns the value resulting from running the body."
(with-open [my-res1 (res1-constructor ___)
my-res2 (res1-constructor ___)]
- (do io.Monad<IO>
+ (do io.monad
[foo (do-something my-res1)
bar (do-something-else my-res2)]
(do-one-last-thing foo bar))))}
@@ -1968,7 +1966,7 @@
closes (list/map (function (_ res)
(` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.identifier ["" (product.left res)]))))))
bindings)]
- (wrap (list (` (do (~! io.Monad<IO>)
+ (wrap (list (` (do (~! io.monad)
[(~+ inits)
(~ g!output) (~ body)
(~' #let) [(~ g!_) (exec (~+ (list.reverse closes)) [])]]
@@ -1991,7 +1989,7 @@
=>
"java.lang.String")}
(-> Text (Meta Text))
- (do Monad<Meta>
+ (do macro.monad
[*compiler* get-compiler]
(wrap (qualify (class-imports *compiler*) class))))
diff --git a/stdlib/source/lux/host/jvm/attribute.lux b/stdlib/source/lux/host/jvm/attribute.lux
index 41928e704..9008dd658 100644
--- a/stdlib/source/lux/host/jvm/attribute.lux
+++ b/stdlib/source/lux/host/jvm/attribute.lux
@@ -22,13 +22,13 @@
#length U4
#info about})
-(def: #export (Equivalence<Info> Equivalence<about>)
+(def: #export (info-equivalence Equivalence<about>)
(All [about]
(-> (Equivalence about)
(Equivalence (Info about))))
($_ equivalence.product
- //index.Equivalence<Index>
- //encoding.Equivalence<U4>
+ //index.equivalence
+ //encoding.u4-equivalence
Equivalence<about>))
(def: (info-format about)
@@ -43,9 +43,9 @@
(type: #export Constant
(Info (Index (Value Any))))
-(def: #export Equivalence<Constant>
+(def: #export constant-equivalence
(Equivalence Constant)
- (..Equivalence<Info> //index.Equivalence<Index>))
+ (..info-equivalence //index.equivalence))
(def: constant-format
(Format Constant)
@@ -76,14 +76,14 @@
## <Code>)
)
-(def: #export Equivalence<Attribute>
+(def: #export equivalence
(Equivalence Attribute)
- ..Equivalence<Constant>)
+ ..constant-equivalence)
(def: #export (constant index)
(-> (Index (Value Any))
(State Pool Attribute))
- (do state.Monad<State>
+ (do state.monad
[@name (//pool.utf8 "ConstantValue")]
(wrap (#Constant {#name @name
#length (//encoding.to-u4 //encoding.u2-bytes)
@@ -91,7 +91,7 @@
## (def: #export (code specification)
## (-> Code' (State Pool Attribute))
-## (do state.Monad<State>
+## (do state.monad
## [@name (//pool.utf8 "Code")]
## (wrap (#Code {#name @name
## #length (undefined)
diff --git a/stdlib/source/lux/host/jvm/class.lux b/stdlib/source/lux/host/jvm/class.lux
index 30959c8ef..0c7bfd0da 100644
--- a/stdlib/source/lux/host/jvm/class.lux
+++ b/stdlib/source/lux/host/jvm/class.lux
@@ -52,27 +52,27 @@
#methods (Row Method)
#attributes (Row Attribute)})
-(def: #export Equivalence<Class>
+(def: #export equivalence
(Equivalence Class)
($_ equivalence.product
- //encoding.Equivalence<U4>
- //encoding.Equivalence<U2>
- //encoding.Equivalence<U2>
- //pool.Equivalence<Pool>
- ..Equivalence<Modifier>
- //index.Equivalence<Index>
- //index.Equivalence<Index>
- (row.Equivalence<Row> //index.Equivalence<Index>)
- (row.Equivalence<Row> //field.Equivalence<Field>)
- (row.Equivalence<Row> //method.Equivalence<Method>)
- (row.Equivalence<Row> //attribute.Equivalence<Attribute>)))
+ //encoding.u4-equivalence
+ //encoding.u2-equivalence
+ //encoding.u2-equivalence
+ //pool.equivalence
+ ..modifier-equivalence
+ //index.equivalence
+ //index.equivalence
+ (row.equivalence //index.equivalence)
+ (row.equivalence //field.equivalence)
+ (row.equivalence //method.equivalence)
+ (row.equivalence //attribute.equivalence)))
(def: default-minor-version Minor (//version.version 0))
(def: (install-classes this super interfaces)
(-> Internal Internal (List Internal)
(State Pool [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))]))
- (do state.Monad<State>
+ (do state.monad
[@this (//pool.class (//name.read this))
@super (//pool.class (//name.read super))
@interfaces (: (State Pool (Row (Index //constant.Class)))
@@ -95,9 +95,9 @@
Class)
(let [[pool [@this @super @interfaces] =fields]
(state.run //pool.empty
- (do state.Monad<State>
+ (do state.monad
[classes (install-classes this super interfaces)
- =fields (monad.seq state.Monad<State> fields)]
+ =fields (monad.seq state.monad fields)]
(wrap [classes =fields])))]
{#magic //magic.code
#minor-version ..default-minor-version
diff --git a/stdlib/source/lux/host/jvm/constant.lux b/stdlib/source/lux/host/jvm/constant.lux
index 7f87136a5..1395e6d5a 100644
--- a/stdlib/source/lux/host/jvm/constant.lux
+++ b/stdlib/source/lux/host/jvm/constant.lux
@@ -5,10 +5,12 @@
["." parser]
["." equivalence (#+ Equivalence)]]
[data
- ["." number]
+ [number
+ ["." int]
+ ["." frac]]
["." text]
[format
- ["." binary (#+ Format) ("mutation/." Monoid<Mutation>)]]
+ ["." binary (#+ Format) ("mutation/." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -18,7 +20,7 @@
["//." index (#+ Index)]
[descriptor (#+ Descriptor)]]
[/
- ["/." tag ("tag/." Equivalence<Tag>)]])
+ ["/." tag ("tag/." equivalence)]])
(type: #export UTF8 Text)
@@ -35,11 +37,11 @@
(-> (Index UTF8) Class)
(|>> :abstraction))
- (def: #export Equivalence<Class>
+ (def: #export class-equivalence
(Equivalence Class)
- (:: equivalence.Contravariant<Equivalence> map-1
+ (:: equivalence.contravariant map-1
(|>> :representation)
- //index.Equivalence<Index>))
+ //index.equivalence))
(def: class-format
(Format Class)
@@ -58,11 +60,11 @@
(All [kind] (-> (Value kind) kind))
(|>> :representation))
- (def: #export (Equivalence<Value> Equivalence<kind>)
+ (def: #export (value-equivalence Equivalence<kind>)
(All [kind]
(-> (Equivalence kind)
(Equivalence (Value kind))))
- (:: equivalence.Contravariant<Equivalence> map-1
+ (:: equivalence.contravariant map-1
(|>> :representation)
Equivalence<kind>))
@@ -88,7 +90,7 @@
<base>))]
[long-format Long .int (<|) binary.bits/64]
- [double-format Double number.bits-to-frac number.frac-to-bits binary.bits/64]
+ [double-format Double frac.bits-to-frac frac.frac-to-bits binary.bits/64]
[string-format String (<|) (<|) //index.format]
)
)
@@ -105,8 +107,8 @@
[(def: #export <equivalence>
(Equivalence <type>)
($_ equivalence.product
- //index.Equivalence<Index>
- //index.Equivalence<Index>))
+ //index.equivalence
+ //index.equivalence))
(def: #export <format>
(Format <type>)
@@ -114,8 +116,8 @@
//index.format
//index.format))]
- [Name-And-Type Equivalence<Name-And-Type> name-and-type-format]
- [Reference Equivalence<Reference> reference-format]
+ [Name-And-Type name-and-type-equivalence name-and-type-format]
+ [Reference reference-equivalence reference-format]
)
(type: #export Constant
@@ -129,27 +131,27 @@
(#Interface-Method Reference)
(#Name-And-Type Name-And-Type))
-(def: #export Equivalence<Constant>
+(def: #export equivalence
(Equivalence Constant)
($_ equivalence.sum
## #UTF8
- text.Equivalence<Text>
+ text.equivalence
## #Long
- (..Equivalence<Value> number.Equivalence<Int>)
+ (..value-equivalence int.equivalence)
## #Double
- (..Equivalence<Value> number.Equivalence<Frac>)
+ (..value-equivalence frac.equivalence)
## #Class
- ..Equivalence<Class>
+ ..class-equivalence
## #String
- (..Equivalence<Value> //index.Equivalence<Index>)
+ (..value-equivalence //index.equivalence)
## #Field
- ..Equivalence<Reference>
+ ..reference-equivalence
## #Method
- ..Equivalence<Reference>
+ ..reference-equivalence
## #Interface-Method
- ..Equivalence<Reference>
+ ..reference-equivalence
## #Name-And-Type
- ..Equivalence<Name-And-Type>
+ ..name-and-type-equivalence
))
(def: #export format
@@ -169,7 +171,7 @@
## TODO: Method-Type
## TODO: Invoke-Dynamic
)]
- {#binary.reader (do parser.Monad<Parser>
+ {#binary.reader (do parser.monad
[tag (get@ #binary.reader /tag.format)]
(`` (cond (~~ (do-template [<case> <tag> <format>]
[(tag/= <tag> tag)
diff --git a/stdlib/source/lux/host/jvm/constant/pool.lux b/stdlib/source/lux/host/jvm/constant/pool.lux
index d1da6f606..7e3119222 100644
--- a/stdlib/source/lux/host/jvm/constant/pool.lux
+++ b/stdlib/source/lux/host/jvm/constant/pool.lux
@@ -5,15 +5,15 @@
[monad (#+ do)]
["." state (#+ State)]]
[data
- [text ("text/." Equivalence<Text>)]
+ [text ("text/." equivalence)]
[format
["." binary (#+ Format)]]
[collection
- [list ("list/." Fold<List>)]
+ [list ("list/." fold)]
["." row (#+ Row)]]]
[type
abstract]]
- ["." // (#+ UTF8 Class Constant) ("class/." Equivalence<Class>)
+ ["." // (#+ UTF8 Class Constant) ("class/." class-equivalence)
[//
["." encoding]
["." index (#+ Index)]
@@ -23,9 +23,9 @@
(type: #export Pool (Row Constant))
-(def: #export Equivalence<Pool>
+(def: #export equivalence
(Equivalence Pool)
- (row.Equivalence<Row> //.Equivalence<Constant>))
+ (row.equivalence //.equivalence))
(template: (!add <value> <tag> <=>)
(function (_ pool)
@@ -58,7 +58,7 @@
(def: #export (class name)
(-> UTF8 (State Pool (Index Class)))
- (do state.Monad<State>
+ (do state.monad
[@name (utf8 name)]
(class' (//.class @name))))
diff --git a/stdlib/source/lux/host/jvm/constant/tag.lux b/stdlib/source/lux/host/jvm/constant/tag.lux
index 8e34d975d..3862f5158 100644
--- a/stdlib/source/lux/host/jvm/constant/tag.lux
+++ b/stdlib/source/lux/host/jvm/constant/tag.lux
@@ -8,14 +8,14 @@
[type
abstract]]
[///
- ["." encoding (#+ U1) ("u1/." Equivalence<U1>)]])
+ ["." encoding (#+ U1) ("u1/." u1-equivalence)]])
(abstract: #export Tag
{}
U1
- (structure: #export _ (Equivalence Tag)
+ (structure: #export equivalence (Equivalence Tag)
(def: (= reference sample)
(u1/= (:representation reference)
(:representation sample))))
diff --git a/stdlib/source/lux/host/jvm/descriptor.lux b/stdlib/source/lux/host/jvm/descriptor.lux
index 9b6e4088f..ffa7e566e 100644
--- a/stdlib/source/lux/host/jvm/descriptor.lux
+++ b/stdlib/source/lux/host/jvm/descriptor.lux
@@ -4,7 +4,7 @@
["." text
format]
[collection
- [list ("list/." Functor<List>)]]]
+ [list ("list/." functor)]]]
[type
abstract]]
[//
diff --git a/stdlib/source/lux/host/jvm/encoding.lux b/stdlib/source/lux/host/jvm/encoding.lux
index 2b2c487ec..ca6875eca 100644
--- a/stdlib/source/lux/host/jvm/encoding.lux
+++ b/stdlib/source/lux/host/jvm/encoding.lux
@@ -2,7 +2,7 @@
[lux #*
[control
[equivalence (#+ Equivalence)]
- [parser ("parser/." Functor<Parser>)]]
+ [parser ("parser/." functor)]]
[data
[number
["." i64]]
@@ -11,7 +11,7 @@
[type
abstract]])
-(do-template [<bytes> <name> <size> <to> <from>]
+(do-template [<bytes> <name> <size> <to> <from> <equivalence>]
[(abstract: #export <name>
{}
@@ -30,14 +30,14 @@
(-> <name> (I64 Any))
(|>> :representation))
- (structure: #export _ (Equivalence <name>)
+ (structure: #export <equivalence> (Equivalence <name>)
(def: (= reference sample)
("lux i64 =" (:representation reference) (:representation sample))))
)]
- [1 U1 u1-bytes to-u1 from-u1]
- [2 U2 u2-bytes to-u2 from-u2]
- [4 U4 u4-bytes to-u4 from-u4]
+ [1 U1 u1-bytes to-u1 from-u1 u1-equivalence]
+ [2 U2 u2-bytes to-u2 from-u2 u2-equivalence]
+ [4 U4 u4-bytes to-u4 from-u4 u4-equivalence]
)
(do-template [<name> <type> <format> <pre-write> <post-read>]
diff --git a/stdlib/source/lux/host/jvm/field.lux b/stdlib/source/lux/host/jvm/field.lux
index 3e1de173a..69e0400ea 100644
--- a/stdlib/source/lux/host/jvm/field.lux
+++ b/stdlib/source/lux/host/jvm/field.lux
@@ -42,13 +42,13 @@
#descriptor (Index (Descriptor (Value Any)))
#attributes (Row Attribute)})
-(def: #export Equivalence<Field>
+(def: #export equivalence
(Equivalence Field)
($_ equivalence.product
- ..Equivalence<Modifier>
- //index.Equivalence<Index>
- //index.Equivalence<Index>
- (row.Equivalence<Row> //attribute.Equivalence<Attribute>)))
+ ..modifier-equivalence
+ //index.equivalence
+ //index.equivalence
+ (row.equivalence //attribute.equivalence)))
(def: #export format
(Format Field)
@@ -61,7 +61,7 @@
(def: #export (field modifier name descriptor attributes)
(-> Modifier UTF8 (Descriptor (Value Any)) (Row Attribute)
(State Pool Field))
- (do state.Monad<State>
+ (do state.monad
[@name (//pool.utf8 name)
@descriptor (//pool.descriptor descriptor)]
(wrap {#modifier modifier
diff --git a/stdlib/source/lux/host/jvm/index.lux b/stdlib/source/lux/host/jvm/index.lux
index 3bf7e150b..69232edb4 100644
--- a/stdlib/source/lux/host/jvm/index.lux
+++ b/stdlib/source/lux/host/jvm/index.lux
@@ -19,11 +19,11 @@
(All [kind] (-> U2 (Index kind)))
(|>> :abstraction))
- (def: #export Equivalence<Index>
+ (def: #export equivalence
(All [kind] (Equivalence (Index kind)))
- (:: equivalence.Contravariant<Equivalence> map-1
+ (:: equivalence.contravariant map-1
(|>> :representation)
- //encoding.Equivalence<U2>))
+ //encoding.u2-equivalence))
(def: #export format
(All [kind] (Format (Index kind)))
diff --git a/stdlib/source/lux/host/jvm/loader.jvm.lux b/stdlib/source/lux/host/jvm/loader.jvm.lux
index b4d5089d4..1a19c2e1e 100644
--- a/stdlib/source/lux/host/jvm/loader.jvm.lux
+++ b/stdlib/source/lux/host/jvm/loader.jvm.lux
@@ -11,7 +11,7 @@
format]
[collection
["." array]
- ["." list ("list/." Functor<List>)]
+ ["." list ("list/." functor)]
["." dictionary (#+ Dictionary)]]]
["." io (#+ IO)]
[world
@@ -87,7 +87,7 @@
(def: #export (new-library _)
(-> Any Library)
- (atom.atom (dictionary.new text.Hash<Text>)))
+ (atom.atom (dictionary.new text.hash)))
(def: #export (memory library)
(-> Library java/lang/ClassLoader)
@@ -110,7 +110,7 @@
(def: #export (store name bytecode library)
(-> Text Binary Library (IO (Error Any)))
- (do io.Monad<IO>
+ (do io.monad
[library' (atom.read library)]
(if (dictionary.contains? name library')
(wrap (ex.throw ..already-stored name))
diff --git a/stdlib/source/lux/host/jvm/method.lux b/stdlib/source/lux/host/jvm/method.lux
index 7bdc147da..c2342cd03 100644
--- a/stdlib/source/lux/host/jvm/method.lux
+++ b/stdlib/source/lux/host/jvm/method.lux
@@ -44,13 +44,13 @@
#descriptor (Index (Descriptor //descriptor.Method))
#attributes (Row Attribute)})
-(def: #export Equivalence<Method>
+(def: #export equivalence
(Equivalence Method)
($_ equivalence.product
- ..Equivalence<Modifier>
- //index.Equivalence<Index>
- //index.Equivalence<Index>
- (row.Equivalence<Row> //attribute.Equivalence<Attribute>)))
+ ..modifier-equivalence
+ //index.equivalence
+ //index.equivalence
+ (row.equivalence //attribute.equivalence)))
(def: #export format
(Format Method)
diff --git a/stdlib/source/lux/host/jvm/modifier.lux b/stdlib/source/lux/host/jvm/modifier.lux
index 8451c3107..41d84a59b 100644
--- a/stdlib/source/lux/host/jvm/modifier.lux
+++ b/stdlib/source/lux/host/jvm/modifier.lux
@@ -10,7 +10,7 @@
[format
["." binary]]
[collection
- [list ("list/." Functor<List>)]]]
+ [list ("list/." functor)]]]
[type
["." abstract]]
[macro (#+ with-gensyms)
@@ -56,15 +56,15 @@
(.do-template [(~ g!<code>) (~ g!<name>)]
[(.def: (~' #export) (~ g!<name>)
(~ g!name)
- (.|> (number.hex (~ g!<code>)) //encoding.to-u2 abstract.:abstraction))]
+ (.|> ((~! number.hex) (~ g!<code>)) //encoding.to-u2 abstract.:abstraction))]
["0000" (~ g!empty)]
(~+ (list/map ..code options))
)
- (.structure: (~' #export) (~' _) (equivalence.Equivalence (~ g!name))
+ (.structure: (~' #export) (~' modifier-equivalence) (equivalence.Equivalence (~ g!name))
(.def: ((~' =) (~' reference) (~' sample))
- (.:: //encoding.Equivalence<U2> (~' =)
+ (.:: //encoding.u2-equivalence (~' =)
(abstract.:representation (~' reference))
(abstract.:representation (~' sample)))))
@@ -72,7 +72,7 @@
(binary.Format (~ g!name))
(.let [(.^open "_/.") //encoding.u2-format]
{#binary.reader (|> (~' _/reader)
- (:: parser.Functor<Parser> (~' map)
+ (:: parser.functor (~' map)
(|>> abstract.:abstraction)))
#binary.writer (|>> abstract.:representation
(~' _/writer))}))))
diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux
index 21d3d8f4a..7fdccda95 100644
--- a/stdlib/source/lux/io.lux
+++ b/stdlib/source/lux/io.lux
@@ -4,10 +4,7 @@
[control
[functor (#+ Functor)]
[apply (#+ Apply)]
- [monad (#+ do Monad)]
- ["ex" exception (#+ Exception)]]
- [data
- ["." error (#+ Error)]]])
+ [monad (#+ do Monad)]]])
(type: #export (IO a)
{#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."}
@@ -27,18 +24,18 @@
_
(#.Left "Wrong syntax for io")))
-(structure: #export _ (Functor IO)
+(structure: #export functor (Functor IO)
(def: (map f ma)
(io (f (ma (:coerce Nothing []))))))
-(structure: #export _ (Apply IO)
- (def: functor Functor<IO>)
+(structure: #export apply (Apply IO)
+ (def: &functor ..functor)
(def: (apply ff fa)
(io ((ff (:coerce Nothing [])) (fa (:coerce Nothing []))))))
-(structure: #export _ (Monad IO)
- (def: functor Functor<IO>)
+(structure: #export monad (Monad IO)
+ (def: &functor ..functor)
(def: (wrap x)
(io x))
@@ -54,43 +51,3 @@
(def: #export (exit code)
(-> Int (IO Nothing))
(io ("lux io exit" code)))
-
-## Process
-(type: #export (Process a)
- (IO (Error a)))
-
-(structure: #export _ (Functor Process)
- (def: (map f ma)
- (io (:: error.Functor<Error> map f (run ma)))))
-
-(structure: #export _ (Apply Process)
- (def: functor Functor<Process>)
-
- (def: (apply ff fa)
- (io (:: error.Apply<Error> apply (run ff) (run fa)))))
-
-(structure: #export _ (Monad Process)
- (def: functor Functor<Process>)
-
- (def: (wrap x)
- (io (:: error.Monad<Error> wrap x)))
-
- (def: (join mma)
- (case (run mma)
- (#error.Success ma)
- ma
-
- (#error.Failure error)
- (io (#error.Failure error)))))
-
-(def: #export from-io
- (All [a] (-> (IO a) (Process a)))
- (:: Functor<IO> map (|>> #error.Success)))
-
-(def: #export (fail error)
- (All [a] (-> Text (Process a)))
- (io (#error.Failure error)))
-
-(def: #export (throw exception message)
- (All [e a] (-> (Exception e) e (Process a)))
- (io (ex.throw exception message)))
diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index 30d9abcd3..3d0f3e532 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -42,14 +42,14 @@
(-> Locale Text)
(|>> :representation))
- (structure: #export _ (Equivalence Locale)
+ (structure: #export equivalence (Equivalence Locale)
(def: (= reference sample)
- (:: text.Equivalence<Text> = (:representation reference) (:representation sample))))
+ (:: text.equivalence = (:representation reference) (:representation sample))))
- (structure: #export _ (Hash Locale)
- (def: eq Equivalence<Locale>)
+ (structure: #export hash (Hash Locale)
+ (def: &equivalence ..equivalence)
(def: hash
(|>> :representation
- (:: text.Hash<Text> hash))))
+ (:: text.hash hash))))
)
diff --git a/stdlib/source/lux/locale/language.lux b/stdlib/source/lux/locale/language.lux
index 8c37efaef..57857fcc3 100644
--- a/stdlib/source/lux/locale/language.lux
+++ b/stdlib/source/lux/locale/language.lux
@@ -516,14 +516,14 @@
["zza" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]
)
- (structure: #export _ (Equivalence Language)
+ (structure: #export equivalence (Equivalence Language)
(def: (= reference sample)
(is? reference sample)))
- (structure: #export _ (Hash Language)
- (def: eq Equivalence<Language>)
+ (structure: #export hash (Hash Language)
+ (def: &equivalence ..equivalence)
(def: hash
(|>> :representation
- (:: text.Hash<Text> hash))))
+ (:: text.hash hash))))
)
diff --git a/stdlib/source/lux/locale/territory.lux b/stdlib/source/lux/locale/territory.lux
index 8c1f802ed..d2cd5b347 100644
--- a/stdlib/source/lux/locale/territory.lux
+++ b/stdlib/source/lux/locale/territory.lux
@@ -295,15 +295,15 @@
["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []]
)
- (structure: #export _ (Equivalence Territory)
+ (structure: #export equivalence (Equivalence Territory)
(def: (= reference sample)
(is? reference sample)))
- (structure: #export _ (Hash Territory)
- (def: eq Equivalence<Territory>)
+ (structure: #export hash (Hash Territory)
+ (def: &equivalence ..equivalence)
(def: hash
(|>> :representation
(get@ #long)
- (:: text.Hash<Text> hash))))
+ (:: text.hash hash))))
)
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 7ad35eec9..abfcd4d86 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -3,23 +3,24 @@
[control
[functor (#+ Functor)]
[apply (#+ Apply)]
- ["." monad (#+ do Monad)]]
+ ["." monad (#+ Monad do)]]
[data
["." product]
- [name ("name/." Codec<Text,Name> Equivalence<Name>)]
+ [name ("name/." codec equivalence)]
["." maybe]
["." error (#+ Error)]
- ["." number ("nat/." Codec<Text,Nat>)]
- ["." text ("text/." Monoid<Text> Equivalence<Text>)]
+ [number
+ ["." nat ("nat/." decimal)]]
+ ["." text ("text/." monoid equivalence)]
[collection
- ["." list ("list/." Monoid<List> Monad<List>)]]]]
+ ["." list ("list/." monoid monad)]]]]
[/
["." code]])
## (type: (Meta a)
## (-> Lux (Error [Lux a])))
-(structure: #export _ (Functor Meta)
+(structure: #export functor (Functor Meta)
(def: (map f fa)
(function (_ compiler)
(case (fa compiler)
@@ -29,8 +30,8 @@
(#error.Success [compiler' a])
(#error.Success [compiler' (f a)])))))
-(structure: #export _ (Apply Meta)
- (def: functor Functor<Meta>)
+(structure: #export apply (Apply Meta)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ compiler)
@@ -46,8 +47,8 @@
(#error.Failure msg)
(#error.Failure msg)))))
-(structure: #export _ (Monad Meta)
- (def: functor Functor<Meta>)
+(structure: #export monad (Monad Meta)
+ (def: &functor ..functor)
(def: (wrap x)
(function (_ compiler)
@@ -136,7 +137,7 @@
(def: #export current-module
(Meta Module)
- (do Monad<Meta>
+ (do ..monad
[this-module-name current-module-name]
(find-module this-module-name)))
@@ -236,7 +237,7 @@
{#.doc <desc>}
(-> Code (List Text))
(maybe.default (list)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[_args (get-ann (name-of <tag>) anns)
args (parse-tuple _args)]
(monad.map @ parse-text args))))]
@@ -249,7 +250,7 @@
(def: (find-macro' modules this-module module name)
(-> (List [Text Module]) Text Text Text
(Maybe Macro))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[$module (get module modules)
[def-type def-anns def-value] (: (Maybe Definition) (|> (: Module $module) (get@ #.definitions) (get name)))]
(if (and (macro? def-anns)
@@ -269,16 +270,16 @@
(-> Name (Meta Name))
(case name
["" name]
- (do Monad<Meta>
+ (do ..monad
[module-name current-module-name]
(wrap [module-name name]))
_
- (:: Monad<Meta> wrap name)))
+ (:: ..monad wrap name)))
(def: #export (find-macro full-name)
(-> Name (Meta (Maybe Macro)))
- (do Monad<Meta>
+ (do ..monad
[[module name] (normalize full-name)
this-module current-module-name]
(: (Meta (Maybe Macro))
@@ -291,17 +292,17 @@
(-> Code (Meta (List Code)))
(case syntax
[_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))]
- (do Monad<Meta>
+ (do ..monad
[?macro (find-macro name)]
(case ?macro
(#.Some macro)
(macro args)
#.None
- (:: Monad<Meta> wrap (list syntax))))
+ (:: ..monad wrap (list syntax))))
_
- (:: Monad<Meta> wrap (list syntax))))
+ (:: ..monad wrap (list syntax))))
(def: #export (expand syntax)
{#.doc (doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left."
@@ -309,53 +310,53 @@
(-> Code (Meta (List Code)))
(case syntax
[_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))]
- (do Monad<Meta>
+ (do ..monad
[?macro (find-macro name)]
(case ?macro
(#.Some macro)
- (do Monad<Meta>
+ (do ..monad
[expansion (macro args)
- expansion' (monad.map Monad<Meta> expand expansion)]
+ expansion' (monad.map ..monad expand expansion)]
(wrap (list/join expansion')))
#.None
- (:: Monad<Meta> wrap (list syntax))))
+ (:: ..monad wrap (list syntax))))
_
- (:: Monad<Meta> wrap (list syntax))))
+ (:: ..monad wrap (list syntax))))
(def: #export (expand-all syntax)
{#.doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."}
(-> Code (Meta (List Code)))
(case syntax
[_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))]
- (do Monad<Meta>
+ (do ..monad
[?macro (find-macro name)]
(case ?macro
(#.Some macro)
- (do Monad<Meta>
+ (do ..monad
[expansion (macro args)
- expansion' (monad.map Monad<Meta> expand-all expansion)]
+ expansion' (monad.map ..monad expand-all expansion)]
(wrap (list/join expansion')))
#.None
- (do Monad<Meta>
- [parts' (monad.map Monad<Meta> expand-all (list& (code.identifier name) args))]
+ (do ..monad
+ [parts' (monad.map ..monad expand-all (list& (code.identifier name) args))]
(wrap (list (code.form (list/join parts')))))))
[_ (#.Form (#.Cons [harg targs]))]
- (do Monad<Meta>
+ (do ..monad
[harg+ (expand-all harg)
- targs+ (monad.map Monad<Meta> expand-all targs)]
+ targs+ (monad.map ..monad expand-all targs)]
(wrap (list (code.form (list/compose harg+ (list/join (: (List (List Code)) targs+)))))))
[_ (#.Tuple members)]
- (do Monad<Meta>
- [members' (monad.map Monad<Meta> expand-all members)]
+ (do ..monad
+ [members' (monad.map ..monad expand-all members)]
(wrap (list (code.tuple (list/join members')))))
_
- (:: Monad<Meta> wrap (list syntax))))
+ (:: ..monad wrap (list syntax))))
(def: #export count
(Meta Nat)
@@ -371,7 +372,7 @@
(#error.Success [(update@ #.seed inc compiler)
(|> compiler
(get@ #.seed)
- (:: number.Codec<Text,Nat> encode)
+ (:: nat.decimal encode)
($_ text/compose "__gensym__" prefix)
[""] code.identifier)])))
@@ -379,7 +380,7 @@
(-> Code (Meta Text))
(case ast
[_ (#.Identifier [_ name])]
- (:: Monad<Meta> wrap name)
+ (:: ..monad wrap name)
_
(fail (text/compose "Code is not a local identifier: " (code.to-text ast)))))
@@ -401,12 +402,12 @@
)))}
(case tokens
(^ (list [_ (#.Tuple identifiers)] body))
- (do Monad<Meta>
+ (do ..monad
[identifier-names (monad.map @ get-local-identifier identifiers)
#let [identifier-defs (list/join (list/map (: (-> Text (List Code))
(function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name)))))))
identifier-names))]]
- (wrap (list (` ((~! do) (~! Monad<Meta>)
+ (wrap (list (` ((~! do) (~! ..monad)
[(~+ identifier-defs)]
(~ body))))))
@@ -416,7 +417,7 @@
(def: #export (expand-1 token)
{#.doc "Works just like expand, except that it ensures that the output is a single Code token."}
(-> Code (Meta Code))
- (do Monad<Meta>
+ (do ..monad
[token+ (expand token)]
(case token+
(^ (list token'))
@@ -468,7 +469,7 @@
(#error.Success [compiler type'])))
_
- (:: Monad<Meta> wrap type)))
+ (:: ..monad wrap type)))
(def: #export (find-var-type name)
{#.doc "Looks-up the type of a local variable somewhere in the environment."}
@@ -476,7 +477,7 @@
(function (_ compiler)
(let [test (: (-> [Text [Type Any]] Bit)
(|>> product.left (text/= name)))]
- (case (do maybe.Monad<Maybe>
+ (case (do maybe.monad
[scope (list.find (function (_ env)
(or (list.any? test (: (List [Text [Type Any]])
(get@ [#.locals #.mappings] env)))
@@ -498,11 +499,11 @@
(def: #export (find-def name)
{#.doc "Looks-up a definition's whole data in the available modules (including the current one)."}
(-> Name (Meta Definition))
- (do Monad<Meta>
+ (do ..monad
[name (normalize name)]
(function (_ compiler)
(case (: (Maybe Definition)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[#let [[v-prefix v-name] name]
(^slots [#.definitions]) (get v-prefix (get@ #.modules compiler))]
(get v-name definitions)))
@@ -527,14 +528,14 @@
(def: #export (find-def-type name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
(-> Name (Meta Type))
- (do Monad<Meta>
+ (do ..monad
[[def-type def-data def-value] (find-def name)]
(clean-type def-type)))
(def: #export (find-type name)
{#.doc "Looks-up the type of either a local variable or a definition."}
(-> Name (Meta Type))
- (do Monad<Meta>
+ (do ..monad
[#let [[_ _name] name]]
(case name
["" _name]
@@ -547,7 +548,7 @@
(def: #export (find-type-def name)
{#.doc "Finds the value of a type definition (such as Int, Any or Lux)."}
(-> Name (Meta Type))
- (do Monad<Meta>
+ (do ..monad
[[def-type def-data def-value] (find-def name)]
(wrap (:coerce Type def-value))))
@@ -563,7 +564,7 @@
(def: #export (exports module-name)
{#.doc "All the exported definitions in a module."}
(-> Text (Meta (List [Text Definition])))
- (do Monad<Meta>
+ (do ..monad
[definitions (definitions module-name)]
(wrap (list.filter (function (_ [name [def-type def-anns def-value]])
(export? def-anns))
@@ -581,7 +582,7 @@
(def: #export (tags-of type-name)
{#.doc "All the tags associated with a type definition."}
(-> Name (Meta (Maybe (List Name))))
- (do Monad<Meta>
+ (do ..monad
[#let [[module name] type-name]
module (find-module module)]
(case (get name (get@ #.types module))
@@ -611,19 +612,19 @@
(def: #export (imported-modules module-name)
{#.doc "All the modules imported by a specified module."}
(-> Text (Meta (List Text)))
- (do Monad<Meta>
+ (do ..monad
[(^slots [#.imports]) (find-module module-name)]
(wrap imports)))
(def: #export (imported-by? import module)
(-> Text Text (Meta Bit))
- (do Monad<Meta>
+ (do ..monad
[(^slots [#.imports]) (find-module module)]
(wrap (list.any? (text/= import) imports))))
(def: #export (imported? import)
(-> Text (Meta Bit))
- (let [(^open ".") Monad<Meta>]
+ (let [(^open ".") ..monad]
(|> current-module-name
(map find-module) join
(map (|>> (get@ #.imports) (list.any? (text/= import)))))))
@@ -631,7 +632,7 @@
(def: #export (resolve-tag tag)
{#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."}
(-> Name (Meta [Nat (List Name) Type]))
- (do Monad<Meta>
+ (do ..monad
[#let [[module name] tag]
=module (find-module module)
this-module-name current-module-name
@@ -649,7 +650,7 @@
(def: #export (tag-lists module)
{#.doc "All the tag-lists defined in a module, with their associated types."}
(-> Text (Meta (List [(List Name) Type])))
- (do Monad<Meta>
+ (do ..monad
[=module (find-module module)
this-module-name current-module-name]
(wrap (|> (get@ #.types =module)
@@ -677,7 +678,7 @@
(def: #export (un-alias def-name)
{#.doc "Given an aliased definition's name, returns the original definition being referenced."}
(-> Name (Meta Name))
- (do Monad<Meta>
+ (do ..monad
[[_ def-anns _] (find-def def-name)]
(case (get-identifier-ann (name-of #.alias) def-anns)
(#.Some real-def-name)
@@ -718,7 +719,7 @@
_
#.None))
(#.Some [omit? token])
- (do Monad<Meta>
+ (do ..monad
[cursor ..cursor
output (<func> token)
#let [_ (log! ($_ text/compose (name/encode (name-of <macro>)) " @ " (.cursor-description cursor)))
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index 7e78fe617..34dd35a3b 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -3,14 +3,17 @@
[control
["." equivalence (#+ Equivalence)]]
[data
- bit
- number
- name
- ["." text (#+ Equivalence<Text>) ("text/." Monoid<Text>)]
+ ["." bit]
+ ["." name]
+ [number
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
+ ["." text ("text/." monoid)]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]]]])
+ ["." list ("list/." functor fold)]]]])
-## [Types]
## (type: (Code' w)
## (#.Bit Bit)
## (#.Nat Nat)
@@ -26,10 +29,8 @@
## (type: Code
## (Ann Cursor (Code' (Ann Cursor))))
-## [Utils]
(def: _cursor Cursor ["" 0 0])
-## [Functions]
(do-template [<name> <type> <tag>]
[(def: #export (<name> x)
(-> <type> Code)
@@ -57,54 +58,52 @@
[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)."])
-## [Structures]
-(structure: #export _ (Equivalence Code)
+(structure: #export equivalence (Equivalence Code)
(def: (= x y)
(case [x y]
(^template [<tag> <eq>]
[[_ (<tag> x')] [_ (<tag> y')]]
(:: <eq> = x' y'))
- ([#.Bit Equivalence<Bit>]
- [#.Nat Equivalence<Nat>]
- [#.Int Equivalence<Int>]
- [#.Rev Equivalence<Rev>]
- [#.Frac Equivalence<Frac>]
- [#.Text Equivalence<Text>]
- [#.Identifier Equivalence<Name>]
- [#.Tag Equivalence<Name>])
+ ([#.Bit bit.equivalence]
+ [#.Nat nat.equivalence]
+ [#.Int int.equivalence]
+ [#.Rev rev.equivalence]
+ [#.Frac frac.equivalence]
+ [#.Text text.equivalence]
+ [#.Identifier name.equivalence]
+ [#.Tag name.equivalence])
(^template [<tag>]
[[_ (<tag> xs')] [_ (<tag> ys')]]
- (:: (list.Equivalence<List> =) = xs' ys'))
+ (:: (list.equivalence =) = xs' ys'))
([#.Form]
[#.Tuple])
[[_ (#.Record xs')] [_ (#.Record ys')]]
- (:: (list.Equivalence<List> (equivalence.product = =))
+ (:: (list.equivalence (equivalence.product = =))
= xs' ys')
_
#0)))
-## [Values]
(def: #export (to-text ast)
(-> Code Text)
(case ast
(^template [<tag> <struct>]
[_ (<tag> value)]
(:: <struct> encode value))
- ([#.Bit Codec<Text,Bit>]
- [#.Nat Codec<Text,Nat>]
- [#.Int Codec<Text,Int>]
- [#.Rev Codec<Text,Rev>]
- [#.Frac Codec<Text,Frac>]
- [#.Identifier Codec<Text,Name>])
+ ([#.Bit bit.codec]
+ [#.Nat nat.decimal]
+ [#.Int int.decimal]
+ [#.Rev rev.decimal]
+ [#.Frac frac.decimal]
+ [#.Identifier name.codec])
[_ (#.Text value)]
(text.encode value)
[_ (#.Tag name)]
- (text/compose "#" (:: Codec<Text,Name> encode name))
+ (text/compose "#" (:: name.codec encode name))
(^template [<tag> <open> <close>]
[_ (<tag> members)]
@@ -132,7 +131,7 @@
(def: #export (replace original substitute ast)
{#.doc "Replaces all code that looks like the 'original' with the 'substitute'."}
(-> Code Code Code Code)
- (if (:: Equivalence<Code> = original ast)
+ (if (:: ..equivalence = original ast)
substitute
(case ast
(^template [<tag>]
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index be33751cc..02ffb21fb 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -1,7 +1,7 @@
(.module:
[lux (#- function)
[control
- ["." monad (#+ do Monad)]
+ ["." monad (#+ Monad do)]
[equivalence]
["p" parser]
["ex" exception (#+ exception:)]]
@@ -10,23 +10,24 @@
["." product]
["." bit]
["." maybe]
- [name ("name/." Codec<Text,Name>)]
+ [name ("name/." codec)]
["." error (#+ Error)]
- ["." number (#+ hex) ("nat/." Codec<Text,Nat>)]
- ["." text ("text/." Monoid<Text>)
+ ["." number (#+ hex)
+ ["." nat ("nat/." decimal)]]
+ ["." text ("text/." monoid)
format]
[collection
- ["." list ("list/." Fold<List> Monad<List> Monoid<List>)]
+ ["." list ("list/." fold monad monoid)]
["dict" dictionary (#+ Dictionary)]]]
["." macro (#+ with-gensyms)
["." code]
- ["s" syntax (#+ syntax: Syntax)]
+ ["s" syntax (#+ Syntax syntax:)]
[syntax
["cs" common]
[common
["csr" reader]
["csw" writer]]]]
- ["." type ("type/." Equivalence<Type>)
+ ["." type ("type/." equivalence)
["." check]]])
(do-template [<name>]
@@ -64,7 +65,7 @@
(type: #export (Poly a)
(p.Parser [Env (List Type)] a))
-(def: #export fresh Env (dict.new number.Hash<Nat>))
+(def: #export fresh Env (dict.new nat.hash))
(def: (run' env types poly)
(All [a] (-> Env (List Type) (Poly a) (Error a)))
@@ -150,7 +151,7 @@
(do-template [<name> <flattener> <tag> <exception>]
[(def: #export (<name> poly)
(All [a] (-> (Poly a) (Poly a)))
- (do p.Monad<Parser>
+ (do p.monad
[headT any]
(let [members (<flattener> (type.un-name headT))]
(if (n/> 1 (list.size members))
@@ -163,7 +164,7 @@
(def: polymorphic'
(Poly [Nat Type])
- (do p.Monad<Parser>
+ (do p.monad
[headT any
#let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]]
(if (n/= 0 num-arg)
@@ -172,7 +173,7 @@
(def: #export (polymorphic poly)
(All [a] (-> (Poly a) (Poly [Code (List Code) a])))
- (do p.Monad<Parser>
+ (do p.monad
[headT any
funcI (:: @ map dict.size ..env)
[num-args non-poly] (local (list headT) polymorphic')
@@ -209,7 +210,7 @@
(def: #export (function in-poly out-poly)
(All [i o] (-> (Poly i) (Poly o) (Poly [i o])))
- (do p.Monad<Parser>
+ (do p.monad
[headT any
#let [[inputsT outputT] (type.flatten-function (type.un-name headT))]]
(if (n/> 0 (list.size inputsT))
@@ -219,7 +220,7 @@
(def: #export (apply poly)
(All [a] (-> (Poly a) (Poly a)))
- (do p.Monad<Parser>
+ (do p.monad
[headT any
#let [[funcT paramsT] (type.flatten-application (type.un-name headT))]]
(if (n/= 0 (list.size paramsT))
@@ -229,7 +230,7 @@
(do-template [<name> <test>]
[(def: #export (<name> expected)
(-> Type (Poly Any))
- (do p.Monad<Parser>
+ (do p.monad
[actual any]
(if (<test> expected actual)
(wrap [])
@@ -249,7 +250,7 @@
(def: #export parameter
(Poly Code)
- (do p.Monad<Parser>
+ (do p.monad
[env ..env
headT any]
(case headT
@@ -266,7 +267,7 @@
(def: #export (parameter! id)
(-> Nat (Poly Any))
- (do p.Monad<Parser>
+ (do p.monad
[env ..env
headT any]
(case headT
@@ -280,7 +281,7 @@
(def: #export existential
(Poly Nat)
- (do p.Monad<Parser>
+ (do p.monad
[headT any]
(case headT
(#.Ex ex-id)
@@ -291,7 +292,7 @@
(def: #export named
(Poly [Name Type])
- (do p.Monad<Parser>
+ (do p.monad
[inputT any]
(case inputT
(#.Named name anonymousT)
@@ -302,7 +303,7 @@
(def: #export (recursive poly)
(All [a] (-> (Poly a) (Poly [Code a])))
- (do p.Monad<Parser>
+ (do p.monad
[headT any]
(case (type.un-name headT)
(#.Apply (#.Named ["lux" "Nothing"] _) (#.UnivQ _ headT'))
@@ -318,7 +319,7 @@
(def: #export recursive-self
(Poly Code)
- (do p.Monad<Parser>
+ (do p.monad
[env ..env
headT any]
(case (type.un-name headT)
@@ -332,7 +333,7 @@
(def: #export recursive-call
(Poly Code)
- (do p.Monad<Parser>
+ (do p.monad
[env ..env
[funcT argsT] (apply (p.and any (p.many any)))
_ (local (list funcT) (..parameter! 0))
@@ -344,26 +345,25 @@
(def: #export log
(All [a] (Poly a))
- (do p.Monad<Parser>
+ (do p.monad
[current any
#let [_ (log! ($_ text/compose
"{" (name/encode (name-of ..log)) "} "
(%type current)))]]
(p.fail "LOGGING")))
-## [Syntax]
(syntax: #export (poly: {export csr.export}
{name s.local-identifier}
body)
(with-gensyms [g!_ g!type g!output]
(let [g!name (code.identifier ["" name])]
(wrap (.list (` (syntax: (~+ (csw.export export)) ((~ g!name) {(~ g!type) s.identifier})
- (do macro.Monad<Meta>
+ (do macro.monad
[(~ g!type) (macro.find-type-def (~ g!type))]
(case (|> (~ body)
(.function ((~ g!_) (~ g!name)))
p.rec
- (do p.Monad<Parser> [])
+ (do p.monad [])
(..run (~ g!type))
(: (.Either .Text .Code)))
(#.Left (~ g!output))
@@ -410,7 +410,6 @@
{#.struct? #1}
(~ impl)))))))
-## [Derivers]
(def: #export (to-code env type)
(-> Env Type Code)
(case type
diff --git a/stdlib/source/lux/macro/poly/equivalence.lux b/stdlib/source/lux/macro/poly/equivalence.lux
index 4b5b80e13..5d95b6256 100644
--- a/stdlib/source/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/lux/macro/poly/equivalence.lux
@@ -8,11 +8,15 @@
["." product]
["." bit]
["." maybe]
- ["." number ("nat/." Codec<Text,Nat>)]
- ["." text ("text/." Monoid<Text>)
+ [number
+ ["." nat ("nat/." codec)]
+ ["." int]
+ ["." rev]
+ ["." frac]]
+ ["." text ("text/." monoid)
format]
[collection
- ["." list ("list/." Monad<List>)]
+ ["." list ("list/." monad)]
["." row]
["." array]
["." queue]
@@ -50,12 +54,12 @@
<eq>))))]
[(poly.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)]
- [(poly.sub Bit) (~! bit.Equivalence<Bit>)]
- [(poly.sub Nat) (~! number.Equivalence<Nat>)]
- [(poly.sub Int) (~! number.Equivalence<Int>)]
- [(poly.sub Rev) (~! number.Equivalence<Rev>)]
- [(poly.sub Frac) (~! number.Equivalence<Frac>)]
- [(poly.sub Text) (~! text.Equivalence<Text>)]))
+ [(poly.sub Bit) (~! bit.equivalence)]
+ [(poly.sub Nat) (~! nat.equivalence)]
+ [(poly.sub Int) (~! int.equivalence)]
+ [(poly.sub Rev) (~! rev.equivalence)]
+ [(poly.sub Frac) (~! frac.equivalence)]
+ [(poly.sub Text) (~! text.equivalence)]))
## Composite types
(~~ (do-template [<name> <eq>]
[(do @
@@ -64,13 +68,13 @@
(wrap (` (: (~ (@Equivalence inputT))
(<eq> (~ argC))))))]
- [.Maybe (~! maybe.Equivalence<Maybe>)]
- [.List (~! list.Equivalence<List>)]
- [row.Row (~! row.Equivalence<Row>)]
- [array.Array (~! array.Equivalence<Array>)]
- [queue.Queue (~! queue.Equivalence<Queue>)]
- [set.Set (~! set.Equivalence<Set>)]
- [rose.Tree (~! rose.Equivalence<Tree>)]
+ [.Maybe (~! maybe.equivalence)]
+ [.List (~! list.equivalence)]
+ [row.Row (~! row.equivalence)]
+ [array.Array (~! array.equivalence)]
+ [queue.Queue (~! queue.equivalence)]
+ [set.Set (~! set.equivalence)]
+ [rose.Tree (~! rose.equivalence)]
))
(do @
[[_ _ valC] (poly.apply ($_ p.and
@@ -78,7 +82,7 @@
poly.any
Equivalence<?>))]
(wrap (` (: (~ (@Equivalence inputT))
- ((~! dict.Equivalence<Dictionary>) (~ valC))))))
+ ((~! dict.equivalence) (~ valC))))))
## Models
(~~ (do-template [<type> <eq>]
[(do @
@@ -86,16 +90,16 @@
(wrap (` (: (~ (@Equivalence inputT))
<eq>))))]
- [du.Duration du.Equivalence<Duration>]
- [i.Instant i.Equivalence<Instant>]
- [da.Date da.Equivalence<Date>]
- [da.Day da.Equivalence<Day>]
- [da.Month da.Equivalence<Month>]))
+ [du.Duration du.equivalence]
+ [i.Instant i.equivalence]
+ [da.Date da.equivalence]
+ [da.Day da.equivalence]
+ [da.Month da.equivalence]))
(do @
[_ (poly.apply (p.and (poly.exactly unit.Qty)
poly.any))]
(wrap (` (: (~ (@Equivalence inputT))
- unit.Equivalence<Qty>))))
+ unit.equivalence))))
## Variants
(do @
[members (poly.variant (p.many Equivalence<?>))
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
index d866db45c..61aba1753 100644
--- a/stdlib/source/lux/macro/poly/functor.lux
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -9,7 +9,7 @@
["." text
format]
[collection
- ["." list ("list/." Monad<List> Monoid<List>)]]]
+ ["." list ("list/." monad monoid)]]]
["." macro
["." code]
[syntax (#+ syntax: Syntax)
@@ -38,7 +38,7 @@
(function (Arg<?> valueC)
($_ p.either
## Type-var
- (do p.Monad<Parser>
+ (do p.monad
[#let [varI (|> num-vars (n/* 2) dec)]
_ (poly.parameter! varI)]
(wrap (` ((~ funcC) (~ valueC)))))
@@ -52,7 +52,7 @@
(` ((~ (code.nat tag)) (~ memberC)))))
(list.enumerate membersC))))))))
## Tuples
- (do p.Monad<Parser>
+ (do p.monad
[pairsCC (: (poly.Poly (List [Code Code]))
(poly.tuple (loop [idx 0
pairsCC (: (List [Code Code])
@@ -81,11 +81,11 @@
(let [(~ outL) ((~ valueC) (~+ inC+))]
(~ outC))))))
## Recursion
- (do p.Monad<Parser>
+ (do p.monad
[_ poly.recursive-call]
(wrap (` ((~' map) (~ funcC) (~ valueC)))))
## Parameters
- (do p.Monad<Parser>
+ (do p.monad
[_ poly.any]
(wrap valueC))
)))]
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 6ef9b249e..22b07f064 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -1,7 +1,7 @@
(.module: {#.doc "Codecs for values in the JSON format."}
[lux #*
[control
- [monad (#+ do Monad)]
+ [monad (#+ Monad do)]
[equivalence (#+ Equivalence)]
codec
["p" parser]]
@@ -11,16 +11,16 @@
["e" error]
["." sum]
["." product]
- [number ("frac/." Codec<Text,Frac>) ("nat/." Codec<Text,Nat>)
+ [number ("frac/." codec) ("nat/." codec)
["." i64]]
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
["l" lexer]
format]
[format
["//" json (#+ JSON)]]
[collection
- ["." list ("list/." Fold<List> Monad<List>)]
- ["." row (#+ Row row) ("row/." Monad<Row>)]
+ ["." list ("list/." fold monad)]
+ ["." row (#+ Row row) ("row/." monad)]
["d" dictionary]]]
[time
## ["i" instant]
@@ -47,7 +47,7 @@
(def: low-mask Nat (|> 1 (i64.left-shift 32) dec))
(def: high-mask Nat (|> low-mask (i64.left-shift 32)))
-(structure: _ (Codec JSON Nat)
+(structure: nat-codec (Codec JSON Nat)
(def: (encode input)
(let [high (|> input (i64.and high-mask) (i64.logical-right-shift 32))
low (i64.and low-mask input)]
@@ -56,16 +56,16 @@
(def: (decode input)
(<| (//.run input)
//.array
- (do p.Monad<Parser>
+ (do p.monad
[high //.number
low //.number])
(wrap (n/+ (|> high frac-to-int .nat (i64.left-shift 32))
(|> low frac-to-int .nat))))))
-(structure: _ (Codec JSON Int)
- (def: encode (|>> .nat (:: Codec<JSON,Nat> encode)))
+(structure: int-codec (Codec JSON Int)
+ (def: encode (|>> .nat (:: nat-codec encode)))
(def: decode
- (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map .int))))
+ (|>> (:: nat-codec decode) (:: e.functor map .int))))
(def: (nullable writer)
{#.doc "Builds a JSON generator for potentially inexistent values."}
@@ -75,15 +75,15 @@
#.None #//.Null
(#.Some value) (writer value))))
-(structure: Codec<JSON,Qty>
+(structure: qty-codec
(All [unit] (Codec JSON (unit.Qty unit)))
(def: encode
- (|>> unit.out (:: Codec<JSON,Int> encode)))
+ (|>> unit.out (:: ..int-codec encode)))
(def: decode
- (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map unit.in))))
+ (|>> (:: ..int-codec decode) (:: e.functor map unit.in))))
-(poly: Codec<JSON,?>//encode
+(poly: codec//encode
(with-expansions
[<basic> (do-template [<matcher> <encoder>]
[(do @
@@ -94,8 +94,8 @@
[(poly.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #//.Null)]
[(poly.sub Bit) (|>> #//.Boolean)]
- [(poly.sub Nat) (:: (~! ..Codec<JSON,Nat>) (~' encode))]
- [(poly.sub Int) (:: (~! ..Codec<JSON,Int>) (~' encode))]
+ [(poly.sub Nat) (:: (~! ..nat-codec) (~' encode))]
+ [(poly.sub Int) (:: (~! ..int-codec) (~' encode))]
[(poly.sub Frac) (|>> #//.Number)]
[(poly.sub Text) (|>> #//.String)])
<time> (do-template [<type> <codec>]
@@ -104,11 +104,11 @@
(wrap (` (: (~ (@JSON//encode inputT))
(|>> (:: <codec> (~' encode)) #//.String)))))]
- ## [du.Duration du.Codec<Text,Duration>]
- ## [i.Instant i.Codec<Text,Instant>]
- [da.Date da.Codec<Text,Date>]
- [da.Day da.Codec<Text,Day>]
- [da.Month da.Codec<Text,Month>])]
+ ## [du.Duration du.codec]
+ ## [i.Instant i.codec]
+ [da.Date da.date-codec]
+ [da.Day da.day-codec]
+ [da.Month da.month-codec])]
(do @
[*env* poly.env
#let [@JSON//encode (: (-> Type Code)
@@ -122,7 +122,7 @@
[unitT (poly.apply (p.after (poly.exactly unit.Qty)
poly.any))]
(wrap (` (: (~ (@JSON//encode inputT))
- (:: (~! Codec<JSON,Qty>) (~' encode))))))
+ (:: (~! qty-codec) (~' encode))))))
(do @
[#let [g!_ (code.local-identifier "_______")
g!key (code.local-identifier "_______key")
@@ -130,29 +130,29 @@
[_ _ =val=] (poly.apply ($_ p.and
(poly.exactly d.Dictionary)
(poly.exactly .Text)
- Codec<JSON,?>//encode))]
+ codec//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
(|>> d.entries
((~! list/map) (function ((~ g!_) [(~ g!key) (~ g!val)])
[(~ g!key) ((~ =val=) (~ g!val))]))
- (d.from-list text.Hash<Text>)
+ (d.from-list text.hash)
#//.Object)))))
(do @
[[_ =sub=] (poly.apply ($_ p.and
(poly.exactly .Maybe)
- Codec<JSON,?>//encode))]
+ codec//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
((~! ..nullable) (~ =sub=))))))
(do @
[[_ =sub=] (poly.apply ($_ p.and
(poly.exactly .List)
- Codec<JSON,?>//encode))]
+ codec//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
(|>> ((~! list/map) (~ =sub=)) row.from-list #//.Array)))))
(do @
[#let [g!_ (code.local-identifier "_______")
g!input (code.local-identifier "_______input")]
- members (poly.variant (p.many Codec<JSON,?>//encode))]
+ members (poly.variant (p.many codec//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
(function ((~ g!_) (~ g!input))
(case (~ g!input)
@@ -162,7 +162,7 @@
((~ g!encode) (~ g!input))]))))
(list.enumerate members))))))))))
(do @
- [g!encoders (poly.tuple (p.many Codec<JSON,?>//encode))
+ [g!encoders (poly.tuple (p.many codec//encode))
#let [g!_ (code.local-identifier "_______")
g!members (|> (list.size g!encoders)
list.indices
@@ -174,7 +174,7 @@
(list.zip2 g!members g!encoders)))]))))))
## Type recursion
(do @
- [[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)
+ [[selfC non-recC] (poly.recursive codec//encode)
#let [g! (code.local-identifier "____________")]]
(wrap (` (: (~ (@JSON//encode inputT))
((~! ..rec-encode) (.function ((~ g!) (~ selfC))
@@ -182,11 +182,11 @@
poly.recursive-self
## Type applications
(do @
- [partsC (poly.apply (p.many Codec<JSON,?>//encode))]
+ [partsC (poly.apply (p.many codec//encode))]
(wrap (` ((~+ partsC)))))
## Polymorphism
(do @
- [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)]
+ [[funcC varsC bodyC] (poly.polymorphic codec//encode)]
(wrap (` (: (All [(~+ varsC)]
(-> (~+ (list/map (function (_ varC) (` (-> (~ varC) //.JSON)))
varsC))
@@ -200,7 +200,7 @@
(p.fail (format "Cannot create JSON encoder for: " (type.to-text inputT)))
))))
-(poly: Codec<JSON,?>//decode
+(poly: codec//decode
(with-expansions
[<basic> (do-template [<matcher> <decoder>]
[(do @
@@ -210,8 +210,8 @@
[(poly.exactly Any) //.null]
[(poly.sub Bit) //.boolean]
- [(poly.sub Nat) (p.codec (~! ..Codec<JSON,Nat>) //.any)]
- [(poly.sub Int) (p.codec (~! ..Codec<JSON,Int>) //.any)]
+ [(poly.sub Nat) (p.codec (~! ..nat-codec) //.any)]
+ [(poly.sub Int) (p.codec (~! ..int-codec) //.any)]
[(poly.sub Frac) //.number]
[(poly.sub Text) //.string])
<time> (do-template [<type> <codec>]
@@ -220,11 +220,11 @@
(wrap (` (: (~ (@JSON//decode inputT))
(p.codec <codec> //.string)))))]
- ## [du.Duration du.Codec<Text,Duration>]
- ## [i.Instant i.Codec<Text,Instant>]
- [da.Date da.Codec<Text,Date>]
- [da.Day da.Codec<Text,Day>]
- [da.Month da.Codec<Text,Month>])]
+ ## [du.Duration du.codec]
+ ## [i.Instant i.codec]
+ [da.Date da.date-codec]
+ [da.Day da.day-codec]
+ [da.Month da.month-codec])]
(do @
[*env* poly.env
#let [@JSON//decode (: (-> Type Code)
@@ -238,26 +238,26 @@
[unitT (poly.apply (p.after (poly.exactly unit.Qty)
poly.any))]
(wrap (` (: (~ (@JSON//decode inputT))
- (p.codec (~! Codec<JSON,Qty>) //.any)))))
+ (p.codec (~! qty-codec) //.any)))))
(do @
[[_ _ valC] (poly.apply ($_ p.and
(poly.exactly d.Dictionary)
(poly.exactly .Text)
- Codec<JSON,?>//decode))]
+ codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
(//.object (~ valC))))))
(do @
[[_ subC] (poly.apply (p.and (poly.exactly .Maybe)
- Codec<JSON,?>//decode))]
+ codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
(//.nullable (~ subC))))))
(do @
[[_ subC] (poly.apply (p.and (poly.exactly .List)
- Codec<JSON,?>//decode))]
+ codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
(//.array (p.some (~ subC)))))))
(do @
- [members (poly.variant (p.many Codec<JSON,?>//decode))]
+ [members (poly.variant (p.many codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
($_ p.or
(~+ (list/map (function (_ [tag memberC])
@@ -266,12 +266,12 @@
//.array)))
(list.enumerate members))))))))
(do @
- [g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))]
+ [g!decoders (poly.tuple (p.many codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
(//.array ($_ p.and (~+ g!decoders)))))))
## Type recursion
(do @
- [[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)
+ [[selfC bodyC] (poly.recursive codec//decode)
#let [g! (code.local-identifier "____________")]]
(wrap (` (: (~ (@JSON//decode inputT))
(p.rec (.function ((~ g!) (~ selfC))
@@ -279,11 +279,11 @@
poly.recursive-self
## Type applications
(do @
- [[funcC argsC] (poly.apply (p.and Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))]
+ [[funcC argsC] (poly.apply (p.and codec//decode (p.many codec//decode)))]
(wrap (` ((~ funcC) (~+ argsC)))))
## Polymorphism
(do @
- [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)]
+ [[funcC varsC bodyC] (poly.polymorphic codec//decode)]
(wrap (` (: (All [(~+ varsC)]
(-> (~+ (list/map (|>> (~) //.Reader (`)) varsC))
(//.Reader ((~ (poly.to-code *env* inputT)) (~+ varsC)))))
@@ -295,7 +295,7 @@
(p.fail (format "Cannot create JSON decoder for: " (type.to-text inputT)))
))))
-(syntax: #export (Codec<JSON,?> inputT)
+(syntax: #export (codec inputT)
{#.doc (doc "A macro for automatically producing JSON codecs."
(type: Variant
(#Case0 Bit)
@@ -312,9 +312,9 @@
#tuple [Bit Frac Text]
#dict (Dictionary Text Frac)})
- (derived: (Codec<JSON,?> Record)))}
+ (derived: (..codec Record)))}
(with-gensyms [g!inputs]
(wrap (list (` (: (Codec //.JSON (~ inputT))
- (structure (def: (~' encode) ((~! Codec<JSON,?>//encode) (~ inputT)))
- (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) ((~! Codec<JSON,?>//decode) (~ inputT))))
+ (structure (def: (~' encode) ((~! ..codec) (~ inputT)))
+ (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) ((~! ..codec) (~ inputT))))
)))))))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index cb235043f..704f6d245 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -1,7 +1,7 @@
(.module:
[lux (#- nat int rev)
[control
- ["." monad (#+ do Monad)]
+ ["." monad (#+ Monad do)]
[equivalence (#+ Equivalence)]
["p" parser]]
[data
@@ -9,12 +9,16 @@
["." name]
["." maybe]
["." error (#+ Error)]
- ["." number]
- ["." text ("text/." Monoid<Text>)]
+ [number
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
+ ["." text ("text/." monoid)]
[collection
- ["." list ("list/." Functor<List>)]]]]
+ ["." list ("list/." functor)]]]]
["." // (#+ with-gensyms)
- ["." code ("code/." Equivalence<Code>)]])
+ ["." code ("code/." equivalence)]])
## [Utils]
(def: (join-pairs pairs)
@@ -55,14 +59,14 @@
_
(#error.Failure ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
- [ bit Bit #.Bit bit.Equivalence<Bit> "bit"]
- [ nat Nat #.Nat number.Equivalence<Nat> "nat"]
- [ int Int #.Int number.Equivalence<Int> "int"]
- [ rev Rev #.Rev number.Equivalence<Rev> "rev"]
- [ frac Frac #.Frac number.Equivalence<Frac> "frac"]
- [ text Text #.Text text.Equivalence<Text> "text"]
- [identifier Name #.Identifier name.Equivalence<Name> "identifier"]
- [ tag Name #.Tag name.Equivalence<Name> "tag"]
+ [ bit Bit #.Bit bit.equivalence "bit"]
+ [ nat Nat #.Nat nat.equivalence "nat"]
+ [ int Int #.Int int.equivalence "int"]
+ [ rev Rev #.Rev rev.equivalence "rev"]
+ [ frac Frac #.Frac frac.equivalence "frac"]
+ [ text Text #.Text text.equivalence "text"]
+ [identifier Name #.Identifier name.equivalence "identifier"]
+ [ tag Name #.Tag name.equivalence "tag"]
)
(def: #export (this? ast)
@@ -190,7 +194,7 @@
{#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."}
(All [a] (-> (List Code) (Syntax a) (Syntax a)))
(function (_ real)
- (do error.Monad<Error>
+ (do error.monad
[value (run inputs syntax)]
(wrap [real value]))))
@@ -198,7 +202,7 @@
(macro: #export (syntax: tokens)
{#.doc (doc "A more advanced way to define macros than 'macro:'."
"The inputs to the macro can be parsed in complex ways through the use of syntax parsers."
- "The macro body is also (implicitly) run in the Monad<Meta>, to save some typing."
+ "The macro body is also (implicitly) run in the Meta monad, to save some typing."
"Also, the compiler state can be accessed through the *compiler* binding."
(syntax: #export (object {#let [imports (class-imports *compiler*)]}
{#let [class-vars (list)]}
@@ -235,7 +239,7 @@
(case ?parts
(#.Some [name args meta body])
(with-gensyms [g!tokens g!body g!error]
- (do //.Monad<Meta>
+ (do //.monad
[vars+parsers (monad.map @
(: (-> Code (Meta [Code Code]))
(function (_ arg)
@@ -265,9 +269,9 @@
(#error.Failure ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))}
((~! ..run) (~ g!tokens)
(: ((~! ..Syntax) (Meta (List Code)))
- ((~! do) (~! p.Monad<Parser>)
+ ((~! do) (~! p.monad)
[(~+ (join-pairs vars+parsers))]
- ((~' wrap) ((~! do) (~! //.Monad<Meta>)
+ ((~' wrap) ((~! do) (~! //.monad)
[]
(~ body)))))))))))))
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index bbbe3f6d7..93e2ffa09 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -2,9 +2,9 @@
[lux #*
[control
monad
- ["p" parser ("parser/." Monad<Parser>)]]
+ ["p" parser ("parser/." monad)]]
[data
- [name ("name/." Equivalence<Name>)]
+ [name ("name/." equivalence)]
["." product]
["." maybe]
[collection
@@ -40,7 +40,7 @@
## Definitions
(def: check^
(Syntax [(Maybe Code) Code])
- (p.either (s.form (do p.Monad<Parser>
+ (p.either (s.form (do p.monad
[_ (s.this (' "lux check"))
type s.any
value s.any]
@@ -55,7 +55,7 @@
(def: (_definition-anns^ _)
(-> Any (Syntax //.Annotations))
(p.or (s.this (' #.Nil))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[_ (s.this (' #.Cons))
[head tail] (p.and (s.tuple (p.and _definition-anns-tag^ s.any))
(_definition-anns^ []))]
@@ -64,10 +64,10 @@
(def: (flat-list^ _)
(-> Any (Syntax (List Code)))
- (p.either (do p.Monad<Parser>
+ (p.either (do p.monad
[_ (s.this (' #.Nil))]
(wrap (list)))
- (s.form (do p.Monad<Parser>
+ (s.form (do p.monad
[_ (s.this (' #.Cons))
[head tail] (s.tuple (p.and s.any s.any))
tail (s.local (list tail) (flat-list^ []))]
@@ -79,7 +79,7 @@
(<| s.tuple
(p.after s.any)
s.form
- (do p.Monad<Parser>
+ (do p.monad
[_ (s.this (' <tag>))]
<then>)))]
@@ -105,7 +105,7 @@
(def: #export (definition compiler)
{#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."}
(-> Lux (Syntax //.Definition))
- (do p.Monad<Parser>
+ (do p.monad
[definition-raw s.any
me-definition-raw (|> definition-raw
////.expand-all
@@ -129,7 +129,7 @@
(def: #export (typed-definition compiler)
{#.doc "A reader for definitions that ensures the input syntax is typed."}
(-> Lux (Syntax //.Definition))
- (do p.Monad<Parser>
+ (do p.monad
[_definition (definition compiler)
_ (case (get@ #//.definition-type _definition)
(#.Some _)
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index 3affd97f7..3a9e2b0a0 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -3,7 +3,7 @@
[lux #*
[data
[collection
- [list ("list/." Functor<List>)]]
+ [list ("list/." functor)]]
["." product]]
["." function]
[macro
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index b5fca4e69..21621ba07 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -1,6 +1,6 @@
(.module:
[lux #*]
- ["." // ("meta/." Monad<Meta>)])
+ ["." // ("meta/." monad)])
(macro: #export (splice tokens)
(case tokens
diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux
index 145b8f579..dec158d52 100644
--- a/stdlib/source/lux/math/infix.lux
+++ b/stdlib/source/lux/math/infix.lux
@@ -2,11 +2,11 @@
[lux #*
[control
monad
- ["p" parser ("parser/." Functor<Parser>)]]
+ ["p" parser ("parser/." functor)]]
[data
["." product]
[collection
- [list ("list/." Fold<List>)]]]
+ [list ("list/." fold)]]]
[macro
["s" syntax (#+ syntax: Syntax)]
["." code]]])
@@ -33,7 +33,7 @@
(s.form (p.many s.any))
(s.tuple (p.and s.any infix^))
(s.tuple ($_ p.either
- (do p.Monad<Parser>
+ (do p.monad
[_ (s.this (' #and))
init-subject infix^
init-op s.any
@@ -45,7 +45,7 @@
(#Binary subject op param)]])
[init-param [init-subject init-op init-param]]
steps))))
- (do p.Monad<Parser>
+ (do p.monad
[init-subject infix^
init-op s.any
init-param infix^
diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux
index edc31f2a7..2f384742a 100644
--- a/stdlib/source/lux/math/logic/continuous.lux
+++ b/stdlib/source/lux/math/logic/continuous.lux
@@ -1,6 +1,8 @@
(.module:
[lux (#- false true or and not)
- [data [number ("rev/." Interval<Rev>)]]])
+ [data
+ [number
+ [rev ("rev/." interval)]]]])
(def: #export true Rev rev/top)
(def: #export false Rev rev/bottom)
diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux
index 6222ed87b..8c0922af2 100644
--- a/stdlib/source/lux/math/modular.lux
+++ b/stdlib/source/lux/math/modular.lux
@@ -7,8 +7,9 @@
[monad (#+ do)]]
[data
["." error (#+ Error)]
- ["." number ("int/." Codec<Text,Int>)]
- [text ("text/." Monoid<Text>)
+ [number
+ ["." int ("int/." decimal)]]
+ [text ("text/." monoid)
["l" lexer (#+ Lexer)]]]
[type
abstract]
@@ -62,7 +63,7 @@
(def: intL
(Lexer Int)
- (p.codec number.Codec<Text,Int>
+ (p.codec int.decimal
(p.either (l.and (l.one-of "-") (l.many l.decimal))
(l.many l.decimal))))
@@ -84,7 +85,7 @@
(def: separator Text " mod ")
- (structure: #export (Codec<Text,Mod> modulus)
+ (structure: #export (codec modulus)
(All [m] (-> (Modulus m) (Codec Text (Mod m))))
(def: (encode modular)
@@ -96,7 +97,7 @@
(def: (decode text)
(<| (l.run text)
- (do p.Monad<Parser>
+ (do p.monad
[[remainder _ _modulus] ($_ p.and intL (l.this separator) intL)
_ (p.assert (ex.construct incorrect-modulus [modulus _modulus])
(i/= (to-int modulus) _modulus))]
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index b73e7df02..433cba425 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -8,14 +8,15 @@
[data
["." product]
["." maybe]
- ["." number (#+ hex)
+ [number (#+ hex)
["." i64]
["r" ratio]
- ["c" complex]]
- ["." text ("text/." Monoid<Text>)
- ["." unicode (#+ Char Segment)]]
+ ["c" complex]
+ ["." frac]]
+ ["." text (#+ Char) ("text/." monoid)
+ ["." unicode (#+ Segment)]]
[collection
- ["." list ("list/." Fold<List>)]
+ ["." list ("list/." fold)]
["." array (#+ Array)]
["." dictionary (#+ Dictionary)]
["." queue (#+ Queue)]
@@ -35,14 +36,14 @@
{#.doc "A producer of random values based on a PRNG."}
(-> PRNG [PRNG a]))
-(structure: #export _ (Functor Random)
+(structure: #export functor (Functor Random)
(def: (map f fa)
(function (_ state)
(let [[state' a] (fa state)]
[state' (f a)]))))
-(structure: #export _ (Apply Random)
- (def: functor Functor<Random>)
+(structure: #export apply (Apply Random)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ state)
@@ -50,8 +51,8 @@
[state'' a] (fa state')]
[state'' (f a)]))))
-(structure: #export _ (Monad Random)
- (def: functor Functor<Random>)
+(structure: #export monad (Monad Random)
+ (def: &functor ..functor)
(def: (wrap a)
(function (_ state)
@@ -65,7 +66,7 @@
(def: #export (filter pred gen)
{#.doc "Retries the generator until the output satisfies a predicate."}
(All [a] (-> (-> a Bit) (Random a) (Random a)))
- (do Monad<Random>
+ (do ..monad
[sample gen]
(if (pred sample)
(wrap sample)
@@ -74,7 +75,7 @@
(def: #export (refine refiner gen)
{#.doc "Retries the generator until the output can be refined."}
(All [t r] (-> (Refiner t r) (Random t) (Random (Refined t r))))
- (do Monad<Random>
+ (do ..monad
[sample gen]
(case (refiner sample)
(#.Some refined)
@@ -101,7 +102,7 @@
(do-template [<name> <type> <cast>]
[(def: #export <name>
(Random <type>)
- (:: Monad<Random> map <cast> ..i64))]
+ (:: ..monad map <cast> ..i64))]
[nat Nat .nat]
[int Int .int]
@@ -110,7 +111,7 @@
(def: #export frac
(Random Frac)
- (:: Monad<Random> map number.bits-to-frac nat))
+ (:: ..monad map frac.bits-to-frac ..nat))
(def: #export (char set)
(-> unicode.Set (Random Char))
@@ -120,7 +121,7 @@
in-range (: (-> Char Char)
(|>> (n/% size) (n/+ start)))]
(|> nat
- (:: Monad<Random> map in-range)
+ (:: ..monad map in-range)
(..filter (function (_ char)
(finger.found? (function (_ segment)
(unicode.within? segment char))
@@ -129,8 +130,8 @@
(def: #export (text char-gen size)
(-> (Random Char) Nat (Random Text))
(if (n/= 0 size)
- (:: Monad<Random> wrap "")
- (do Monad<Random>
+ (:: ..monad wrap "")
+ (do ..monad
[x char-gen
xs (text char-gen (dec size))]
(wrap (text/compose (text.from-code x) xs)))))
@@ -150,7 +151,7 @@
(do-template [<name> <type> <ctor> <gen>]
[(def: #export <name>
(Random <type>)
- (do Monad<Random>
+ (do ..monad
[left <gen>
right <gen>]
(wrap (<ctor> left right))))]
@@ -162,7 +163,7 @@
(def: #export (and left right)
{#.doc "Sequencing combinator."}
(All [a b] (-> (Random a) (Random b) (Random [a b])))
- (do Monad<Random>
+ (do ..monad
[=left left
=right right]
(wrap [=left =right])))
@@ -170,7 +171,7 @@
(def: #export (or left right)
{#.doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Random a) (Random b) (Random (| a b))))
- (do Monad<Random>
+ (do ..monad
[? bit]
(if ?
(do @
@@ -183,7 +184,7 @@
(def: #export (either left right)
{#.doc "Homogeneous alternative combinator."}
(All [a] (-> (Random a) (Random a) (Random a)))
- (do Monad<Random>
+ (do ..monad
[? bit]
(if ?
left
@@ -198,7 +199,7 @@
(def: #export (maybe value-gen)
(All [a] (-> (Random a) (Random (Maybe a))))
- (do Monad<Random>
+ (do ..monad
[some? bit]
(if some?
(do @
@@ -210,11 +211,11 @@
[(def: #export (<name> size value-gen)
(All [a] (-> Nat (Random a) (Random (<type> a))))
(if (n/> 0 size)
- (do Monad<Random>
+ (do ..monad
[x value-gen
xs (<name> (dec size) value-gen)]
(wrap (<plus> x xs)))
- (:: Monad<Random> wrap <zero>)))]
+ (:: ..monad wrap <zero>)))]
[list List (.list) #.Cons]
[row Row row.empty row.add]
@@ -223,7 +224,7 @@
(do-template [<name> <type> <ctor>]
[(def: #export (<name> size value-gen)
(All [a] (-> Nat (Random a) (Random (<type> a))))
- (do Monad<Random>
+ (do ..monad
[values (list size value-gen)]
(wrap (|> values <ctor>))))]
@@ -235,7 +236,7 @@
(def: #export (set Hash<a> size value-gen)
(All [a] (-> (Hash a) Nat (Random a) (Random (Set a))))
(if (n/> 0 size)
- (do Monad<Random>
+ (do ..monad
[xs (set Hash<a> (dec size) value-gen)]
(loop [_ []]
(do @
@@ -244,12 +245,12 @@
(if (n/= size (set.size xs+))
(wrap xs+)
(recur [])))))
- (:: Monad<Random> wrap (set.new Hash<a>))))
+ (:: ..monad wrap (set.new Hash<a>))))
(def: #export (dictionary Hash<a> size key-gen value-gen)
(All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v))))
(if (n/> 0 size)
- (do Monad<Random>
+ (do ..monad
[kv (dictionary Hash<a> (dec size) key-gen value-gen)]
(loop [_ []]
(do @
@@ -259,7 +260,7 @@
(if (n/= size (dictionary.size kv+))
(wrap kv+)
(recur [])))))
- (:: Monad<Random> wrap (dictionary.new Hash<a>))))
+ (:: ..monad wrap (dictionary.new Hash<a>))))
(def: #export (run prng calc)
(All [a] (-> PRNG (Random a) [PRNG a]))
diff --git a/stdlib/source/lux/platform/compiler.lux b/stdlib/source/lux/platform/compiler.lux
index d6c6d82d9..b4fdd541e 100644
--- a/stdlib/source/lux/platform/compiler.lux
+++ b/stdlib/source/lux/platform/compiler.lux
@@ -7,7 +7,6 @@
[collection
["." dictionary (#+ Dictionary)]]]
[world
- ["." binary (#+ Binary)]
["." file (#+ File)]]]
[/
[meta
@@ -16,29 +15,32 @@
[descriptor (#+ Module)]
[document (#+ Document)]]]])
-(type: #export Code Text)
+(type: #export Code
+ Text)
-(type: #export Parameter Text)
+(type: #export Parameter
+ Text)
(type: #export Input
{#module Module
#file File
+ #hash Nat
#code Code})
-(type: #export Output
- (Dictionary Text Binary))
+(type: #export (Output o)
+ (Dictionary Text o))
-(type: #export (Compilation d)
+(type: #export (Compilation d o)
{#dependencies (List Module)
#process (-> Archive
- (Error (Either (Compilation d)
- [(Document d) Output])))})
+ (Error (Either (Compilation d o)
+ [(Document d) (Output o)])))})
-(type: #export (Compiler d)
- (-> (Key d) (List Parameter) Input (Compilation d)))
+(type: #export (Compiler d o)
+ (-> Input (Compilation d o)))
-(type: #export (Importer !)
- (-> (file.System !) Module Archive (! (Error Archive))))
+(type: #export (Instancer d o)
+ (-> (Key d) (List Parameter) (Compiler d o)))
(exception: #export (cannot-compile {module Module})
(ex.report ["Module" module]))
diff --git a/stdlib/source/lux/platform/compiler/cli.lux b/stdlib/source/lux/platform/compiler/cli.lux
index 55ce35145..7e92b2c34 100644
--- a/stdlib/source/lux/platform/compiler/cli.lux
+++ b/stdlib/source/lux/platform/compiler/cli.lux
@@ -4,10 +4,12 @@
["p" parser]]
["." cli (#+ CLI)]
[world
- [file (#+ File)]]])
+ [file (#+ File)]]]
+ [///
+ [importer (#+ Source)]])
(type: #export Configuration
- {#sources (List File)
+ {#sources (List Source)
#target File
#module Text})
diff --git a/stdlib/source/lux/platform/compiler/default/evaluation.lux b/stdlib/source/lux/platform/compiler/default/evaluation.lux
index 157596e84..1f21304ca 100644
--- a/stdlib/source/lux/platform/compiler/default/evaluation.lux
+++ b/stdlib/source/lux/platform/compiler/default/evaluation.lux
@@ -25,12 +25,12 @@
(translation.Phase anchor expression statement)
Eval))
(function (eval count type exprC)
- (do phase.Monad<Operation>
+ (do phase.monad
[exprA (type.with-type type
(expressionA.compile exprC))]
- (phase.lift (do error.Monad<Error>
+ (phase.lift (do error.monad
[exprS (|> exprA expressionS.phase (phase.run synthesis-state))]
(phase.run translation-state
- (do phase.Monad<Operation>
+ (do phase.monad
[exprO (translate exprS)]
(translation.evaluate! (format "eval" (%n count)) exprO))))))))
diff --git a/stdlib/source/lux/platform/compiler/default/init.lux b/stdlib/source/lux/platform/compiler/default/init.lux
index 012ab3ea9..b71596150 100644
--- a/stdlib/source/lux/platform/compiler/default/init.lux
+++ b/stdlib/source/lux/platform/compiler/default/init.lux
@@ -6,7 +6,7 @@
[data
["." product]
["." error (#+ Error)]
- ["." text ("text/." Hash<Text>)]
+ ["." text ("text/." hash)]
[collection
["." dictionary]]]
["." macro]
@@ -54,7 +54,7 @@
(def: refresh
(All [anchor expression statement]
(statement.Operation anchor expression statement Any))
- (do phase.Monad<Operation>
+ (do phase.monad
[[bundle state] phase.get-state
#let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state)
(get@ [#statement.translation #statement.state] state)
@@ -114,7 +114,7 @@
(def: (begin hash input)
(-> Nat ///.Input <Operation>)
(statement.lift-analysis
- (do phase.Monad<Operation>
+ (do phase.monad
[#let [module (get@ #///.module input)]
_ (module.create hash module)
_ (analysis.set-current-module module)]
@@ -127,7 +127,7 @@
(def: (iteration reader)
(-> Reader <Operation>)
- (do phase.Monad<Operation>
+ (do phase.monad
[code (statement.lift-analysis
(..read reader))
_ (totalS.phase code)]
@@ -135,7 +135,7 @@
(def: (loop module)
(-> Module <Operation>)
- (do phase.Monad<Operation>
+ (do phase.monad
[reader (statement.lift-analysis
(..reader module syntax.no-aliases))]
(function (_ state)
@@ -151,7 +151,7 @@
(def: (compile hash input)
(-> Nat ///.Input <Operation>)
- (do phase.Monad<Operation>
+ (do phase.monad
[#let [module (get@ #///.module input)]
_ (..begin hash input)
_ (..loop module)]
@@ -174,11 +174,11 @@
dependencies (default-dependencies prelude input)]
{#///.dependencies dependencies
#///.process (function (_ archive)
- (do error.Monad<Error>
+ (do error.monad
[[state' analysis-module] (phase.run' state
(: (All [anchor expression statement]
(statement.Operation anchor expression statement .Module))
- (do phase.Monad<Operation>
+ (do phase.monad
[_ (compile hash input)]
(statement.lift-analysis
(extension.lift
@@ -189,7 +189,7 @@
#descriptor.references dependencies
#descriptor.state #.Compiled}]]
(wrap (#.Right [(document.write key descriptor analysis-module)
- (dictionary.new text.Hash<Text>)]))))})))
+ (dictionary.new text.hash)]))))})))
(def: #export key
(Key .Module)
diff --git a/stdlib/source/lux/platform/compiler/default/platform.lux b/stdlib/source/lux/platform/compiler/default/platform.lux
index 10dfd6ebb..7e3846c09 100644
--- a/stdlib/source/lux/platform/compiler/default/platform.lux
+++ b/stdlib/source/lux/platform/compiler/default/platform.lux
@@ -28,7 +28,7 @@
## (def: (write-module target-dir file-name module-name module outputs)
## (-> File Text Text Module Outputs (Process Any))
-## (do io.Monad<Process>
+## (do (error.with-error io.monad)
## [_ (monad.map @ (product.uncurry (&io.write target-dir))
## (dictionary.entries outputs))]
## (&io.write target-dir
@@ -48,7 +48,7 @@
(phase.run' (init.state (get@ #host platform)
(get@ #phase platform)
translation-bundle))
- (:: error.Functor<Error> map product.left)
+ (:: error.functor map product.left)
(:: (get@ #file-system platform) lift))
## (case (runtimeT.translate ## (initL.compiler (io.run js.init))
diff --git a/stdlib/source/lux/platform/compiler/default/syntax.lux b/stdlib/source/lux/platform/compiler/default/syntax.lux
index a1bb9f3ea..c76857aab 100644
--- a/stdlib/source/lux/platform/compiler/default/syntax.lux
+++ b/stdlib/source/lux/platform/compiler/default/syntax.lux
@@ -31,7 +31,11 @@
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
- ["." number]
+ [number
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
["." text
[lexer (#+ Offset)]
format]
@@ -82,7 +86,7 @@
)
(type: #export Aliases (Dictionary Text Text))
-(def: #export no-aliases Aliases (dictionary.new text.Hash<Text>))
+(def: #export no-aliases Aliases (dictionary.new text.hash))
(def: #export prelude "lux")
@@ -302,8 +306,8 @@
(def: no-exponent Offset 0)
-(with-expansions [<int-output> (as-is (!number-output start end number.Codec<Text,Int> #.Int))
- <frac-output> (as-is (!number-output start end number.Codec<Text,Frac> #.Frac))
+(with-expansions [<int-output> (as-is (!number-output start end int.decimal #.Int))
+ <frac-output> (as-is (!number-output start end frac.decimal #.Frac))
<failure> (ex.throw unrecognized-input [where "Frac" source-code offset])]
(def: (parse-frac source-code//size start [where offset source-code])
(-> Nat Offset Parser)
@@ -351,8 +355,8 @@
(recur (!inc g!end))
(!number-output start g!end <codec> <tag>)))))]
- [!parse-nat number.Codec<Text,Nat> #.Nat]
- [!parse-rev number.Codec<Text,Rev> #.Rev]
+ [!parse-nat nat.decimal #.Nat]
+ [!parse-rev rec.decimal #.Rev]
)
(template: (!parse-signed source-code//size offset where source-code @end)
diff --git a/stdlib/source/lux/platform/compiler/host/scheme.lux b/stdlib/source/lux/platform/compiler/host/scheme.lux
index 8d5cbdbcd..f3550ad88 100644
--- a/stdlib/source/lux/platform/compiler/host/scheme.lux
+++ b/stdlib/source/lux/platform/compiler/host/scheme.lux
@@ -7,7 +7,7 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]]]
+ ["." list ("list/." functor fold)]]]
[type
abstract]])
diff --git a/stdlib/source/lux/platform/compiler/meta/archive.lux b/stdlib/source/lux/platform/compiler/meta/archive.lux
index f36a0b754..c318bfaf7 100644
--- a/stdlib/source/lux/platform/compiler/meta/archive.lux
+++ b/stdlib/source/lux/platform/compiler/meta/archive.lux
@@ -38,14 +38,14 @@
(abstract: #export Archive
{}
- (Dictionary Text <Document>)
+ (Dictionary Text [Descriptor <Document>])
(def: #export empty
Archive
- (:abstraction (dictionary.new text.Hash<Text>)))
+ (:abstraction (dictionary.new text.hash)))
- (def: #export (add name document archive)
- (-> Module <Document> Archive (Error Archive))
+ (def: #export (add name descriptor document archive)
+ (-> Module Descriptor <Document> Archive (Error Archive))
(case (dictionary.get name (:representation archive))
(#.Some existing)
(if (is? document existing)
@@ -53,11 +53,13 @@
(ex.throw cannot-replace-document [name existing document]))
#.None
- (#error.Success (:abstraction (dictionary.put name document
- (:representation archive))))))
+ (#error.Success (|> archive
+ :representation
+ (dictionary.put name [descriptor document])
+ :abstraction))))
(def: #export (find name archive)
- (-> Module Archive (Error <Document>))
+ (-> Module Archive (Error [Descriptor <Document>]))
(case (dictionary.get name (:representation archive))
(#.Some document)
(#error.Success document)
@@ -67,9 +69,9 @@
(def: #export (merge additions archive)
(-> Archive Archive (Error Archive))
- (monad.fold error.Monad<Error>
- (function (_ [name' document'] archive')
- (..add name' document' archive'))
+ (monad.fold error.monad
+ (function (_ [name' descriptor+document'] archive')
+ (..add name' descriptor+document' archive'))
archive
(dictionary.entries (:representation additions))))
))
diff --git a/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux
index 6c7e6744e..328240e6c 100644
--- a/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux
+++ b/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux
@@ -1,5 +1,8 @@
(.module:
[lux (#- Module)
+ [data
+ [collection
+ [set (#+ Set)]]]
[world
[file (#+ File)]]])
@@ -9,5 +12,5 @@
{#hash Nat
#name Module
#file File
- #references (List Module)
+ #references (Set Module)
#state Module-State})
diff --git a/stdlib/source/lux/platform/compiler/meta/archive/document.lux b/stdlib/source/lux/platform/compiler/meta/archive/document.lux
index b99ff9b72..5c077080f 100644
--- a/stdlib/source/lux/platform/compiler/meta/archive/document.lux
+++ b/stdlib/source/lux/platform/compiler/meta/archive/document.lux
@@ -11,25 +11,23 @@
[//
["." signature (#+ Signature)]
["." key (#+ Key)]
- ["." descriptor (#+ Module Descriptor)]])
+ [descriptor (#+ Module)]])
## Document
-(exception: #export (invalid-signature {module Module} {expected Signature} {actual Signature})
- (ex.report ["Module" module]
- ["Expected" (signature.description expected)]
+(exception: #export (invalid-signature {expected Signature} {actual Signature})
+ (ex.report ["Expected" (signature.description expected)]
["Actual" (signature.description actual)]))
(abstract: #export (Document d)
{}
{#signature Signature
- #descriptor Descriptor
#content d}
(def: #export (read key document)
(All [d] (-> (Key d) (Document Any) (Error d)))
- (let [[document//signature document//descriptor document//content] (:representation document)]
- (if (:: signature.Equivalence<Signature> =
+ (let [[document//signature document//content] (:representation document)]
+ (if (:: signature.equivalence =
(key.signature key)
document//signature)
(#error.Success (:share [e]
@@ -37,14 +35,12 @@
key}
{e
document//content}))
- (ex.throw invalid-signature [(get@ #descriptor.name document//descriptor)
- (key.signature key)
+ (ex.throw invalid-signature [(key.signature key)
document//signature]))))
- (def: #export (write key descriptor content)
- (All [d] (-> (Key d) Descriptor d (Document d)))
+ (def: #export (write key content)
+ (All [d] (-> (Key d) d (Document d)))
(:abstraction {#signature (key.signature key)
- #descriptor descriptor
#content content}))
(def: #export signature
diff --git a/stdlib/source/lux/platform/compiler/meta/archive/signature.lux b/stdlib/source/lux/platform/compiler/meta/archive/signature.lux
index 5332b79c3..fb96aec58 100644
--- a/stdlib/source/lux/platform/compiler/meta/archive/signature.lux
+++ b/stdlib/source/lux/platform/compiler/meta/archive/signature.lux
@@ -14,9 +14,9 @@
{#name Name
#version Version})
-(def: #export Equivalence<Signature>
+(def: #export equivalence
(Equivalence Signature)
- (equivalence.product name.Equivalence<Name> text.Equivalence<Text>))
+ (equivalence.product name.equivalence text.equivalence))
(def: #export (description signature)
(-> Signature Text)
diff --git a/stdlib/source/lux/platform/compiler/meta/cache.lux b/stdlib/source/lux/platform/compiler/meta/cache.lux
index ceed96164..c54fac935 100644
--- a/stdlib/source/lux/platform/compiler/meta/cache.lux
+++ b/stdlib/source/lux/platform/compiler/meta/cache.lux
@@ -5,7 +5,7 @@
["ex" exception (#+ exception:)]
pipe]
[data
- ["." bit ("bit/." Equivalence<Bit>)]
+ ["." bit ("bit/." equivalence)]
["." maybe]
["." error]
["." product]
@@ -14,7 +14,7 @@
["." text
[format (#- Format)]]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]
+ ["." list ("list/." functor fold)]
["dict" dictionary (#+ Dictionary)]
["." set (#+ Set)]]]
[world
@@ -122,12 +122,12 @@
(do (:: System<m> &monad)
[document' (:: System<m> read (io/archive.document System<m> root module))
[module' source-code] (io/context.read System<m> contexts module)
- #let [current-hash (:: text.Hash<Text> hash source-code)]]
- (case (do error.Monad<Error>
+ #let [current-hash (:: text.hash hash source-code)]]
+ (case (do error.monad
[[signature descriptor content] (binary.read (..document binary) document')
#let [[document-hash _file references _state] descriptor]
_ (ex.assert mismatched-signature [module (get@ #archive.signature key) signature]
- (:: archive.Equivalence<Signature> =
+ (:: archive.equivalence =
(get@ #archive.signature key)
signature))
_ (ex.assert stale-document [module current-hash document-hash]
@@ -157,13 +157,13 @@
#.None
archive))
(: (Dictionary Text [(List Module) (Ex [d] (Document d))])
- (dict.new text.Hash<Text>))))]))
+ (dict.new text.hash))))]))
#let [candidate-entries (dict.entries candidate)
candidate-dependencies (list/map (product.both id product.left)
candidate-entries)
candidate-archive (|> candidate-entries
(list/map (product.both id product.right))
- (dict.from-list text.Hash<Text>))
+ (dict.from-list text.hash))
graph (|> candidate
dict.entries
(list/map (product.both id product.left))
diff --git a/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux b/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux
index e63fa192b..d18b92d59 100644
--- a/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux
+++ b/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux
@@ -3,14 +3,14 @@
[data
["." text]
[collection
- [list ("list/." Functor<List> Fold<List>)]
+ [list ("list/." functor fold)]
["dict" dictionary (#+ Dictionary)]]]]
[///io (#+ Module)]
[///archive (#+ Archive)])
(type: #export Graph (Dictionary Module (List Module)))
-(def: #export empty Graph (dict.new text.Hash<Text>))
+(def: #export empty Graph (dict.new text.hash))
(def: #export (add to from)
(-> Module Module Graph Graph)
diff --git a/stdlib/source/lux/platform/compiler/phase.lux b/stdlib/source/lux/platform/compiler/phase.lux
index a81d5dfa7..203ed73bc 100644
--- a/stdlib/source/lux/platform/compiler/phase.lux
+++ b/stdlib/source/lux/platform/compiler/phase.lux
@@ -6,7 +6,7 @@
[monad (#+ do)]]
[data
["." product]
- ["." error (#+ Error) ("error/." Functor<Error>)]
+ ["." error (#+ Error) ("error/." functor)]
["." text
format]]
[time
@@ -19,8 +19,8 @@
(type: #export (Operation s o)
(state.State' Error s o))
-(def: #export Monad<Operation>
- (state.Monad<State'> error.Monad<Error>))
+(def: #export monad
+ (state.monad error.monad))
(type: #export (Phase s i o)
(-> i (Operation s o)))
@@ -35,7 +35,7 @@
(-> s (Operation s o) (Error o)))
(|> state
operation
- (:: error.Monad<Error> map product.right)))
+ (:: error.monad map product.right)))
(def: #export get-state
(All [s o]
@@ -55,17 +55,17 @@
(Operation s' o)
(Operation s o)))
(function (_ state)
- (do error.Monad<Error>
+ (do error.monad
[[state' output] (operation (get state))]
(wrap [(set state' state) output]))))
(def: #export fail
(-> Text Operation)
- (|>> error.fail (state.lift error.Monad<Error>)))
+ (|>> error.fail (state.lift error.monad)))
(def: #export (throw exception parameters)
(All [e] (-> (Exception e) e Operation))
- (state.lift error.Monad<Error>
+ (state.lift error.monad
(ex.throw exception parameters)))
(def: #export (lift error)
@@ -75,7 +75,7 @@
(syntax: #export (assert exception message test)
(wrap (list (` (if (~ test)
- (:: ..Monad<Operation> (~' wrap) [])
+ (:: ..monad (~' wrap) [])
(..throw (~ exception) (~ message)))))))
(def: #export (with-stack exception message action)
@@ -94,7 +94,7 @@
(Phase s1 t o)
(Phase [s0 s1] i o)))
(function (_ input [pre/state post/state])
- (do error.Monad<Error>
+ (do error.monad
[[pre/state' temp] (pre input pre/state)
[post/state' output] (post temp post/state)]
(wrap [[pre/state' post/state'] output]))))
@@ -102,7 +102,7 @@
(def: #export (timed definition description operation)
(All [s a]
(-> Name Text (Operation s a) (Operation s a)))
- (do Monad<Operation>
+ (do ..monad
[_ (wrap [])
#let [pre (io.run instant.now)]
output operation
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis.lux b/stdlib/source/lux/platform/compiler/phase/analysis.lux
index c5256436f..d1bd6a986 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis.lux
@@ -6,10 +6,10 @@
["." product]
["." error]
["." maybe]
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
format]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]]]
+ ["." list ("list/." functor fold)]]]
["." function]]
[//
["." extension (#+ Extension)]
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/case.lux b/stdlib/source/lux/platform/compiler/phase/analysis/case.lux
index d7b020932..343d4c813 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/case.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/case.lux
@@ -10,7 +10,7 @@
[text
format]
[collection
- ["." list ("list/." Fold<List> Monoid<List> Functor<List>)]]]
+ ["." list ("list/." fold monoid functor)]]]
["." type
["." check]]
["." macro
@@ -69,7 +69,7 @@
caseT caseT]
(.case caseT
(#.Var id)
- (do ///.Monad<Operation>
+ (do ///.monad
[?caseT' (//type.with-env
(check.read id))]
(.case ?caseT'
@@ -86,7 +86,7 @@
(recur (#.Cons env envs) unquantifiedT)
(#.ExQ _)
- (do ///.Monad<Operation>
+ (do ///.monad
[[ex-id exT] (//type.with-env
check.existential)]
(recur envs (maybe.assume (type.apply (list exT) caseT))))
@@ -94,9 +94,9 @@
(#.Apply inputT funcT)
(.case funcT
(#.Var funcT-id)
- (do ///.Monad<Operation>
+ (do ///.monad
[funcT' (//type.with-env
- (do check.Monad<Check>
+ (do check.monad
[?funct' (check.read funcT-id)]
(.case ?funct'
(#.Some funct')
@@ -119,15 +119,15 @@
type.flatten-tuple
(list/map (re-quantify envs))
type.tuple
- (:: ///.Monad<Operation> wrap))
+ (:: ///.monad wrap))
_
- (:: ///.Monad<Operation> wrap (re-quantify envs caseT)))))
+ (:: ///.monad wrap (re-quantify envs caseT)))))
(def: (analyse-primitive type inputT cursor output next)
(All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a])))
(//.with-cursor cursor
- (do ///.Monad<Operation>
+ (do ///.monad
[_ (//type.with-env
(check.check inputT type))
outputA next]
@@ -154,7 +154,7 @@
(.case pattern
[cursor (#.Identifier ["" name])]
(//.with-cursor cursor
- (do ///.Monad<Operation>
+ (do ///.monad
[outputA (scope.with-local [name inputT]
next)
idx scope.next-local]
@@ -176,7 +176,7 @@
[cursor (#.Tuple sub-patterns)]
(//.with-cursor cursor
- (do ///.Monad<Operation>
+ (do ///.monad
[inputT' (simplify-case inputT)]
(.case inputT'
(#.Product _)
@@ -216,7 +216,7 @@
)))
[cursor (#.Record record)]
- (do ///.Monad<Operation>
+ (do ///.monad
[record (structure.normalize record)
[members recordT] (structure.order record)
_ (//type.with-env
@@ -229,7 +229,7 @@
(^ [cursor (#.Form (list& [_ (#.Nat idx)] values))])
(//.with-cursor cursor
- (do ///.Monad<Operation>
+ (do ///.monad
[inputT' (simplify-case inputT)]
(.case inputT'
(#.Sum _)
@@ -239,7 +239,7 @@
(.case (list.nth idx flat-sum)
(^multi (#.Some caseT)
(n/< num-cases idx))
- (do ///.Monad<Operation>
+ (do ///.monad
[[testP nextA] (if (and (n/> num-cases size-sum)
(n/= (dec num-cases) idx))
(analyse-pattern #.None
@@ -262,7 +262,7 @@
(^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
(//.with-cursor cursor
- (do ///.Monad<Operation>
+ (do ///.monad
[tag (extension.lift (macro.normalize tag))
[idx group variantT] (extension.lift (macro.resolve-tag tag))
_ (//type.with-env
@@ -277,7 +277,7 @@
(-> Phase Code (List [Code Code]) (Operation Analysis))
(.case branches
(#.Cons [patternH bodyH] branchesT)
- (do ///.Monad<Operation>
+ (do ///.monad
[[inputT inputA] (//type.with-inference
(analyse inputC))
outputH (analyse-pattern #.None inputT patternH (analyse bodyH))
@@ -287,7 +287,7 @@
branchesT)
outputHC (|> outputH product.left coverage.determine)
outputTC (monad.map @ (|>> product.left coverage.determine) outputT)
- _ (.case (monad.fold error.Monad<Error> coverage.merge outputHC outputTC)
+ _ (.case (monad.fold error.monad coverage.merge outputHC outputTC)
(#error.Success coverage)
(///.assert non-exhaustive-pattern-matching [inputC branches coverage]
(coverage.exhaustive? coverage))
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux
index bdf524f73..b21df1fcd 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux
@@ -5,16 +5,16 @@
["ex" exception (#+ exception:)]
equivalence]
[data
- [bit ("bit/." Equivalence<Bit>)]
+ [bit ("bit/." equivalence)]
["." number]
- ["." error (#+ Error) ("error/." Monad<Error>)]
+ ["." error (#+ Error) ("error/." monad)]
["." maybe]
["." text
format]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]
+ ["." list ("list/." functor fold)]
["." dictionary (#+ Dictionary)]]]]
- ["." //// ("operation/." Monad<Operation>)]
+ ["." //// ("operation/." monad)]
["." /// (#+ Pattern Variant Operation)])
(exception: #export (invalid-tuple-pattern)
@@ -119,11 +119,11 @@
(////.throw invalid-tuple-pattern [])
(#.Cons lastP prevsP+)
- (do ////.Monad<Operation>
+ (do ////.monad
[lastC (determine lastP)]
- (monad.fold ////.Monad<Operation>
+ (monad.fold ////.monad
(function (_ leftP rightC)
- (do ////.Monad<Operation>
+ (do ////.monad
[leftC (determine leftP)]
(case rightC
#Exhaustive
@@ -136,7 +136,7 @@
## Variant patterns can be shown to be exhaustive if all the possible
## cases are handled exhaustively.
(#///.Complex (#///.Variant [lefts right? value]))
- (do ////.Monad<Operation>
+ (do ////.monad
[value-coverage (determine value)
#let [idx (if right?
(inc lefts)
@@ -144,7 +144,7 @@
(wrap (#Variant (if right?
(#.Some idx)
#.None)
- (|> (dictionary.new number.Hash<Nat>)
+ (|> (dictionary.new number.hash)
(dictionary.put idx value-coverage)))))))
(def: (xor left right)
@@ -183,7 +183,7 @@
[(#Variant allR casesR) (#Variant allS casesS)]
(and (n/= (cases allR)
(cases allS))
- (:: (dictionary.Equivalence<Dictionary> =) = casesR casesS))
+ (:: (dictionary.equivalence =) = casesR casesS))
[(#Seq leftR rightR) (#Seq leftS rightS)]
(and (= leftR leftS)
@@ -200,7 +200,7 @@
_
#0)))
-(open: "coverage/." Equivalence<Coverage>)
+(open: "coverage/." ..equivalence)
(exception: #export (variants-do-not-match {addition-cases Nat} {so-far-cases Nat})
(ex.report ["So-far Cases" (%n so-far-cases)]
@@ -229,11 +229,11 @@
(not (n/= addition-cases so-far-cases)))
(ex.throw variants-do-not-match [addition-cases so-far-cases])
- (:: (dictionary.Equivalence<Dictionary> Equivalence<Coverage>) = casesSF casesA)
+ (:: (dictionary.equivalence ..equivalence) = casesSF casesA)
(ex.throw redundant-pattern [so-far addition])
## else
- (do error.Monad<Error>
+ (do error.monad
[casesM (monad.fold @
(function (_ [tagA coverageA] casesSF')
(case (dictionary.get tagA casesSF')
@@ -263,7 +263,7 @@
(case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)]
## Same prefix
[#1 #0]
- (do error.Monad<Error>
+ (do error.monad
[rightM (merge rightA rightSF)]
(if (exhaustive? rightM)
## If all that follows is exhaustive, then it can be safely dropped
@@ -274,7 +274,7 @@
## Same suffix
[#0 #1]
- (do error.Monad<Error>
+ (do error.monad
[leftM (merge leftA leftSF)]
(wrap (#Seq leftM rightA)))
@@ -314,7 +314,7 @@
## This process must be repeated until no further productive
## merges can be done.
[_ (#Alt leftS rightS)]
- (do error.Monad<Error>
+ (do error.monad
[#let [fuse-once (: (-> Coverage (List Coverage)
(Error [(Maybe Coverage)
(List Coverage)]))
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux b/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux
index 1da6520a5..3ce70fe9b 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux
@@ -26,7 +26,7 @@
(def: #export (compile code)
Phase
- (do ///.Monad<Operation>
+ (do ///.monad
[expectedT (extension.lift macro.expected-type)]
(let [[cursor code'] code]
## The cursor must be set in the state for the sake
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/function.lux b/stdlib/source/lux/platform/compiler/phase/analysis/function.lux
index a996457d9..a95412e42 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/function.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/function.lux
@@ -8,7 +8,7 @@
["." text
format]
[collection
- ["." list ("list/." Fold<List> Monoid<List> Monad<List>)]]]
+ ["." list ("list/." fold monoid monad)]]]
["." type
["." check]]
["." macro]]
@@ -35,7 +35,7 @@
(def: #export (function analyse function-name arg-name body)
(-> Phase Text Text Code (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[functionT (extension.lift macro.expected-type)]
(loop [expectedT functionT]
(///.with-stack cannot-analyse [expectedT function-name arg-name body]
@@ -97,6 +97,6 @@
(def: #export (apply analyse functionT functionA argsC+)
(-> Phase Type Analysis (List Code) (Operation Analysis))
(<| (///.with-stack cannot-apply [functionT argsC+])
- (do ///.Monad<Operation>
+ (do ///.monad
[[applyT argsA+] (inference.general analyse functionT argsC+)])
(wrap (//.apply [functionA argsA+]))))
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux b/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux
index 010bdc437..7ce10cb32 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux
@@ -8,11 +8,11 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
["." type
["." check]]
["." macro]]
- ["." /// ("operation/." Monad<Operation>)
+ ["." /// ("operation/." monad)
["." extension]]
[// (#+ Tag Analysis Operation Phase)]
["." //type])
@@ -84,7 +84,7 @@
(def: new-named-type
(Operation Type)
- (do ///.Monad<Operation>
+ (do ///.monad
[cursor (extension.lift macro.cursor)
[ex-id _] (//type.with-env check.existential)]
(wrap (named-type cursor ex-id))))
@@ -100,7 +100,7 @@
(-> Phase Type (List Code) (Operation [Type (List Analysis)]))
(case args
#.Nil
- (do ///.Monad<Operation>
+ (do ///.monad
[_ (//type.infer inferT)]
(wrap [inferT (list)]))
@@ -110,12 +110,12 @@
(general analyse unnamedT args)
(#.UnivQ _)
- (do ///.Monad<Operation>
+ (do ///.monad
[[var-id varT] (//type.with-env check.var)]
(general analyse (maybe.assume (type.apply (list varT) inferT)) args))
(#.ExQ _)
- (do ///.Monad<Operation>
+ (do ///.monad
[[var-id varT] (//type.with-env check.var)
output (general analyse
(maybe.assume (type.apply (list varT) inferT))
@@ -146,7 +146,7 @@
## avoided in Lux code, since the inference algorithm can piece
## things together more easily.
(#.Function inputT outputT)
- (do ///.Monad<Operation>
+ (do ///.monad
[[outputT' args'A] (general analyse outputT args')
argA (<| (///.with-stack cannot-infer-argument [inputT argC])
(//type.with-type inputT)
@@ -154,7 +154,7 @@
(wrap [outputT' (list& argA args'A)]))
(#.Var infer-id)
- (do ///.Monad<Operation>
+ (do ///.monad
[?inferT' (//type.with-env (check.read infer-id))]
(case ?inferT'
(#.Some inferT')
@@ -176,7 +176,7 @@
(^template [<tag>]
(<tag> env bodyT)
- (do ///.Monad<Operation>
+ (do ///.monad
[bodyT+ (record bodyT)]
(wrap (<tag> env bodyT+))))
([#.UnivQ]
@@ -203,13 +203,13 @@
currentT inferT]
(case currentT
(#.Named name unnamedT)
- (do ///.Monad<Operation>
+ (do ///.monad
[unnamedT+ (recur depth unnamedT)]
(wrap unnamedT+))
(^template [<tag>]
(<tag> env bodyT)
- (do ///.Monad<Operation>
+ (do ///.monad
[bodyT+ (recur (inc depth) bodyT)]
(wrap (<tag> env bodyT+))))
([#.UnivQ]
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux b/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux
index 64dabaf43..d02478454 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux
@@ -9,7 +9,7 @@
format]
[collection
[array (#+ Array)]
- [list ("list/." Functor<List>)]]]
+ [list ("list/." functor)]]]
["." macro]
["." host (#+ import:)]]
["." ///])
@@ -49,7 +49,7 @@
(def: #export (expand name macro inputs)
(-> Name Macro (List Code) (Meta (List Code)))
(function (_ state)
- (do error.Monad<Error>
+ (do error.monad
[apply-method (|> macro
(:coerce Object)
(Object::getClass)
@@ -69,7 +69,7 @@
(def: #export (expand-one name macro inputs)
(-> Name Macro (List Code) (Meta Code))
- (do macro.Monad<Meta>
+ (do macro.monad
[expansion (expand name macro inputs)]
(case expansion
(^ (list single))
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/module.lux b/stdlib/source/lux/platform/compiler/phase/analysis/module.lux
index a8f6bda03..9905ee2dc 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/module.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/module.lux
@@ -5,11 +5,11 @@
["ex" exception (#+ exception:)]
pipe]
[data
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
format]
["." error]
[collection
- ["." list ("list/." Fold<List> Functor<List>)]
+ ["." list ("list/." fold functor)]
[dictionary
["." plist]]]]
["." macro]]
@@ -63,7 +63,7 @@
(def: #export (set-annotations annotations)
(-> Code (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[self-name (extension.lift macro.current-module-name)
self (extension.lift macro.current-module)]
(case (get@ #.module-annotations self)
@@ -80,7 +80,7 @@
(def: #export (import module)
(-> Text (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[self-name (extension.lift macro.current-module-name)]
(extension.lift
(function (_ state)
@@ -91,7 +91,7 @@
(def: #export (alias alias module)
(-> Text Text (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[self-name (extension.lift macro.current-module-name)]
(extension.lift
(function (_ state)
@@ -113,7 +113,7 @@
(def: #export (define name definition)
(-> Text Definition (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[self-name (extension.lift macro.current-module-name)
self (extension.lift macro.current-module)]
(extension.lift
@@ -144,7 +144,7 @@
(def: #export (with-module hash name action)
(All [a] (-> Nat Text (Operation a) (Operation [Module a])))
- (do ///.Monad<Operation>
+ (do ///.monad
[_ (create hash name)
output (//.with-current-module name
action)
@@ -210,7 +210,7 @@
(def: (ensure-undeclared-tags module-name tags)
(-> Text (List Tag) (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[bindings (..tags module-name)
_ (monad.map @
(function (_ tag)
@@ -225,7 +225,7 @@
(def: #export (declare-tags tags exported? type)
(-> (List Tag) Bit Type (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[self-name (extension.lift macro.current-module-name)
[type-module type-name] (case type
(#.Named type-name _)
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux b/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux
index bd42825d3..b46983293 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux
@@ -10,7 +10,7 @@
(do-template [<name> <type> <tag>]
[(def: #export (<name> value)
(-> <type> (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[_ (typeA.infer <type>)]
(wrap (#//.Primitive (<tag> value)))))]
@@ -24,6 +24,6 @@
(def: #export unit
(Operation Analysis)
- (do ///.Monad<Operation>
+ (do ///.monad
[_ (typeA.infer Any)]
(wrap (#//.Primitive #//.Unit))))
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux b/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux
index 30da3e60f..b7f41a81a 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux
@@ -5,7 +5,7 @@
["ex" exception (#+ exception:)]]
["." macro]
[data
- [text ("text/." Equivalence<Text>)
+ [text ("text/." equivalence)
format]]]
["." // (#+ Analysis Operation)
["." scope]
@@ -26,7 +26,7 @@
(def: (definition def-name)
(-> Name (Operation Analysis))
(with-expansions [<return> (wrap (|> def-name reference.constant #//.Reference))]
- (do ///.Monad<Operation>
+ (do ///.monad
[[actualT def-anns _] (extension.lift (macro.find-def def-name))]
(case (macro.get-identifier-ann (name-of #.alias) def-anns)
(#.Some real-def-name)
@@ -49,7 +49,7 @@
(def: (variable var-name)
(-> Text (Operation (Maybe Analysis)))
- (do ///.Monad<Operation>
+ (do ///.monad
[?var (scope.find var-name)]
(case ?var
(#.Some [actualT ref])
@@ -64,7 +64,7 @@
(-> Name (Operation Analysis))
(case reference
["" simple-name]
- (do ///.Monad<Operation>
+ (do ///.monad
[?var (variable simple-name)]
(case ?var
(#.Some varA)
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux b/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux
index 8cd55e198..c724edad2 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux
@@ -4,13 +4,13 @@
monad
["ex" exception (#+ exception:)]]
[data
- [text ("text/." Equivalence<Text>)
+ [text ("text/." equivalence)
format]
- ["." maybe ("maybe/." Monad<Maybe>)]
+ ["." maybe ("maybe/." monad)]
["." product]
["e" error]
[collection
- ["." list ("list/." Functor<List> Fold<List> Monoid<List>)]
+ ["." list ("list/." functor fold monoid)]
[dictionary
["." plist]]]]]
[// (#+ Operation Phase)
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux b/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux
index 43cb8e0d2..21b2b6e2b 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux
@@ -13,7 +13,7 @@
[text
format]
[collection
- ["." list ("list/." Functor<List>)]
+ ["." list ("list/." functor)]
["dict" dictionary (#+ Dictionary)]]]
["." type
["." check]]
@@ -82,7 +82,7 @@
(def: #export (sum analyse tag valueC)
(-> Phase Nat Code (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[expectedT (extension.lift macro.expected-type)]
(///.with-stack cannot-analyse-variant [expectedT tag valueC]
(case expectedT
@@ -160,7 +160,7 @@
(def: (typed-product analyse members)
(-> Phase (List Code) (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[expectedT (extension.lift macro.expected-type)
membersA+ (: (Operation (List Analysis))
(loop [membersT+ (type.flatten-tuple expectedT)
@@ -187,7 +187,7 @@
(def: #export (product analyse membersC)
(-> Phase (List Code) (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[expectedT (extension.lift macro.expected-type)]
(///.with-stack cannot-analyse-tuple [expectedT membersC]
(case expectedT
@@ -254,7 +254,7 @@
(def: #export (tagged-sum analyse tag valueC)
(-> Phase Name Code (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[tag (extension.lift (macro.normalize tag))
[idx group variantT] (extension.lift (macro.resolve-tag tag))
expectedT (extension.lift macro.expected-type)]
@@ -279,11 +279,11 @@
## canonical form (with their corresponding module identified).
(def: #export (normalize record)
(-> (List [Code Code]) (Operation (List [Name Code])))
- (monad.map ///.Monad<Operation>
+ (monad.map ///.monad
(function (_ [key val])
(case key
[_ (#.Tag key)]
- (do ///.Monad<Operation>
+ (do ///.monad
[key (extension.lift (macro.normalize key))]
(wrap [key val]))
@@ -299,10 +299,10 @@
(case record
## empty-record = empty-tuple = unit = []
#.Nil
- (:: ///.Monad<Operation> wrap [(list) Any])
+ (:: ///.monad wrap [(list) Any])
(#.Cons [head-k head-v] _)
- (do ///.Monad<Operation>
+ (do ///.monad
[head-k (extension.lift (macro.normalize head-k))
[_ tag-set recordT] (extension.lift (macro.resolve-tag head-k))
#let [size-record (list.size record)
@@ -311,7 +311,7 @@
(wrap [])
(///.throw record-size-mismatch [size-ts size-record recordT record]))
#let [tuple-range (list.indices size-ts)
- tag->idx (dict.from-list name.Hash<Name> (list.zip2 tag-set tuple-range))]
+ tag->idx (dict.from-list name.hash (list.zip2 tag-set tuple-range))]
idx->val (monad.fold @
(function (_ [key val] idx->val)
(do @
@@ -325,7 +325,7 @@
#.None
(///.throw tag-does-not-belong-to-record [key recordT]))))
(: (Dictionary Nat Code)
- (dict.new number.Hash<Nat>))
+ (dict.new number.hash))
record)
#let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val)))
tuple-range)]]
@@ -334,7 +334,7 @@
(def: #export (record analyse members)
(-> Phase (List [Code Code]) (Operation Analysis))
- (do ///.Monad<Operation>
+ (do ///.monad
[members (normalize members)
[membersC recordT] (order members)]
(case membersC
diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/type.lux b/stdlib/source/lux/platform/compiler/phase/analysis/type.lux
index c3219f5ac..75d691628 100644
--- a/stdlib/source/lux/platform/compiler/phase/analysis/type.lux
+++ b/stdlib/source/lux/platform/compiler/phase/analysis/type.lux
@@ -35,14 +35,14 @@
(def: #export (infer actualT)
(-> Type (Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[expectedT (extension.lift macro.expected-type)]
(with-env
(tc.check expectedT actualT))))
(def: #export (with-inference action)
(All [a] (-> (Operation a) (Operation [Type a])))
- (do ///.Monad<Operation>
+ (do ///.monad
[[_ varT] (..with-env
tc.var)
output (with-type varT
diff --git a/stdlib/source/lux/platform/compiler/phase/extension.lux b/stdlib/source/lux/platform/compiler/phase/extension.lux
index ec7323b1e..4e5721c5e 100644
--- a/stdlib/source/lux/platform/compiler/phase/extension.lux
+++ b/stdlib/source/lux/platform/compiler/phase/extension.lux
@@ -5,10 +5,10 @@
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
- ["." text ("text/." Order<Text>)
+ ["." text ("text/." order)
format]
[collection
- ["." list ("list/." Functor<List>)]
+ ["." list ("list/." functor)]
["." dictionary (#+ Dictionary)]]]
["." function]]
["." //])
diff --git a/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux
index 73f0d6c9d..426c8af9e 100644
--- a/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux
@@ -6,7 +6,7 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]
+ ["." list ("list/." functor)]
["." dictionary (#+ Dictionary)]]]
[type
["." check]]
@@ -30,7 +30,7 @@
(function (_ extension-name analyse args)
(let [num-actual (list.size args)]
(if (n/= num-expected num-actual)
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer outputT)
argsA (monad.map @
(function (_ [argT argC])
@@ -61,7 +61,7 @@
(def: lux::is
Handler
(function (_ extension-name analyse args)
- (do ////.Monad<Operation>
+ (do ////.monad
[[var-id varT] (typeA.with-env check.var)]
((binary varT varT Bit extension-name)
analyse args))))
@@ -73,7 +73,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list opC))
- (do ////.Monad<Operation>
+ (do ////.monad
[[var-id varT] (typeA.with-env check.var)
_ (typeA.infer (type (Either Text varT)))
opA (typeA.with-type (type (IO varT))
@@ -100,7 +100,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list typeC valueC))
- (do ////.Monad<Operation>
+ (do ////.monad
[count (///.lift macro.count)
actualT (:: @ map (|>> (:coerce Type))
(eval count Type typeC))
@@ -120,7 +120,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list valueC))
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer Type)
valueA (typeA.with-type Type
(analyse valueC))]
diff --git a/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux
index 2981dc89b..6b4b7ad36 100644
--- a/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux
@@ -9,10 +9,10 @@
["." error (#+ Error)]
["." maybe]
["." product]
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
format]
[collection
- ["." list ("list/." Fold<List> Functor<List> Monoid<List>)]
+ ["." list ("list/." fold functor monoid)]
["." array (#+ Array)]
["." dictionary (#+ Dictionary)]]]
["." type
@@ -24,7 +24,7 @@
["." common]
["/." //
["." bundle]
- ["//." // ("operation/." Monad<Operation>)
+ ["//." // ("operation/." monad)
["." analysis (#+ Analysis Operation Handler Bundle)
[".A" type]
[".A" inference]]]]]
@@ -216,14 +216,14 @@
["float" "java.lang.Float"]
["double" "java.lang.Double"]
["char" "java.lang.Character"])
- (dictionary.from-list text.Hash<Text>)))
+ (dictionary.from-list text.hash)))
(def: array::length
Handler
(function (_ extension-name analyse args)
(case args
(^ (list arrayC))
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer Nat)
[var-id varT] (typeA.with-env check.var)
arrayA (typeA.with-type (type (Array varT))
@@ -238,7 +238,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list lengthC))
- (do ////.Monad<Operation>
+ (do ////.monad
[lengthA (typeA.with-type Nat
(analyse lengthC))
expectedT (///.lift macro.expected-type)
@@ -303,7 +303,7 @@
(def: (check-object objectT)
(-> Type (Operation Text))
- (do ////.Monad<Operation>
+ (do ////.monad
[name (check-jvm objectT)]
(if (dictionary.contains? name boxes)
(////.throw primitives-are-not-objects name)
@@ -331,7 +331,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list arrayC idxC))
- (do ////.Monad<Operation>
+ (do ////.monad
[[var-id varT] (typeA.with-env check.var)
_ (typeA.infer varT)
arrayA (typeA.with-type (type (Array varT))
@@ -351,7 +351,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list arrayC idxC valueC))
- (do ////.Monad<Operation>
+ (do ////.monad
[[var-id varT] (typeA.with-env check.var)
_ (typeA.infer (type (Array varT)))
arrayA (typeA.with-type (type (Array varT))
@@ -383,7 +383,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list))
- (do ////.Monad<Operation>
+ (do ////.monad
[expectedT (///.lift macro.expected-type)
_ (check-object expectedT)]
(wrap (#analysis.Extension extension-name (list))))
@@ -396,7 +396,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list objectC))
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer Bit)
[objectT objectA] (typeA.with-inference
(analyse objectC))
@@ -411,7 +411,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list monitorC exprC))
- (do ////.Monad<Operation>
+ (do ////.monad
[[monitorT monitorA] (typeA.with-inference
(analyse monitorC))
_ (check-object monitorT)
@@ -482,7 +482,7 @@
(def: (load-class name)
(-> Text (Operation (Class Object)))
- (do ////.Monad<Operation>
+ (do ////.monad
[]
(case (Class::forName name)
(#error.Success [class])
@@ -493,7 +493,7 @@
(def: (sub-class? super sub)
(-> Text Text (Operation Bit))
- (do ////.Monad<Operation>
+ (do ////.monad
[super (load-class super)
sub (load-class sub)]
(wrap (Class::isAssignableFrom sub super))))
@@ -503,7 +503,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list exceptionC))
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer Nothing)
[exceptionT exceptionA] (typeA.with-inference
(analyse exceptionC))
@@ -525,7 +525,7 @@
(^ (list classC))
(case classC
[_ (#.Text class)]
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
_ (load-class class)]
(wrap (#analysis.Extension extension-name (list (analysis.text class)))))
@@ -543,7 +543,7 @@
(^ (list classC objectC))
(case classC
[_ (#.Text class)]
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer Bit)
[objectT objectA] (typeA.with-inference
(analyse objectC))
@@ -573,7 +573,7 @@
(type: Mappings
(Dictionary Text Type))
-(def: fresh-mappings Mappings (dictionary.new text.Hash<Text>))
+(def: fresh-mappings Mappings (dictionary.new text.hash))
(def: (java-type-to-lux-type mappings java-type)
(-> Mappings java/lang/reflect/Type (Operation Type))
@@ -614,7 +614,7 @@
(let [java-type (:coerce ParameterizedType java-type)
raw (ParameterizedType::getRawType java-type)]
(if (host.instance? Class raw)
- (do ////.Monad<Operation>
+ (do ////.monad
[paramsT (|> java-type
ParameterizedType::getActualTypeArguments
array.to-list
@@ -624,7 +624,7 @@
(////.throw jvm-type-is-not-a-class raw)))
(host.instance? GenericArrayType java-type)
- (do ////.Monad<Operation>
+ (do ////.monad
[innerT (|> (:coerce GenericArrayType java-type)
GenericArrayType::getGenericComponentType
(java-type-to-lux-type mappings))]
@@ -656,7 +656,7 @@
## else
(operation/wrap (|> params
(list.zip2 (list/map (|>> TypeVariable::getName) class-params))
- (dictionary.from-list text.Hash<Text>)))
+ (dictionary.from-list text.hash)))
))
_
@@ -667,7 +667,7 @@
(function (_ extension-name analyse args)
(case args
(^ (list valueC))
- (do ////.Monad<Operation>
+ (do ////.monad
[toT (///.lift macro.expected-type)
to-name (check-jvm toT)
[valueT valueA] (typeA.with-inference
@@ -756,7 +756,7 @@
(def: (find-field class-name field-name)
(-> Text Text (Operation [(Class Object) Field]))
- (do ////.Monad<Operation>
+ (do ////.monad
[class (load-class class-name)]
(case (Class::getDeclaredField field-name class)
(#error.Success field)
@@ -773,7 +773,7 @@
(def: (static-field class-name field-name)
(-> Text Text (Operation [Type Bit]))
- (do ////.Monad<Operation>
+ (do ////.monad
[[class fieldJ] (find-field class-name field-name)
#let [modifiers (Field::getModifiers fieldJ)]]
(if (Modifier::isStatic modifiers)
@@ -785,7 +785,7 @@
(def: (virtual-field class-name field-name objectT)
(-> Text Text Type (Operation [Type Bit]))
- (do ////.Monad<Operation>
+ (do ////.monad
[[class fieldJ] (find-field class-name field-name)
#let [modifiers (Field::getModifiers fieldJ)]]
(if (not (Modifier::isStatic modifiers))
@@ -808,7 +808,7 @@
" Type: " (%type objectT))
(n/= num-params num-vars))]
(wrap (|> (list.zip2 var-names _class-params)
- (dictionary.from-list text.Hash<Text>))))
+ (dictionary.from-list text.hash))))
_
(////.throw non-object objectT)))
@@ -823,7 +823,7 @@
(^ (list classC fieldC))
(case [classC fieldC]
[[_ (#.Text class)] [_ (#.Text field)]]
- (do ////.Monad<Operation>
+ (do ////.monad
[[fieldT final?] (static-field class field)]
(wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field)))))
@@ -840,7 +840,7 @@
(^ (list classC fieldC valueC))
(case [classC fieldC]
[[_ (#.Text class)] [_ (#.Text field)]]
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (typeA.infer Any)
[fieldT final?] (static-field class field)
_ (////.assert cannot-set-a-final-field (format class "#" field)
@@ -862,7 +862,7 @@
(^ (list classC fieldC objectC))
(case [classC fieldC]
[[_ (#.Text class)] [_ (#.Text field)]]
- (do ////.Monad<Operation>
+ (do ////.monad
[[objectT objectA] (typeA.with-inference
(analyse objectC))
[fieldT final?] (virtual-field class field objectT)]
@@ -881,7 +881,7 @@
(^ (list classC fieldC valueC objectC))
(case [classC fieldC]
[[_ (#.Text class)] [_ (#.Text field)]]
- (do ////.Monad<Operation>
+ (do ////.monad
[[objectT objectA] (typeA.with-inference
(analyse objectC))
_ (typeA.infer objectT)
@@ -911,7 +911,7 @@
(operation/wrap "java.lang.Object")
(host.instance? GenericArrayType type)
- (do ////.Monad<Operation>
+ (do ////.monad
[componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))]
(wrap (format componentP "[]")))
@@ -927,7 +927,7 @@
(def: (check-method class method-name method-style arg-classes method)
(-> (Class Object) Text Method-Style (List Text) Method (Operation Bit))
- (do ////.Monad<Operation>
+ (do ////.monad
[parameters (|> (Method::getGenericParameterTypes method)
array.to-list
(monad.map @ java-type-to-parameter))
@@ -956,7 +956,7 @@
(def: (check-constructor class arg-classes constructor)
(-> (Class Object) (List Text) (Constructor Object) (Operation Bit))
- (do ////.Monad<Operation>
+ (do ////.monad
[parameters (|> (Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map @ java-type-to-parameter))]
@@ -1006,8 +1006,8 @@
(|> (list/compose owner-tvarsT method-tvarsT)
list.reverse
(list.zip2 all-tvars)
- (dictionary.from-list text.Hash<Text>))))]
- (do ////.Monad<Operation>
+ (dictionary.from-list text.hash))))]
+ (do ////.monad
[inputsT (|> (Method::getGenericParameterTypes method)
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))
@@ -1046,7 +1046,7 @@
(def: (method-candidate class-name method-name method-style arg-classes)
(-> Text Text Method-Style (List Text) (Operation Method-Signature))
- (do ////.Monad<Operation>
+ (do ////.monad
[class (load-class class-name)
candidates (|> class
Class::getDeclaredMethods
@@ -1094,8 +1094,8 @@
(|> (list/compose owner-tvarsT constructor-tvarsT)
list.reverse
(list.zip2 all-tvars)
- (dictionary.from-list text.Hash<Text>))))]
- (do ////.Monad<Operation>
+ (dictionary.from-list text.hash))))]
+ (do ////.monad
[inputsT (|> (Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map @ (java-type-to-lux-type mappings)))
@@ -1112,7 +1112,7 @@
(def: (constructor-candidate class-name arg-classes)
(-> Text (List Text) (Operation Method-Signature))
- (do ////.Monad<Operation>
+ (do ////.monad
[class (load-class class-name)
candidates (|> class
Class::getConstructors
@@ -1146,7 +1146,7 @@
(case (: (Error [Text Text (List [Text Code])])
(s.run args ($_ p.and s.text s.text (p.some (s.tuple (p.and s.text s.any))))))
(#error.Success [class method argsTC])
- (do ////.Monad<Operation>
+ (do ////.monad
[#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (method-candidate class method #Static argsT)
[outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))
@@ -1163,7 +1163,7 @@
(case (: (Error [Text Text Code (List [Text Code])])
(s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))))))
(#error.Success [class method objectC argsTC])
- (do ////.Monad<Operation>
+ (do ////.monad
[#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (method-candidate class method #Virtual argsT)
[outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
@@ -1186,7 +1186,7 @@
(case (: (Error [(List Code) [Text Text Code (List [Text Code]) Any]])
(p.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))) s.end!)))
(#error.Success [_ [class method objectC argsTC _]])
- (do ////.Monad<Operation>
+ (do ////.monad
[#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (method-candidate class method #Special argsT)
[outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
@@ -1203,7 +1203,7 @@
(case (: (Error [Text Text Code (List [Text Code])])
(s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))))))
(#error.Success [class-name method objectC argsTC])
- (do ////.Monad<Operation>
+ (do ////.monad
[#let [argsT (list/map product.left argsTC)]
class (load-class class-name)
_ (////.assert non-interface class-name
@@ -1224,7 +1224,7 @@
(case (: (Error [Text (List [Text Code])])
(s.run args ($_ p.and s.text (p.some (s.tuple (p.and s.text s.any))))))
(#error.Success [class argsTC])
- (do ////.Monad<Operation>
+ (do ////.monad
[#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (constructor-candidate class argsT)
[outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))]
diff --git a/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux b/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux
index 582526694..41879fa0c 100644
--- a/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux
+++ b/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux
@@ -6,13 +6,13 @@
["." text
format]
[collection
- [list ("list/." Functor<List>)]
+ [list ("list/." functor)]
["." dictionary (#+ Dictionary)]]]]
[// (#+ Handler Bundle)])
(def: #export empty
Bundle
- (dictionary.new text.Hash<Text>))
+ (dictionary.new text.hash))
(def: #export (install name anonymous)
(All [s i o]
@@ -25,4 +25,4 @@
(-> Text (-> (Bundle s i o) (Bundle s i o))))
(|>> dictionary.entries
(list/map (function (_ [key val]) [(format prefix " " key) val]))
- (dictionary.from-list text.Hash<Text>)))
+ (dictionary.from-list text.hash)))
diff --git a/stdlib/source/lux/platform/compiler/phase/extension/statement.lux b/stdlib/source/lux/platform/compiler/phase/extension/statement.lux
index e5963e96c..02edd7565 100644
--- a/stdlib/source/lux/platform/compiler/phase/extension/statement.lux
+++ b/stdlib/source/lux/platform/compiler/phase/extension/statement.lux
@@ -7,7 +7,7 @@
[text
format]
[collection
- [list ("list/." Functor<List>)]
+ [list ("list/." functor)]
["." dictionary]]]
["." macro]
[type (#+ :share)
@@ -25,7 +25,7 @@
(def: (evaluate! type codeC)
(All [anchor expression statement]
(-> Type Code (Operation anchor expression statement [Type expression Any])))
- (do ///.Monad<Operation>
+ (do ///.monad
[state (//.lift ///.get-state)
#let [analyse (get@ [#statement.analysis #statement.phase] state)
synthesize (get@ [#statement.synthesis #statement.phase] state)
@@ -51,7 +51,7 @@
(All [anchor expression statement]
(-> Name (Maybe Type) Code
(Operation anchor expression statement [Type expression Text Any])))
- (do ///.Monad<Operation>
+ (do ///.monad
[state (//.lift ///.get-state)
#let [analyse (get@ [#statement.analysis #statement.phase] state)
synthesize (get@ [#statement.synthesis #statement.phase] state)
@@ -86,7 +86,7 @@
(function (_ extension-name phase inputsC+)
(case inputsC+
(^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC))
- (do ///.Monad<Operation>
+ (do ///.monad
[current-module (statement.lift-analysis
(//.lift macro.current-module-name))
#let [full-name [current-module short-name]]
@@ -117,7 +117,7 @@
(def: (alias! alias def-name)
(-> Text Name (analysis.Operation Any))
- (do ///.Monad<Operation>
+ (do ///.monad
[definition (//.lift (macro.find-def def-name))]
(module.define alias definition)))
@@ -126,7 +126,7 @@
(function (_ extension-name phase inputsC+)
(case inputsC+
(^ (list annotationsC))
- (do ///.Monad<Operation>
+ (do ///.monad
[[_ annotationsT annotationsV] (evaluate! Code annotationsC)
_ (statement.lift-analysis
(module.set-annotations (:coerce Code annotationsV)))]
@@ -155,7 +155,7 @@
(function (handler extension-name phase inputsC+)
(case inputsC+
(^ (list [_ (#.Text name)] valueC))
- (do ///.Monad<Operation>
+ (do ///.monad
[[_ handlerT handlerV] (evaluate! (:of (:share [anchor expression statement]
{(Handler anchor expression statement)
handler}
diff --git a/stdlib/source/lux/platform/compiler/phase/statement/total.lux b/stdlib/source/lux/platform/compiler/phase/statement/total.lux
index 15f116aa1..c494b01c6 100644
--- a/stdlib/source/lux/platform/compiler/phase/statement/total.lux
+++ b/stdlib/source/lux/platform/compiler/phase/statement/total.lux
@@ -31,7 +31,7 @@
(extension.apply "Statement" phase [name inputs])
(^ [_ (#.Form (list& macro inputs))])
- (do ///.Monad<Operation>
+ (do ///.monad
[expansion (//.lift-analysis
(do @
[macroA (type.with-type Macro
diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis.lux b/stdlib/source/lux/platform/compiler/phase/synthesis.lux
index cf29ad74b..f1239fdfe 100644
--- a/stdlib/source/lux/platform/compiler/phase/synthesis.lux
+++ b/stdlib/source/lux/platform/compiler/phase/synthesis.lux
@@ -5,11 +5,11 @@
[equivalence (#+ Equivalence)]
["ex" exception (#+ exception:)]]
[data
- [bit ("bit/." Equivalence<Bit>)]
- ["." text ("text/." Equivalence<Text>)
+ [bit ("bit/." equivalence)]
+ ["." text ("text/." equivalence)
format]
[collection
- [list ("list/." Functor<List>)]
+ [list ("list/." functor)]
["." dictionary (#+ Dictionary)]]]]
["." //
["." analysis (#+ Environment Arity Composite Analysis)]
@@ -24,7 +24,7 @@
(def: #export fresh-resolver
Resolver
- (dictionary.new reference.Hash<Variable>))
+ (dictionary.new reference.hash))
(def: #export init
State
@@ -192,7 +192,7 @@
(def: #export with-new-local
(All [a] (-> (Operation a) (Operation a)))
- (<<| (do //.Monad<Operation>
+ (<<| (do //.monad
[locals ..locals])
(..with-locals (inc locals))))
@@ -388,7 +388,7 @@
(Format Path)
(%path' %synthesis))
-(structure: #export _ (Equivalence Primitive)
+(structure: #export primitive-equivalence (Equivalence Primitive)
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <eq> <format>]
@@ -404,7 +404,7 @@
_
false)))
-(structure: #export _ (Equivalence Access)
+(structure: #export access-equivalence (Equivalence Access)
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
@@ -424,7 +424,7 @@
_
false)))
-(structure: #export (Equivalence<Path'> Equivalence<a>)
+(structure: #export (path'-equivalence Equivalence<a>)
(All [a] (-> (Equivalence a) (Equivalence (Path' a))))
(def: (= reference sample)
@@ -435,8 +435,8 @@
(^template [<tag> <equivalence>]
[(<tag> reference') (<tag> sample')]
(:: <equivalence> = reference' sample'))
- ([#Test Equivalence<Primitive>]
- [#Access Equivalence<Access>]
+ ([#Test primitive-equivalence]
+ [#Access access-equivalence]
[#Then Equivalence<a>])
[(#Bind reference') (#Bind sample')]
@@ -452,17 +452,17 @@
_
false)))
-(structure: #export _ (Equivalence Synthesis)
+(structure: #export equivalence (Equivalence Synthesis)
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <equivalence>]
[(<tag> reference') (<tag> sample')]
(:: <equivalence> = reference' sample'))
- ([#Primitive Equivalence<Primitive>])
+ ([#Primitive primitive-equivalence])
_
false)))
-(def: #export Equivalence<Path>
+(def: #export path-equivalence
(Equivalence Path)
- (Equivalence<Path'> Equivalence<Synthesis>))
+ (path'-equivalence equivalence))
diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux
index e9e941a30..95adf33f3 100644
--- a/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux
+++ b/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux
@@ -6,15 +6,15 @@
["." monad (#+ do)]]
[data
["." product]
- [bit ("bit/." Equivalence<Bit>)]
- [text ("text/." Equivalence<Text>)
+ [bit ("bit/." equivalence)]
+ [text ("text/." equivalence)
format]
- [number ("frac/." Equivalence<Frac>)]
+ [number ("frac/." equivalence)]
[collection
- ["." list ("list/." Fold<List> Monoid<List>)]]]]
+ ["." list ("list/." fold monoid)]]]]
["." // (#+ Path Synthesis Operation Phase)
["." function]
- ["/." // ("operation/." Monad<Operation>)
+ ["/." // ("operation/." monad)
["." analysis (#+ Pattern Match Analysis)]
[//
["." reference]]]])
@@ -43,7 +43,7 @@
[#analysis.Text #//.Text]))
(#analysis.Bind register)
- (<| (:: ///.Monad<Operation> map (|>> (#//.Seq (#//.Bind register))))
+ (<| (:: ///.monad map (|>> (#//.Seq (#//.Bind register))))
//.with-new-local
thenC)
@@ -121,7 +121,7 @@
(def: #export (synthesize synthesize^ inputA [headB tailB+])
(-> Phase Analysis Match (Operation Synthesis))
- (do ///.Monad<Operation>
+ (do ///.monad
[inputS (synthesize^ inputA)]
(with-expansions [<unnecesary-let>
(as-is (^multi (^ (#analysis.Reference (reference.local outputR)))
diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux
index 672bc9e87..7b836b29a 100644
--- a/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux
+++ b/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux
@@ -7,12 +7,12 @@
["." maybe]
["." error]
[collection
- ["." list ("list/." Functor<List>)]
+ ["." list ("list/." functor)]
["." dictionary (#+ Dictionary)]]]]
["." // (#+ Synthesis Phase)
["." function]
["." case]
- ["/." // ("operation/." Monad<Operation>)
+ ["/." // ("operation/." monad)
["." analysis (#+ Analysis)]
["." extension]
[//
@@ -47,14 +47,14 @@
(#analysis.Structure structure)
(case structure
(#analysis.Variant variant)
- (do ///.Monad<Operation>
+ (do ///.monad
[valueS (phase (get@ #analysis.value variant))]
(wrap (//.variant (set@ #analysis.value valueS variant))))
(#analysis.Tuple tuple)
(|> tuple
- (monad.map ///.Monad<Operation> phase)
- (:: ///.Monad<Operation> map (|>> //.tuple))))
+ (monad.map ///.monad phase)
+ (:: ///.monad map (|>> //.tuple))))
(#analysis.Reference reference)
(operation/wrap (#//.Reference reference))
@@ -80,7 +80,7 @@
(#error.Failure error)
(<| (///.run' state)
- (do ///.Monad<Operation>
+ (do ///.monad
[argsS+ (monad.map @ phase args)]
(wrap (#//.Extension [name argsS+])))))))
))
diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux
index 267d941fc..ccc7835a4 100644
--- a/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux
+++ b/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux
@@ -8,11 +8,11 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List> Monoid<List> Fold<List>)]
+ ["." list ("list/." functor monoid fold)]
["dict" dictionary (#+ Dictionary)]]]]
["." // (#+ Path Synthesis Operation Phase)
["." loop (#+ Transform)]
- ["/." // ("operation/." Monad<Operation>)
+ ["/." // ("operation/." monad)
["." analysis (#+ Environment Arity Analysis)]
[//
["." reference (#+ Register Variable)]]]])
@@ -40,7 +40,7 @@
(-> Phase Phase)
(function (_ exprA)
(let [[funcA argsA] (analysis.application exprA)]
- (do ///.Monad<Operation>
+ (do ///.monad
[funcS (phase funcA)
argsS (monad.map @ phase argsA)
## locals //.locals
@@ -75,7 +75,7 @@
(^template [<tag>]
(<tag> left right)
- (do ///.Monad<Operation>
+ (do ///.monad
[left' (grow-path grow left)
right' (grow-path grow right)]
(wrap (<tag> left' right'))))
@@ -91,7 +91,7 @@
(def: (grow-sub-environment super sub)
(-> Environment Environment (Operation Environment))
- (monad.map ///.Monad<Operation>
+ (monad.map ///.monad
(function (_ variable)
(case variable
(#reference.Local register)
@@ -113,7 +113,7 @@
(#analysis.Tuple membersS+)
(|> membersS+
- (monad.map ///.Monad<Operation> (grow environment))
+ (monad.map ///.monad (grow environment))
(operation/map (|>> //.tuple))))
(^ (..self-reference))
@@ -139,20 +139,20 @@
(#//.Branch branch)
(case branch
(#//.Let [inputS register bodyS])
- (do ///.Monad<Operation>
+ (do ///.monad
[inputS' (grow environment inputS)
bodyS' (grow environment bodyS)]
(wrap (//.branch/let [inputS' (inc register) bodyS'])))
(#//.If [testS thenS elseS])
- (do ///.Monad<Operation>
+ (do ///.monad
[testS' (grow environment testS)
thenS' (grow environment thenS)
elseS' (grow environment elseS)]
(wrap (//.branch/if [testS' thenS' elseS'])))
(#//.Case [inputS pathS])
- (do ///.Monad<Operation>
+ (do ///.monad
[inputS' (grow environment inputS)
pathS' (grow-path (grow environment) pathS)]
(wrap (//.branch/case [inputS' pathS']))))
@@ -160,20 +160,20 @@
(#//.Loop loop)
(case loop
(#//.Scope [start initsS+ iterationS])
- (do ///.Monad<Operation>
+ (do ///.monad
[initsS+' (monad.map @ (grow environment) initsS+)
iterationS' (grow environment iterationS)]
(wrap (//.loop/scope [start initsS+' iterationS'])))
(#//.Recur argumentsS+)
(|> argumentsS+
- (monad.map ///.Monad<Operation> (grow environment))
+ (monad.map ///.monad (grow environment))
(operation/map (|>> //.loop/recur))))
(#//.Function function)
(case function
(#//.Abstraction [_env _arity _body])
- (do ///.Monad<Operation>
+ (do ///.monad
[_env' (grow-sub-environment environment _env)]
(wrap (//.function/abstraction [_env' _arity _body])))
@@ -184,14 +184,14 @@
(list/compose pre-argsS+ argsS+)]))
_
- (do ///.Monad<Operation>
+ (do ///.monad
[funcS' (grow environment funcS)
argsS+' (monad.map @ (grow environment) argsS+)]
(wrap (//.function/apply [funcS' argsS+']))))))
(#//.Extension name argumentsS+)
(|> argumentsS+
- (monad.map ///.Monad<Operation> (grow environment))
+ (monad.map ///.monad (grow environment))
(operation/map (|>> (#//.Extension name))))
_
@@ -199,7 +199,7 @@
(def: #export (abstraction phase environment bodyA)
(-> Phase Environment Analysis (Operation Synthesis))
- (do ///.Monad<Operation>
+ (do ///.monad
[bodyS (phase bodyA)]
(case bodyS
(^ (//.function/abstraction [env' down-arity' bodyS']))
diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux
index cd57c1d29..924a9b413 100644
--- a/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux
+++ b/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux
@@ -4,9 +4,9 @@
["." monad (#+ do)]
["p" parser]]
[data
- ["." maybe ("maybe/." Monad<Maybe>)]
+ ["." maybe ("maybe/." monad)]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
[macro
["." code]
["." syntax]]]
@@ -179,7 +179,7 @@
(^template [<tag>]
(<tag> leftS rightS)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[leftS' (recur leftS)
rightS' (recur rightS)]
(wrap (<tag> leftS' rightS'))))
@@ -198,7 +198,7 @@
(#//.Structure structureS)
(case structureS
(#analysis.Variant variantS)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[valueS' (|> variantS (get@ #analysis.value) recur)]
(wrap (|> variantS
(set@ #analysis.value valueS')
@@ -207,7 +207,7 @@
(#analysis.Tuple membersS+)
(|> membersS+
- (monad.map maybe.Monad<Maybe> recur)
+ (monad.map maybe.monad recur)
(maybe/map (|>> #analysis.Tuple #//.Structure))))
(#//.Reference reference)
@@ -224,29 +224,29 @@
(maybe/map (|>> #reference.Variable #//.Reference))))
(^ (//.branch/case [inputS pathS]))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[inputS' (recur inputS)
pathS' (adjust-path recur offset pathS)]
(wrap (|> pathS' [inputS'] //.branch/case)))
(^ (//.branch/let [inputS register bodyS]))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[inputS' (recur inputS)
bodyS' (recur bodyS)]
(wrap (//.branch/let [inputS' register bodyS'])))
(^ (//.branch/if [inputS thenS elseS]))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[inputS' (recur inputS)
thenS' (recur thenS)
elseS' (recur elseS)]
(wrap (//.branch/if [inputS' thenS' elseS'])))
(^ (//.loop/scope scopeS))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[inits' (|> scopeS
(get@ #//.inits)
- (monad.map maybe.Monad<Maybe> recur))
+ (monad.map maybe.monad recur))
iteration' (recur (get@ #//.iteration scopeS))]
(wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset))
#//.inits inits'
@@ -254,26 +254,26 @@
(^ (//.loop/recur argsS))
(|> argsS
- (monad.map maybe.Monad<Maybe> recur)
+ (monad.map maybe.monad recur)
(maybe/map (|>> //.loop/recur)))
(^ (//.function/abstraction [environment arity bodyS]))
- (do maybe.Monad<Maybe>
- [environment' (monad.map maybe.Monad<Maybe>
+ (do maybe.monad
+ [environment' (monad.map maybe.monad
(resolve scope-environment)
environment)]
(wrap (//.function/abstraction [environment' arity bodyS])))
(^ (//.function/apply [function arguments]))
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[function' (recur function)
- arguments' (monad.map maybe.Monad<Maybe> recur arguments)]
+ arguments' (monad.map maybe.monad recur arguments)]
(wrap (//.function/apply [function' arguments'])))
(#//.Extension [name argsS])
(|> argsS
- (monad.map maybe.Monad<Maybe> recur)
+ (monad.map maybe.monad recur)
(maybe/map (|>> [name] #//.Extension)))
_
diff --git a/stdlib/source/lux/platform/compiler/phase/translation.lux b/stdlib/source/lux/platform/compiler/phase/translation.lux
index c7fb60c08..79c343d5a 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation.lux
@@ -6,7 +6,7 @@
[data
["." product]
["." error (#+ Error)]
- ["." name ("name/." Equivalence<Name>)]
+ ["." name ("name/." equivalence)]
["." text
format]
[collection
@@ -92,9 +92,9 @@
#anchor #.None
#host host
#buffer #.None
- #outputs (dictionary.new text.Hash<Text>)
+ #outputs (dictionary.new text.hash)
#counter 0
- #name-cache (dictionary.new name.Hash<Name>)})
+ #name-cache (dictionary.new name.hash)})
(def: #export (with-context expr)
(All [anchor expression statement output]
@@ -166,7 +166,7 @@
(def: #export next
(All [anchor expression statement]
(Operation anchor expression statement Nat))
- (do //.Monad<Operation>
+ (do //.monad
[count (extension.read (get@ #counter))
_ (extension.update (update@ #counter inc))]
(wrap count)))
@@ -201,7 +201,7 @@
(def: #export (save! name code)
(All [anchor expression statement]
(-> Name statement (Operation anchor expression statement Any)))
- (do //.Monad<Operation>
+ (do //.monad
[count ..next
_ (execute! (format "save" (%n count)) code)
?buffer (extension.read (get@ #buffer))]
@@ -217,7 +217,7 @@
(def: #export (save-buffer! target)
(All [anchor expression statement]
(-> File (Operation anchor expression statement Any)))
- (do //.Monad<Operation>
+ (do //.monad
[buffer ..buffer]
(extension.update (update@ #outputs (dictionary.put target buffer)))))
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux
index 4a963d507..b50e4485a 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux
@@ -8,12 +8,12 @@
["." text
format]
[collection
- [list ("list/." Functor<List> Fold<List>)]
+ [list ("list/." functor fold)]
[set (#+ Set)]]]]
[//
["." runtime (#+ Operation Phase)]
["." reference]
- ["/." /// ("operation/." Monad<Operation>)
+ ["/." /// ("operation/." monad)
["." synthesis (#+ Synthesis Path)]
[//
[reference (#+ Register)]
@@ -24,7 +24,7 @@
(def: #export (let translate [valueS register bodyS])
(-> Phase [Synthesis Register Synthesis]
(Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[valueO (translate valueS)
bodyO (translate bodyS)]
(wrap (_.let (list [(reference.local' register) valueO])
@@ -33,7 +33,7 @@
(def: #export (record-get translate valueS pathP)
(-> Phase Synthesis (List [Nat Bit])
(Operation Expression))
- (do ////.Monad<Operation>
+ (do ////.monad
[valueO (translate valueS)]
(wrap (list/fold (function (_ [idx tail?] source)
(.let [method (.if tail?
@@ -46,7 +46,7 @@
(def: #export (if translate [testS thenS elseS])
(-> Phase [Synthesis Synthesis Synthesis]
(Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[testO (translate testS)
thenO (translate thenS)
elseO (translate elseS)]
@@ -143,7 +143,7 @@
(^template [<tag> <computation>]
(^ (<tag> leftP rightP))
- (do ////.Monad<Operation>
+ (do ////.monad
[leftO (pattern-matching' translate leftP)
rightO (pattern-matching' translate rightP)]
(wrap <computation>)))
@@ -161,7 +161,7 @@
(def: (pattern-matching translate pathP)
(-> Phase Path (Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[pattern-matching! (pattern-matching' translate pathP)]
(wrap (_.with-exception-handler
(pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching.")))
@@ -170,7 +170,7 @@
(def: #export (case translate [valueS pathP])
(-> Phase [Synthesis Path] (Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[valueO (translate valueS)]
(<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))]
[@savepoint (_.list/* (list))])))
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux
index a503949dd..46f0c8102 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux
@@ -10,7 +10,7 @@
format]
[number (#+ hex)]
[collection
- ["." list ("list/." Functor<List>)]
+ ["." list ("list/." functor)]
["dict" dictionary (#+ Dictionary)]]]
["." macro (#+ with-gensyms)
["." code]
@@ -26,7 +26,6 @@
[host
["_" scheme (#+ Expression Computation)]]]]])
-## [Types]
(syntax: (Vector {size s.nat} elemT)
(wrap (list (` [(~+ (list.repeat size elemT))]))))
@@ -36,7 +35,6 @@
(type: #export Trinary (-> (Vector 3 Expression) Computation))
(type: #export Variadic (-> (List Expression) Computation))
-## [Utils]
(syntax: (arity: {name s.local-identifier} {arity s.nat})
(with-gensyms [g!_ g!extension g!name g!phase g!inputs]
(do @
@@ -47,7 +45,7 @@
(function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs))
(case (~ g!inputs)
(^ (list (~+ g!input+)))
- (do /////.Monad<Operation>
+ (do /////.monad
[(~+ (|> g!input+
(list/map (function (_ g!input)
(list g!input (` ((~ g!phase) (~ g!input))))))
@@ -66,19 +64,16 @@
(-> Variadic Handler)
(function (_ extension-name)
(function (_ phase inputsS)
- (do /////.Monad<Operation>
+ (do /////.monad
[inputsI (monad.map @ phase inputsS)]
(wrap (extension inputsI))))))
-## [Bundle]
-## [[Lux]]
(def: bundle::lux
Bundle
(|> bundle.empty
(bundle.install "is?" (binary (product.uncurry _.eq?/2)))
(bundle.install "try" (unary runtime.lux//try))))
-## [[Bits]]
(do-template [<name> <op>]
[(def: (<name> [subjectO paramO])
Binary
@@ -115,7 +110,6 @@
(bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
)))
-## [[Numbers]]
(import: java/lang/Double
(#static MIN_VALUE Double)
(#static MAX_VALUE Double))
@@ -202,7 +196,6 @@
(bundle.install "encode" (unary _.number->string/1))
(bundle.install "decode" (unary runtime.frac//decode)))))
-## [[Text]]
(def: (text::char [subjectO paramO])
Binary
(_.string/1 (_.string-ref/2 subjectO paramO)))
@@ -222,7 +215,6 @@
(bundle.install "char" (binary text::char))
(bundle.install "clip" (trinary text::clip)))))
-## [[IO]]
(def: (io::log input)
Unary
(_.begin (list (_.display/1 input)
@@ -241,7 +233,6 @@
(bundle.install "exit" (unary _.exit/1))
(bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit))))))))
-## [Bundles]
(def: #export bundle
Bundle
(<| (bundle.prefix "lux")
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux
index 7eeb5a8ed..8d19558dd 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux
@@ -8,12 +8,12 @@
[text
format]
[collection
- ["." list ("list/." Functor<List>)]]]]
+ ["." list ("list/." functor)]]]]
[//
["." runtime (#+ Operation Phase)]
["." reference]
["/." //
- ["//." // ("operation/." Monad<Operation>)
+ ["//." // ("operation/." monad)
[analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
[synthesis (#+ Synthesis)]
[//
@@ -25,7 +25,7 @@
(def: #export (apply translate [functionS argsS+])
(-> Phase (Application Synthesis) (Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[functionO (translate functionS)
argsO+ (monad.map @ translate argsS+)]
(wrap (_.apply/* functionO argsO+))))
@@ -54,7 +54,7 @@
(def: #export (function translate [environment arity bodyS])
(-> Phase (Abstraction Synthesis) (Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[[function-name bodyO] (///.with-context
(do @
[function-name ///.context]
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux
index 91757d291..e25b96254 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux
@@ -7,7 +7,7 @@
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]]]]
+ ["." list ("list/." functor)]]]]
[//
[runtime (#+ Operation Phase)]
["." reference]
@@ -22,7 +22,7 @@
(def: #export (scope translate [start initsS+ bodyS])
(-> Phase (Scope Synthesis) (Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[initsO+ (monad.map @ translate initsS+)
bodyO (///.with-anchor @scope
(translate bodyS))]
@@ -35,7 +35,7 @@
(def: #export (recur translate argsS+)
(-> Phase (List Synthesis) (Operation Computation))
- (do ////.Monad<Operation>
+ (do ////.monad
[@scope ///.anchor
argsO+ (monad.map @ translate argsS+)]
(wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux
index c16c696c4..caa71f74f 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux
@@ -3,7 +3,7 @@
[//
[runtime (#+ Operation)]
[// (#+ State)
- [// ("operation/." Monad<Operation>)
+ [// ("operation/." monad)
[///
[host
["_" scheme (#+ Expression)]]]]]])
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux
index 6d4088189..88e091e83 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux
@@ -8,7 +8,7 @@
[//
[runtime (#+ Operation)]
["/." //
- [// ("operation/." Monad<Operation>)
+ [// ("operation/." monad)
[analysis (#+ Variant Tuple)]
[synthesis (#+ Synthesis)]
[//
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux
index 43748c3b1..97e53d143 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux
@@ -1,14 +1,14 @@
(.module:
[lux #*
[control
- ["p" parser ("parser/." Monad<Parser>)]
+ ["p" parser ("parser/." monad)]
[monad (#+ do)]]
[data
[number (#+ hex)]
[text
format]
[collection
- ["." list ("list/." Monad<List>)]]]
+ ["." list ("list/." monad)]]]
["." function]
[macro
["." code]
@@ -138,16 +138,16 @@
(with-vars [error]
(_.with-exception-handler
(_.lambda [(list error) #.None]
- (..left error))
+ (..left error))
(_.lambda [(list) #.None]
- (..right (_.apply/* op (list ..unit)))))))
+ (..right (_.apply/* op (list ..unit)))))))
(runtime: (lux//program-args program-args)
(with-vars [@loop @input @output]
(_.letrec (list [@loop (_.lambda [(list @input @output) #.None]
- (_.if (_.eqv?/2 _.nil @input)
- @output
- (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))])
+ (_.if (_.eqv?/2 _.nil @input)
+ @output
+ (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))])
(_.apply/2 @loop (_.reverse/1 program-args) ..none))))
(def: runtime//lux
@@ -317,6 +317,6 @@
(def: #export translate
(Operation Any)
(///.with-buffer
- (do ////.Monad<Operation>
+ (do ////.monad
[_ (///.save! ["" ..prefix] ..runtime)]
(///.save-buffer! ""))))
diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux
index 3991ea281..dc1b88591 100644
--- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux
+++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux
@@ -22,12 +22,12 @@
(translate singletonS)
_
- (do ///.Monad<Operation>
+ (do ///.monad
[elemsT+ (monad.map @ translate elemsS+)]
(wrap (_.vector/* elemsT+)))))
(def: #export (variant translate [lefts right? valueS])
(-> Phase (Variant Synthesis) (Operation Expression))
- (do ///.Monad<Operation>
+ (do ///.monad
[valueT (translate valueS)]
(wrap (runtime.variant [lefts right? valueT]))))
diff --git a/stdlib/source/lux/platform/compiler/reference.lux b/stdlib/source/lux/platform/compiler/reference.lux
index b945c1327..a20691986 100644
--- a/stdlib/source/lux/platform/compiler/reference.lux
+++ b/stdlib/source/lux/platform/compiler/reference.lux
@@ -18,7 +18,7 @@
(#Variable Variable)
(#Constant Name))
-(structure: #export _ (Equivalence Variable)
+(structure: #export equivalence (Equivalence Variable)
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
@@ -29,8 +29,8 @@
_
#0)))
-(structure: #export _ (Hash Variable)
- (def: eq Equivalence<Variable>)
+(structure: #export hash (Hash Variable)
+ (def: &equivalence ..equivalence)
(def: (hash var)
(case var
(#Local register)
diff --git a/stdlib/source/lux/platform/interpreter.lux b/stdlib/source/lux/platform/interpreter.lux
index a75cbc01e..87206750d 100644
--- a/stdlib/source/lux/platform/interpreter.lux
+++ b/stdlib/source/lux/platform/interpreter.lux
@@ -5,7 +5,7 @@
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
format]]
[type (#+ :share)
["." check]]
@@ -56,7 +56,7 @@
(All [anchor expression statement]
(Operation anchor expression statement Any))
(statement.lift-analysis
- (do phase.Monad<Operation>
+ (do phase.monad
[_ (module.create 0 ..module)]
(analysis.set-current-module ..module))))
@@ -87,7 +87,7 @@
(def: (interpret-statement code)
(All [anchor expression statement]
(-> Code <Interpretation>))
- (do phase.Monad<Operation>
+ (do phase.monad
[_ (total.phase code)
_ init.refresh]
(wrap [Any []])))
@@ -95,7 +95,7 @@
(def: (interpret-expression code)
(All [anchor expression statement]
(-> Code <Interpretation>))
- (do phase.Monad<Operation>
+ (do phase.monad
[state (extension.lift phase.get-state)
#let [analyse (get@ [#statement.analysis #statement.phase] state)
synthesize (get@ [#statement.synthesis #statement.phase] state)
@@ -146,7 +146,7 @@
(def: (execute configuration code)
(All [anchor expression statement]
(-> Configuration Code (Operation anchor expression statement Text)))
- (do phase.Monad<Operation>
+ (do phase.monad
[[codeT codeV] (interpret configuration code)
state phase.get-state]
(wrap (/type.represent (get@ [#extension.state
@@ -165,7 +165,7 @@
(def: (read-eval-print context)
(All [anchor expression statement]
(-> <Context> (Error [<Context> Text])))
- (do error.Monad<Error>
+ (do error.monad
[#let [[_where _offset _code] (get@ #source context)]
[source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context))
[state' representation] (let [## TODO: Simplify ASAP
diff --git a/stdlib/source/lux/platform/interpreter/type.lux b/stdlib/source/lux/platform/interpreter/type.lux
index 698238e1c..f6a66a76a 100644
--- a/stdlib/source/lux/platform/interpreter/type.lux
+++ b/stdlib/source/lux/platform/interpreter/type.lux
@@ -32,12 +32,12 @@
(def: primitive-representation
(Poly Representation)
(`` ($_ p.either
- (do p.Monad<Parser>
+ (do p.monad
[_ (poly.exactly Any)]
(wrap (function.constant "[]")))
(~~ (do-template [<type> <formatter>]
- [(do p.Monad<Parser>
+ [(do p.monad
[_ (poly.sub <type>)]
(wrap (|>> (:coerce <type>) <formatter>)))]
@@ -52,7 +52,7 @@
(-> (Poly Representation) (Poly Representation))
(`` ($_ p.either
(~~ (do-template [<type> <formatter>]
- [(do p.Monad<Parser>
+ [(do p.monad
[_ (poly.sub <type>)]
(wrap (|>> (:coerce <type>) <formatter>)))]
@@ -64,12 +64,12 @@
[JSON %json]
[XML %xml]))
- (do p.Monad<Parser>
+ (do p.monad
[[_ elemT] (poly.apply (p.and (poly.exactly List) poly.any))
elemR (poly.local (list elemT) representation)]
(wrap (|>> (:coerce (List Any)) (%list elemR))))
- (do p.Monad<Parser>
+ (do p.monad
[[_ elemT] (poly.apply (p.and (poly.exactly Maybe) poly.any))
elemR (poly.local (list elemT) representation)]
(wrap (|>> (:coerce (Maybe Any))
@@ -81,7 +81,7 @@
(def: (record-representation tags representation)
(-> (List Name) (Poly Representation) (Poly Representation))
- (do p.Monad<Parser>
+ (do p.monad
[membersR+ (poly.tuple (p.many representation))
_ (p.assert "Number of tags does not match record type size."
(n/= (list.size tags) (list.size membersR+)))]
@@ -103,7 +103,7 @@
(def: (variant-representation tags representation)
(-> (List Name) (Poly Representation) (Poly Representation))
- (do p.Monad<Parser>
+ (do p.monad
[casesR+ (poly.variant (p.many representation))
#let [num-tags (list.size tags)]
_ (p.assert "Number of tags does not match variant type size."
@@ -131,7 +131,7 @@
(def: (tagged-representation compiler representation)
(-> Lux (Poly Representation) (Poly Representation))
- (do p.Monad<Parser>
+ (do p.monad
[[name anonymous] poly.named]
(case (macro.run compiler (macro.tags-of name))
(#error.Success ?tags)
@@ -149,7 +149,7 @@
(def: (tuple-representation representation)
(-> (Poly Representation) (Poly Representation))
- (do p.Monad<Parser>
+ (do p.monad
[membersR+ (poly.tuple (p.many representation))]
(wrap (function (_ tupleV)
(let [tuple-body (loop [representations membersR+
@@ -176,7 +176,7 @@
(tagged-representation compiler representation)
(tuple-representation representation)
- (do p.Monad<Parser>
+ (do p.monad
[[funcT inputsT+] (poly.apply (p.and poly.any (p.many poly.any)))]
(case (type.apply inputsT+ funcT)
(#.Some outputT)
@@ -185,7 +185,7 @@
#.None
(p.fail "")))
- (do p.Monad<Parser>
+ (do p.monad
[[name anonymous] poly.named]
(poly.local (list anonymous) representation))
diff --git a/stdlib/source/lux/platform/mediator.lux b/stdlib/source/lux/platform/mediator.lux
new file mode 100644
index 000000000..4481b6e2e
--- /dev/null
+++ b/stdlib/source/lux/platform/mediator.lux
@@ -0,0 +1,20 @@
+(.module:
+ [lux (#- Source Module)
+ [data
+ ["." error (#+ Error)]]
+ [world
+ ["." binary (#+ Binary)]
+ ["." file (#+ File)]]]
+ [//
+ [compiler (#+ Compiler)
+ [meta
+ ["." archive (#+ Archive)
+ [descriptor (#+ Module)]]]]])
+
+(type: #export Source File)
+
+(type: #export (Mediator !)
+ (-> Archive Module (! Archive)))
+
+(type: #export (Instancer ! d o)
+ (-> (file.System !) (List Source) (Compiler d o) (Mediator !)))
diff --git a/stdlib/source/lux/platform/mediator/parallelism.lux b/stdlib/source/lux/platform/mediator/parallelism.lux
new file mode 100644
index 000000000..251ec1f9f
--- /dev/null
+++ b/stdlib/source/lux/platform/mediator/parallelism.lux
@@ -0,0 +1,169 @@
+(.module:
+ [lux (#- Source Module)
+ [control
+ ["." monad (#+ Monad do)]
+ ["ex" exception (#+ exception:)]]
+ [concurrency
+ ["." promise (#+ Promise) ("promise/." functor)]
+ ["." task (#+ Task)]
+ ["." stm (#+ Var STM)]]
+ [data
+ ["." error (#+ Error) ("error/." monad)]
+ ["." text ("text/." equivalence)
+ format]
+ [collection
+ [list ("list/." functor)]
+ ["." dictionary (#+ Dictionary)]]]
+ ["." io]]
+ ["." // (#+ Source Mediator)
+ [//
+ ["." compiler (#+ Input Output Compilation Compiler)
+ [meta
+ ["." archive (#+ Archive)
+ ["." descriptor (#+ Module Descriptor)]
+ [document (#+ Document)]]
+ [io
+ ["." context]]]]]])
+
+(exception: #export (self-dependency {module Module})
+ (ex.report ["Module" module]))
+
+(exception: #export (circular-dependency {module Module} {dependency Module})
+ (ex.report ["Module" module]
+ ["Dependency" dependency]))
+
+(type: Pending-Compilation
+ (Promise (Error (Ex [d] (Document d)))))
+
+(type: Active-Compilations
+ (Dictionary Module [Descriptor Pending-Compilation]))
+
+(def: (self-dependence? module dependency)
+ (-> Module Module Bit)
+ (text/= module dependency))
+
+(def: (circular-dependence? active dependency)
+ (-> Active-Compilations Module Bit)
+ (case (dictionary.get dependency active)
+ (#.Some [descriptor pending])
+ (case (get@ #descriptor.state descriptor)
+ #.Active
+ true
+
+ _
+ false)
+
+ #.None
+ false))
+
+(def: (ensure-valid-dependencies! active dependencies module)
+ (-> Active-Compilations (List Module) Module (Task Any))
+ (do task.monad
+ [_ (: (Task Any)
+ (if (list.any? (self-dependence? module) dependencies)
+ (task.throw self-dependency module)
+ (wrap [])))]
+ (: (Task Any)
+ (case (list.find (circular-dependence? active) dependencies)
+ (#.Some dependency)
+ (task.throw circular-dependency module dependency)
+
+ #.None
+ (wrap [])))))
+
+(def: (share-compilation archive pending)
+ (-> Active-Compilations Pending-Compilation (Task Archive))
+ (promise/map (|>> (error/map (function (_ document)
+ (archive.add module document archive)))
+ error/join)
+ pending))
+
+(def: (import Monad<!> mediate archive dependencies)
+ (All [!] (-> (Monad !) (Mediator !) Active-Compilations (List Module) (! (List Archive))))
+ (|> dependencies
+ (list/map (mediate archive))
+ (monad.seq Monad<!>)))
+
+(def: (step-compilation archive imports [dependencies process])
+ (All [d o] (-> Archive (List Archive) (Compilation d o)
+ [Archive (Either (Compilation d o)
+ [(Document d) (Output o)])]))
+ (do error.monad
+ [archive' (monad.fold error.monad archive.merge archive imports)
+ outcome (process archive')]
+ (case outcome
+ (#.Right [document output])
+ (do @
+ [archive'' (archive.add module document archive')]
+ (wrap [archive'' (#.Right [document output])]))
+
+ (#.Left continue)
+ (wrap [archive' outcome]))))
+
+(def: (request-compilation file-system sources module compilations)
+ (All [!]
+ (-> (file.System Task) (List Source) Module (Var Active-Compilations)
+ (Task (Either Pending-Compilation
+ [Pending-Compilation Active-Compilations Input]))))
+ (do (:: file-system &monad)
+ [current (|> (stm.read compilations)
+ stm.commit
+ task.from-promise)]
+ (case (dictionary.get module current)
+ (#.Some [descriptor pending])
+ (wrap (#.Left pending))
+
+ #.None
+ (do @
+ [input (context.read file-system sources module)]
+ (do stm.monad
+ [stale (stm.read compilations)]
+ (case (dictionary.get module stale)
+ (#.Some [descriptor pending])
+ (wrap (#.Left [pending current]))
+
+ #.None
+ (do @
+ [#let [base-descriptor {#descriptor.hash (get@ #compiler.hash input)
+ #descriptor.name (get@ #compiler.module input)
+ #descriptor.file (get@ #compiler.file input)
+ #descriptor.references (list)
+ #descriptor.state #.Active}
+ pending (promise.promise (: (Maybe (Error (Ex [d] (Document d))))
+ #.None))]
+ updated (stm.update (dictionary.put (get@ #compiler.module input)
+ [base-descriptor pending])
+ compilations)]
+ (wrap (is? current stale)
+ (#.Right [pending updated input])))))))))
+
+(def: (mediate-compilation Monad<!> mediate compiler input archive pending)
+ (All [! d o] (-> (Monad !) (Mediator ! d o) (Compiler d o) Input Archive Pending-Compilation (Task Archive)))
+ (loop [archive archive
+ compilation (compiler input)]
+ (do Monad<!>
+ [#let [[dependencies process] compilation]
+ _ (ensure-valid-dependencies! active dependencies (get@ #compiler.module input))
+ imports (import @ mediate archive dependencies)
+ [archive' next] (promise/wrap (step-compilation archive imports compilation))]
+ (case next
+ (#.Left continue)
+ (recur archive' continue)
+
+ (#.Right [document output])
+ (exec (io.run (promise.resolve (#error.Success document) pending))
+ (wrap archive'))))))
+
+(def: #export (mediator file-system sources compiler)
+ (//.Instancer Task)
+ (let [compilations (: (Var Active-Compilations)
+ (stm.var (dictionary.new text.hash)))]
+ (function (mediate archive module)
+ (do (:: file-system &monad)
+ [request (request-compilation file-system sources module compilations)]
+ (case request
+ (#.Left pending)
+ (share-compilation archive pending)
+
+ (#.Right [pending active input])
+ (mediate-compilation @ mediate compiler input archive pending))))))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index a96af556b..86957c223 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -4,18 +4,18 @@
["." monad (#+ Monad do)]
["ex" exception (#+ exception:)]
[concurrency
- ["." promise (#+ Promise) ("promise/." Monad<Promise>)]]]
+ ["." promise (#+ Promise) ("promise/." monad)]]]
[data
["." product]
["." text
format]
[collection
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
[time
["." instant]
["." duration]]
[math
- ["r" random ("random/." Monad<Random>)]]
+ ["r" random ("random/." monad)]]
["." io]])
(type: #export Counters
@@ -47,10 +47,10 @@
(def: #export (and left right)
{#.doc "Sequencing combinator."}
(-> Test Test Test)
- (do r.Monad<Random>
+ (do r.monad
[left left
right right]
- (wrap (do promise.Monad<Promise>
+ (wrap (do promise.monad
[[l-counter l-documentation] left
[r-counter r-documentation] right]
(wrap [(add-counters l-counter r-counter)
@@ -88,7 +88,7 @@
(def: #export (test message condition)
{#.doc "Check that a condition is #1, and fail with the given message otherwise."}
(-> Text Bit Test)
- (:: r.Monad<Random> wrap (assert message condition)))
+ (:: r.monad wrap (assert message condition)))
(def: pcg-32-magic-inc Nat 12345)
@@ -123,11 +123,11 @@
test
## else
- (do r.Monad<Random>
+ (do r.monad
[seed r.nat]
(function (_ prng)
(let [[prng' instance] (r.run (r.pcg-32 [..pcg-32-magic-inc seed]) test)]
- [prng' (do promise.Monad<Promise>
+ [prng' (do promise.monad
[[counters documentation] instance]
(if (failed? counters)
(wrap [counters (times-failure seed documentation)])
@@ -146,7 +146,7 @@
(def: #export (run! test)
(-> Test (Promise Nothing))
- (do promise.Monad<Promise>
+ (do promise.monad
[pre (promise.future instant.now)
#let [seed (instant.to-millis pre)
prng (r.pcg-32 [..pcg-32-magic-inc seed])]
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
index 27113d336..1bee129e4 100644
--- a/stdlib/source/lux/time/date.lux
+++ b/stdlib/source/lux/time/date.lux
@@ -1,198 +1,37 @@
(.module:
[lux #*
[control
- equivalence
- order
- enum
+ [equivalence (#+ Equivalence)]
+ [order (#+ Order)]
+ [enum (#+ Enum)]
codec
- ["p" parser ("p/." Functor<Parser>)]
+ ["p" parser ("p/." functor)]
[monad (#+ do)]]
[data
["." error (#+ Error)]
["." maybe]
- ["." number ("nat/." Codec<Text,Nat>) ("int/." Codec<Text,Int>)]
- [text ("text/." Monoid<Text>)
+ [number
+ ["." nat ("nat/." decimal)]
+ ["." int ("int/." decimal)]]
+ [text ("text/." monoid)
["l" lexer]]
[collection
- ["." row (#+ Row row)]]]])
+ ["." row (#+ Row row)]]]]
+ [//
+ ["//." month (#+ Month)]])
(type: #export Year Int)
-(type: #export Month
- #January
- #February
- #March
- #April
- #May
- #June
- #July
- #August
- #September
- #October
- #November
- #December)
-
-(structure: #export _ (Equivalence Month)
- (def: (= reference sample)
- (case [reference sample]
- (^template [<tag>]
- [<tag> <tag>]
- #1)
- ([#January]
- [#February]
- [#March]
- [#April]
- [#May]
- [#June]
- [#July]
- [#August]
- [#September]
- [#October]
- [#November]
- [#December])
-
- _
- #0)))
-
-(def: (month-to-nat month)
- (-> Month Nat)
- (case month
- #January 00
- #February 01
- #March 02
- #April 03
- #May 04
- #June 05
- #July 06
- #August 07
- #September 08
- #October 09
- #November 10
- #December 11))
-
-(`` (structure: #export _ (Order Month)
- (def: eq Equivalence<Month>)
- (~~ (do-template [<name> <comp>]
- [(def: (<name> reference sample)
- (<comp> (month-to-nat reference) (month-to-nat sample)))]
-
- [< n/<]
- [<= n/<=]
- [> n/>]
- [>= n/>=]
- ))))
-
-(structure: #export _ (Enum Month)
- (def: order Order<Month>)
- (def: (succ month)
- (case month
- #January #February
- #February #March
- #March #April
- #April #May
- #May #June
- #June #July
- #July #August
- #August #September
- #September #October
- #October #November
- #November #December
- #December #January))
- (def: (pred month)
- (case month
- #February #January
- #March #February
- #April #March
- #May #April
- #June #May
- #July #June
- #August #July
- #September #August
- #October #September
- #November #October
- #December #November
- #January #December)))
-
-(type: #export Day
- #Sunday
- #Monday
- #Tuesday
- #Wednesday
- #Thursday
- #Friday
- #Saturday)
-
-(structure: #export _ (Equivalence Day)
- (def: (= reference sample)
- (case [reference sample]
- (^template [<tag>]
- [<tag> <tag>]
- #1)
- ([#Sunday]
- [#Monday]
- [#Tuesday]
- [#Wednesday]
- [#Thursday]
- [#Friday]
- [#Saturday])
-
- _
- #0)))
-
-(def: (day-to-nat day)
- (-> Day Nat)
- (case day
- #Sunday 0
- #Monday 1
- #Tuesday 2
- #Wednesday 3
- #Thursday 4
- #Friday 5
- #Saturday 6))
-
-(`` (structure: #export _ (Order Day)
- (def: eq Equivalence<Day>)
- (~~ (do-template [<name> <comp>]
- [(def: (<name> reference sample)
- (<comp> (day-to-nat reference) (day-to-nat sample)))]
-
- [< n/<]
- [<= n/<=]
- [> n/>]
- [>= n/>=]
- ))))
-
-(structure: #export _ (Enum Day)
- (def: order Order<Day>)
- (def: (succ day)
- (case day
- #Sunday #Monday
- #Monday #Tuesday
- #Tuesday #Wednesday
- #Wednesday #Thursday
- #Thursday #Friday
- #Friday #Saturday
- #Saturday #Sunday))
- (def: (pred day)
- (case day
- #Monday #Sunday
- #Tuesday #Monday
- #Wednesday #Tuesday
- #Thursday #Wednesday
- #Friday #Thursday
- #Saturday #Friday
- #Sunday #Saturday)))
-
(type: #export Date
{#year Year
#month Month
#day Nat})
-(structure: #export _ (Equivalence Date)
+(structure: #export equivalence (Equivalence Date)
(def: (= reference sample)
(and (i/= (get@ #year reference)
(get@ #year sample))
- (:: Equivalence<Month> =
+ (:: //month.equivalence =
(get@ #month reference)
(get@ #month sample))
(n/= (get@ #day reference)
@@ -202,23 +41,23 @@
(-> Date Date Bit)
(or (i/< (get@ #year reference)
(get@ #year sample))
- (:: Order<Month> <
+ (:: //month.order <
(get@ #month reference)
(get@ #month sample))
(n/< (get@ #day reference)
(get@ #day sample))))
-(structure: #export _ (Order Date)
- (def: eq Equivalence<Date>)
+(structure: #export order (Order Date)
+ (def: &equivalence ..equivalence)
(def: < date/<)
(def: (> reference sample)
(date/< sample reference))
(def: (<= reference sample)
(or (date/< reference sample)
- (:: Equivalence<Date> = reference sample)))
+ (:: ..equivalence = reference sample)))
(def: (>= reference sample)
(or (date/< sample reference)
- (:: Equivalence<Date> = sample reference))))
+ (:: ..equivalence = sample reference))))
## Based on this: https://stackoverflow.com/a/42936293/6823464
(def: (pad value)
@@ -235,14 +74,14 @@
(int/encode year)
(nat/encode (.nat year)))
"-"
- (pad (|> month month-to-nat inc .int)) "-"
+ (pad (|> month //month.number inc .int)) "-"
(pad (|> day .int))))
(def: lex-year
(l.Lexer Int)
- (do p.Monad<Parser>
+ (do p.monad
[sign (p.maybe (l.this "-"))
- raw-year (p.codec number.Codec<Text,Nat> (l.many l.decimal))
+ raw-year (p.codec nat.decimal (l.many l.decimal))
#let [signum (case sign
(#.Some _)
-1
@@ -253,7 +92,7 @@
(def: lex-section
(l.Lexer Int)
- (p/map .int (p.codec number.Codec<Text,Nat> (l.exactly 2 l.decimal))))
+ (p/map .int (p.codec nat.decimal (l.exactly 2 l.decimal))))
(def: (leap-years year)
(-> Int Int)
@@ -285,13 +124,24 @@
## Based on: https://stackoverflow.com/a/3309340/6823464
(def: lex-date
(l.Lexer Date)
- (do p.Monad<Parser>
+ (do p.monad
[utc-year lex-year
_ (l.this "-")
utc-month lex-section
- _ (p.assert "Invalid month."
- (and (i/>= +1 utc-month)
- (i/<= +12 utc-month)))
+ month (case utc-month
+ +01 (wrap #//month.January)
+ +02 (wrap #//month.February)
+ +03 (wrap #//month.March)
+ +04 (wrap #//month.April)
+ +05 (wrap #//month.May)
+ +06 (wrap #//month.June)
+ +07 (wrap #//month.July)
+ +08 (wrap #//month.August)
+ +09 (wrap #//month.September)
+ +10 (wrap #//month.October)
+ +11 (wrap #//month.November)
+ +12 (wrap #//month.December)
+ _ (p.fail "Invalid month."))
#let [months (if (leap-year? utc-year)
leap-year-months
normal-months)
@@ -304,27 +154,14 @@
(and (i/>= +1 utc-day)
(i/<= (.int month-days) utc-day)))]
(wrap {#year utc-year
- #month (case utc-month
- +01 #January
- +02 #February
- +03 #March
- +04 #April
- +05 #May
- +06 #June
- +07 #July
- +08 #August
- +09 #September
- +10 #October
- +11 #November
- +12 #December
- _ (undefined))
+ #month month
#day (.nat utc-day)})))
(def: (decode input)
(-> Text (Error Date))
(l.run input ..lex-date))
-(structure: #export _
+(structure: #export codec
{#.doc (doc "Based on ISO 8601."
"For example: 2017-01-15")}
(Codec Text Date)
diff --git a/stdlib/source/lux/time/day.lux b/stdlib/source/lux/time/day.lux
new file mode 100644
index 000000000..2288111d7
--- /dev/null
+++ b/stdlib/source/lux/time/day.lux
@@ -0,0 +1,76 @@
+(.module:
+ [lux #*
+ [control
+ [equivalence (#+ Equivalence)]
+ [order (#+ Order)]
+ [enum (#+ Enum)]]])
+
+(type: #export Day
+ #Sunday
+ #Monday
+ #Tuesday
+ #Wednesday
+ #Thursday
+ #Friday
+ #Saturday)
+
+(structure: #export equivalence (Equivalence Day)
+ (def: (= reference sample)
+ (case [reference sample]
+ (^template [<tag>]
+ [<tag> <tag>]
+ #1)
+ ([#Sunday]
+ [#Monday]
+ [#Tuesday]
+ [#Wednesday]
+ [#Thursday]
+ [#Friday]
+ [#Saturday])
+
+ _
+ #0)))
+
+(def: (day-to-nat day)
+ (-> Day Nat)
+ (case day
+ #Sunday 0
+ #Monday 1
+ #Tuesday 2
+ #Wednesday 3
+ #Thursday 4
+ #Friday 5
+ #Saturday 6))
+
+(`` (structure: #export order (Order Day)
+ (def: &equivalence ..equivalence)
+ (~~ (do-template [<name> <comp>]
+ [(def: (<name> reference sample)
+ (<comp> (day-to-nat reference) (day-to-nat sample)))]
+
+ [< n/<]
+ [<= n/<=]
+ [> n/>]
+ [>= n/>=]
+ ))))
+
+(structure: #export enum (Enum Day)
+ (def: &order ..order)
+ (def: (succ day)
+ (case day
+ #Sunday #Monday
+ #Monday #Tuesday
+ #Tuesday #Wednesday
+ #Wednesday #Thursday
+ #Thursday #Friday
+ #Friday #Saturday
+ #Saturday #Sunday))
+ (def: (pred day)
+ (case day
+ #Monday #Sunday
+ #Tuesday #Monday
+ #Wednesday #Tuesday
+ #Thursday #Wednesday
+ #Friday #Thursday
+ #Saturday #Friday
+ #Sunday #Saturday)))
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index 9821bc33d..3c3fab0dd 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -8,8 +8,10 @@
["p" parser]
[monad (#+ do)]]
[data
- ["." number ("nat/." Codec<Text,Nat>) ("int/." Codec<Text,Int> Number<Int>)]
- [text ("text/." Monoid<Text>)
+ [number
+ ["." nat ("nat/." decimal)]
+ ["." int ("int/." decimal number)]]
+ [text ("text/." monoid)
["l" lexer]]
["e" error]]
[type
@@ -57,12 +59,12 @@
(-> Duration Duration Int)
(i// (:representation param) (:representation subject)))
- (structure: #export _ (Equivalence Duration)
+ (structure: #export equivalence (Equivalence Duration)
(def: (= param subject)
(i/= (:representation param) (:representation subject))))
- (`` (structure: #export _ (Order Duration)
- (def: eq Equivalence<Duration>)
+ (`` (structure: #export order (Order Duration)
+ (def: &equivalence ..equivalence)
(~~ (do-template [<name> <op>]
[(def: (<name> param subject)
(<op> (:representation param) (:representation subject)))]
@@ -73,7 +75,7 @@
[>= i/>=]
))))
- (open: "duration/." Order<Duration>)
+ (open: "duration/." ..order)
(do-template [<name> <op>]
[(def: #export (<name> left right)
@@ -113,13 +115,13 @@
(def: #export leap-year (merge day normal-year))
-(structure: #export _ (Monoid Duration)
- (def: identity empty)
- (def: compose merge))
+(structure: #export monoid (Monoid Duration)
+ (def: identity ..empty)
+ (def: compose ..merge))
(def: #export (encode duration)
(-> Duration Text)
- (if (:: Equivalence<Duration> = empty duration)
+ (if (:: ..equivalence = empty duration)
"+0ms"
(let [signed? (negative? duration)
[days time-left] [(query day duration) (frame day duration)]
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index d8fb0fe98..b85e3edd1 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -2,26 +2,29 @@
[lux #*
[io (#+ IO io)]
[control
- equivalence
- order
- enum
+ [equivalence (#+ Equivalence)]
+ [order (#+ Order)]
+ [enum (#+ Enum)]
codec
[monad (#+ do Monad)]
["p" parser]]
[data
["." error (#+ Error)]
["." maybe]
- ["." number ("int/." Codec<Text,Int>)]
- [text ("text/." Monoid<Text>)
+ [number
+ ["." int ("int/." decimal)]]
+ [text ("text/." monoid)
["l" lexer]]
[collection
- ["." list ("list/." Fold<List>)]
- ["." row (#+ Row row) ("row/." Functor<Row> Fold<Row>)]]]
+ ["." list ("list/." fold)]
+ ["." row (#+ Row row) ("row/." functor fold)]]]
[type
abstract]]
[//
- ["." duration ("duration/." Order<Duration>)]
- ["." date]])
+ ["." duration ("duration/." order)]
+ ["." date (#+ Date)]
+ ["." month (#+ Month)]
+ ["." day (#+ Day)]])
(abstract: #export Instant
{#.doc "Instant is defined as milliseconds since the epoch."}
@@ -51,24 +54,24 @@
(-> duration.Duration Instant)
(|> offset duration.to-millis :abstraction))
- (structure: #export _ (Equivalence Instant)
+ (structure: #export equivalence (Equivalence Instant)
(def: (= param subject)
- (:: number.Equivalence<Int> = (:representation param) (:representation subject))))
+ (:: int.equivalence = (:representation param) (:representation subject))))
- (`` (structure: #export _ (Order Instant)
- (def: eq Equivalence<Instant>)
+ (`` (structure: #export order (Order Instant)
+ (def: &equivalence ..equivalence)
(~~ (do-template [<name>]
[(def: (<name> param subject)
- (:: number.Order<Int> <name> (:representation param) (:representation subject)))]
+ (:: int.order <name> (:representation param) (:representation subject)))]
[<] [<=] [>] [>=]
))))
- (`` (structure: #export _ (Enum Instant)
- (def: order Order<Instant>)
+ (`` (structure: #export enum (Enum Instant)
+ (def: &order ..order)
(~~ (do-template [<name>]
[(def: <name>
- (|>> :representation (:: number.Enum<Int> <name>) :abstraction))]
+ (|>> :representation (:: int.enum <name>) :abstraction))]
[succ] [pred]
))))
@@ -217,9 +220,9 @@
## Codec::decode
(def: lex-year
(l.Lexer Int)
- (do p.Monad<Parser>
+ (do p.monad
[sign (p.or (l.this "-") (l.this "+"))
- raw-year (p.codec number.Codec<Text,Int> (l.many l.decimal))
+ raw-year (p.codec int.decimal (l.many l.decimal))
#let [signum (case sign
(#.Left _) -1
(#.Right _) +1)]]
@@ -227,14 +230,14 @@
(def: lex-section
(l.Lexer Int)
- (p.codec number.Codec<Text,Int> (l.exactly 2 l.decimal)))
+ (p.codec int.decimal (l.exactly 2 l.decimal)))
(def: lex-millis
(l.Lexer Int)
(p.either (|> (l.at-most 3 l.decimal)
- (p.codec number.Codec<Text,Int>)
+ (p.codec int.decimal)
(p.after (l.this ".")))
- (:: p.Monad<Parser> wrap +0)))
+ (:: p.monad wrap +0)))
(def: (leap-years year)
(-> Int Int)
@@ -245,7 +248,7 @@
## Based on: https://stackoverflow.com/a/3309340/6823464
## (def: lex-instant
## (l.Lexer Instant)
-## (do p.Monad<Parser>
+## (do p.monad
## [utc-year lex-year
## _ (l.this "-")
## utc-month lex-section
@@ -315,32 +318,32 @@
(io (from-millis ("lux io current-time"))))
(def: #export (date instant)
- (-> Instant date.Date)
+ (-> Instant Date)
(let [[[year month day] _] (extract-date instant)]
{#date.year year
#date.month (case (dec month)
- +0 #date.January
- +1 #date.February
- +2 #date.March
- +3 #date.April
- +4 #date.May
- +5 #date.June
- +6 #date.July
- +7 #date.August
- +8 #date.September
- +9 #date.October
- +10 #date.November
- +11 #date.December
+ +0 #month.January
+ +1 #month.February
+ +2 #month.March
+ +3 #month.April
+ +4 #month.May
+ +5 #month.June
+ +6 #month.July
+ +7 #month.August
+ +8 #month.September
+ +9 #month.October
+ +10 #month.November
+ +11 #month.December
_ (undefined))
#date.day (.nat day)}))
(def: #export (month instant)
- (-> Instant date.Month)
+ (-> Instant Month)
(let [[year month day] (date instant)]
month))
(def: #export (day instant)
- (-> Instant date.Day)
+ (-> Instant Day)
(let [offset (relative instant)
days (duration.query duration.day offset)
day-time (duration.frame duration.day offset)
@@ -354,11 +357,11 @@
(i/+ days) (i/% +7)
## This is done to turn negative days into positive days.
(i/+ +7) (i/% +7))
- +0 #date.Sunday
- +1 #date.Monday
- +2 #date.Tuesday
- +3 #date.Wednesday
- +4 #date.Thursday
- +5 #date.Friday
- +6 #date.Saturday
+ +0 #day.Sunday
+ +1 #day.Monday
+ +2 #day.Tuesday
+ +3 #day.Wednesday
+ +4 #day.Thursday
+ +5 #day.Friday
+ +6 #day.Saturday
_ (undefined))))
diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux
new file mode 100644
index 000000000..203f5c6cb
--- /dev/null
+++ b/stdlib/source/lux/time/month.lux
@@ -0,0 +1,101 @@
+(.module:
+ [lux #*
+ [control
+ [equivalence (#+ Equivalence)]
+ [order (#+ Order)]
+ [enum (#+ Enum)]]])
+
+(type: #export Month
+ #January
+ #February
+ #March
+ #April
+ #May
+ #June
+ #July
+ #August
+ #September
+ #October
+ #November
+ #December)
+
+(structure: #export equivalence (Equivalence Month)
+ (def: (= reference sample)
+ (case [reference sample]
+ (^template [<tag>]
+ [<tag> <tag>]
+ #1)
+ ([#January]
+ [#February]
+ [#March]
+ [#April]
+ [#May]
+ [#June]
+ [#July]
+ [#August]
+ [#September]
+ [#October]
+ [#November]
+ [#December])
+
+ _
+ #0)))
+
+(def: #export (number month)
+ (-> Month Nat)
+ (case month
+ #January 00
+ #February 01
+ #March 02
+ #April 03
+ #May 04
+ #June 05
+ #July 06
+ #August 07
+ #September 08
+ #October 09
+ #November 10
+ #December 11))
+
+(`` (structure: #export order (Order Month)
+ (def: &equivalence ..equivalence)
+ (~~ (do-template [<name> <comp>]
+ [(def: (<name> reference sample)
+ (<comp> (number reference) (number sample)))]
+
+ [< n/<]
+ [<= n/<=]
+ [> n/>]
+ [>= n/>=]
+ ))))
+
+(structure: #export enum (Enum Month)
+ (def: &order ..order)
+ (def: (succ month)
+ (case month
+ #January #February
+ #February #March
+ #March #April
+ #April #May
+ #May #June
+ #June #July
+ #July #August
+ #August #September
+ #September #October
+ #October #November
+ #November #December
+ #December #January))
+ (def: (pred month)
+ (case month
+ #February #January
+ #March #February
+ #April #March
+ #May #April
+ #June #May
+ #July #June
+ #August #July
+ #September #August
+ #October #September
+ #November #October
+ #December #November
+ #January #December)))
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 3615ac808..e72eccd55 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -2,21 +2,21 @@
[lux (#- function)
[control
[equivalence (#+ Equivalence)]
- [monad (#+ do Monad)]
+ [monad (#+ Monad do)]
["p" parser]]
[data
- ["." text ("text/." Monoid<Text> Equivalence<Text>)]
- [name ("name/." Equivalence<Name> Codec<Text,Name>)]
- [number ("nat/." Codec<Text,Nat>)]
+ ["." text ("text/." monoid equivalence)]
+ [name ("name/." equivalence codec)]
+ [number
+ [nat ("nat/." decimal)]]
["." maybe]
[collection
["." array]
- ["." list ("list/." Functor<List> Monoid<List> Fold<List>)]]]
+ ["." list ("list/." functor monoid fold)]]]
["." macro
["." code]
["s" syntax (#+ Syntax syntax:)]]])
-## [Utils]
(def: (beta-reduce env type)
(-> (List Type) Type Type)
(case type
@@ -48,8 +48,7 @@
type
))
-## [Structures]
-(structure: #export _ (Equivalence Type)
+(structure: #export equivalence (Equivalence Type)
(def: (= x y)
(case [x y]
[(#.Primitive xname xparams) (#.Primitive yname yparams)]
@@ -90,7 +89,6 @@
#0
)))
-## [Values]
(do-template [<name> <tag>]
[(def: #export (<name> type)
(-> Type [Nat Type])
@@ -321,7 +319,7 @@
(#.Apply A F)
(maybe.default #0
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[applied (apply (list A) F)]
(wrap (quantified? applied))))
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index ccb6b9e18..fb086d2ed 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -2,15 +2,15 @@
[lux (#- Scope)
[control
[monad (#+ Monad do)]
- ["p" parser ("p/." Monad<Parser>)]
+ ["p" parser ("p/." monad)]
["ex" exception (#+ exception:)]]
[data
- [name ("name/." Codec<Text,Name>)]
- [text ("text/." Equivalence<Text> Monoid<Text>)]
+ [name ("name/." codec)]
+ [text ("text/." equivalence monoid)]
[collection
- ["." list ("list/." Functor<List> Monoid<List>)]
+ ["." list ("list/." functor monoid)]
["." stack (#+ Stack)]]]
- ["." macro ("meta/." Monad<Meta>)
+ ["." macro ("meta/." monad)
["." code]
["s" syntax (#+ Syntax syntax:)]
[syntax
@@ -166,7 +166,7 @@
(def: declaration
(Syntax [Text (List Text)])
(p.either (s.form (p.and s.local-identifier (p.some s.local-identifier)))
- (p.and s.local-identifier (:: p.Monad<Parser> wrap (list)))))
+ (p.and s.local-identifier (:: p.monad wrap (list)))))
## TODO: Make sure the generated code always gets optimized away.
## (This applies to uses of ":abstraction" and ":representation")
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index fa6067ab6..d12b19599 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -3,18 +3,19 @@
[control
[functor (#+ Functor)]
[apply (#+ Apply)]
- ["." monad (#+ do Monad)]
+ ["." monad (#+ Monad do)]
["ex" exception (#+ exception:)]]
[data
["." maybe]
["." product]
["." error (#+ Error)]
- ["." number ("nat/." Codec<Text,Nat>)]
- ["." text ("text/." Monoid<Text> Equivalence<Text>)]
+ [number
+ ["." nat ("nat/." decimal)]]
+ ["." text ("text/." monoid equivalence)]
[collection
["." list]
["." set (#+ Set)]]]]
- ["." // ("type/." Equivalence<Type>)])
+ ["." // ("type/." equivalence)])
(template: (!n/= reference subject)
("lux i64 =" subject reference))
@@ -51,7 +52,7 @@
(type: #export Type-Vars
(List [Var (Maybe Type)]))
-(structure: #export _ (Functor Check)
+(structure: #export functor (Functor Check)
(def: (map f fa)
(function (_ context)
(case (fa context)
@@ -61,8 +62,8 @@
(#error.Failure error)
(#error.Failure error)))))
-(structure: #export _ (Apply Check)
- (def: functor Functor<Check>)
+(structure: #export apply (Apply Check)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ context)
@@ -80,8 +81,8 @@
)))
)
-(structure: #export _ (Monad Check)
- (def: functor Functor<Check>)
+(structure: #export monad (Monad Check)
+ (def: &functor ..functor)
(def: (wrap x)
(function (_ context)
@@ -103,7 +104,7 @@
)))
)
-(open: "check/." Monad<Check>)
+(open: "check/." ..monad)
(def: (var::get id plist)
(-> Var Type-Vars (Maybe (Maybe Type)))
@@ -148,7 +149,6 @@
#.Nil
#.Nil))
-## [[Logic]]
(def: #export (run context proc)
(All [a] (-> Type-Context (Check a) (Error a)))
(case (proc context)
@@ -241,7 +241,7 @@
(-> Type Type (Check Type))
(case funcT
(#.Var func-id)
- (do Monad<Check>
+ (do ..monad
[?funcT' (read func-id)]
(case ?funcT'
(#.Some funcT')
@@ -260,7 +260,7 @@
(type: #export Ring (Set Var))
-(def: empty-ring Ring (set.new number.Hash<Nat>))
+(def: empty-ring Ring (set.new nat.hash))
## TODO: Optimize this by not using sets anymore.
(def: #export (ring start)
@@ -341,29 +341,29 @@
(-> Var Type (Check a) (-> Type (Check a))
(Check a)))
($_ either
- (do Monad<Check>
+ (do ..monad
[_ (..bind type id)]
then)
- (do Monad<Check>
+ (do ..monad
[ring (..ring id)
_ (assert "" (n/> 1 (set.size ring)))
_ (monad.map @ (update type) (set.to-list ring))]
then)
- (do Monad<Check>
+ (do ..monad
[?bound (read id)]
(else (maybe.default (#.Var id) ?bound)))))
## TODO: "link-2" can be optimized...
(def: (link-2 left right)
(-> Var Var (Check Any))
- (do Monad<Check>
+ (do ..monad
[_ (..bind (#.Var right) left)]
(..bind (#.Var left) right)))
## TODO: "link-3" can be optimized...
(def: (link-3 interpose to from)
(-> Var Var Var (Check Any))
- (do Monad<Check>
+ (do ..monad
[_ (update (#.Var interpose) from)]
(update (#.Var to) interpose)))
@@ -375,7 +375,7 @@
(Check (List Assumption)))
(if (!n/= idE idA)
(check/wrap assumptions)
- (do Monad<Check>
+ (do ..monad
[ebound (attempt (peek idE))
abound (attempt (peek idA))]
(case [ebound abound]
@@ -413,7 +413,7 @@
(do @
[ringE (..ring idE)
ringA (..ring idA)]
- (if (:: set.Equivalence<Set> = ringE ringA)
+ (if (:: set.equivalence = ringE ringA)
(wrap assumptions)
## Fuse 2 rings
(do @
@@ -464,43 +464,43 @@
(Check (List Assumption)))
(case [eFT aFT]
(^or [(#.UnivQ _ _) (#.Ex _)] [(#.UnivQ _ _) (#.Var _)])
- (do Monad<Check>
+ (do ..monad
[eFT' (apply-type! eFT eAT)]
(check' assumptions eFT' (#.Apply aAT aFT)))
(^or [(#.Ex _) (#.UnivQ _ _)] [(#.Var _) (#.UnivQ _ _)])
- (do Monad<Check>
+ (do ..monad
[aFT' (apply-type! aFT aAT)]
(check' assumptions (#.Apply eAT eFT) aFT'))
(^or [(#.Ex _) _] [_ (#.Ex _)])
- (do Monad<Check>
+ (do ..monad
[assumptions (check' assumptions eFT aFT)]
(check' assumptions eAT aAT))
[(#.Var id) _]
- (do Monad<Check>
+ (do ..monad
[?rFT (read id)]
(case ?rFT
(#.Some rFT)
(check' assumptions (#.Apply eAT rFT) (#.Apply aAT aFT))
_
- (do Monad<Check>
+ (do ..monad
[assumptions (check' assumptions eFT aFT)
e' (apply-type! aFT eAT)
a' (apply-type! aFT aAT)]
(check' assumptions e' a'))))
[_ (#.Var id)]
- (do Monad<Check>
+ (do ..monad
[?rFT (read id)]
(case ?rFT
(#.Some rFT)
(check' assumptions (#.Apply eAT eFT) (#.Apply aAT rFT))
_
- (do Monad<Check>
+ (do ..monad
[assumptions (check' assumptions eFT aFT)
e' (apply-type! eFT eAT)
a' (apply-type! eFT aAT)]
@@ -545,19 +545,19 @@
(let [new-assumption [expected actual]]
(if (assumed? new-assumption assumptions)
(check/wrap assumptions)
- (do Monad<Check>
+ (do ..monad
[expected' (apply-type! F A)]
(check' (assume! new-assumption assumptions) expected' actual))))
[_ (#.Apply A F)]
- (do Monad<Check>
+ (do ..monad
[actual' (apply-type! F A)]
(check' assumptions expected actual'))
## TODO: Refactor-away as cold-code
(^template [<tag> <instancer>]
[(<tag> _) _]
- (do Monad<Check>
+ (do ..monad
[[_ paramT] <instancer>
expected' (apply-type! expected paramT)]
(check' assumptions expected' actual)))
@@ -567,7 +567,7 @@
## TODO: Refactor-away as cold-code
(^template [<tag> <instancer>]
[_ (<tag> _)]
- (do Monad<Check>
+ (do ..monad
[[_ paramT] <instancer>
actual' (apply-type! actual paramT)]
(check' assumptions expected actual')))
@@ -584,7 +584,7 @@
(check/wrap assumptions)
[(#.Cons e-head e-tail) (#.Cons a-head a-tail)]
- (do Monad<Check>
+ (do ..monad
[assumptions' (check' assumptions e-head a-head)]
(recur assumptions' e-tail a-tail))
@@ -594,14 +594,14 @@
(^template [<compose>]
[(<compose> eL eR) (<compose> aL aR)]
- (do Monad<Check>
+ (do ..monad
[assumptions (check' assumptions eL aL)]
(check' assumptions eR aR)))
([#.Sum]
[#.Product])
[(#.Function eI eO) (#.Function aI aO)]
- (do Monad<Check>
+ (do ..monad
[assumptions (check' assumptions aI eI)]
(check' assumptions eO aO))
@@ -644,7 +644,7 @@
(case inputT
(#.Primitive name paramsT+)
(|> paramsT+
- (monad.map Monad<Check> clean)
+ (monad.map ..monad clean)
(check/map (|>> (#.Primitive name))))
(^or (#.Parameter _) (#.Ex _) (#.Named _))
@@ -652,14 +652,14 @@
(^template [<tag>]
(<tag> leftT rightT)
- (do Monad<Check>
+ (do ..monad
[leftT' (clean leftT)]
(|> (clean rightT)
(check/map (|>> (<tag> leftT'))))))
([#.Sum] [#.Product] [#.Function] [#.Apply])
(#.Var id)
- (do Monad<Check>
+ (do ..monad
[?actualT (read id)]
(case ?actualT
(#.Some actualT)
@@ -670,7 +670,7 @@
(^template [<tag>]
(<tag> envT+ unquantifiedT)
- (do Monad<Check>
+ (do ..monad
[envT+' (monad.map @ clean envT+)]
(wrap (<tag> envT+' unquantifiedT))))
([#.UnivQ] [#.ExQ])
diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux
index 6fb83f8fb..cda9ac14b 100644
--- a/stdlib/source/lux/type/dynamic.lux
+++ b/stdlib/source/lux/type/dynamic.lux
@@ -36,7 +36,7 @@
(with-gensyms [g!type g!value]
(wrap (list (` (let [[(~ g!type) (~ g!value)] ((~! ..dynamic-representation) (~ value))]
(: ((~! error.Error) (~ type))
- (if (:: (~! type.Equivalence<Type>) (~' =)
+ (if (:: (~! type.equivalence) (~' =)
(.type (~ type)) (~ g!type))
(#error.Success (:coerce (~ type) (~ g!value)))
((~! ex.throw) ..wrong-type [(.type (~ type)) (~ g!type)])))))))))
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index 42db42900..83a8e9998 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -8,10 +8,10 @@
["." product]
["." maybe]
["." number]
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
format]
[collection
- ["." list ("list/." Monad<List> Fold<List>)]
+ ["." list ("list/." monad fold)]
["dict" dictionary (#+ Dictionary)]]]
["." macro
["." code]
@@ -29,7 +29,7 @@
(find-type-var id' env)
_
- (:: macro.Monad<Meta> wrap type))
+ (:: macro.monad wrap type))
(#.Some [_ #.None])
(macro.fail (format "Unbound type-var " (%n id)))
@@ -40,7 +40,7 @@
(def: (resolve-type var-name)
(-> Name (Meta Type))
- (do macro.Monad<Meta>
+ (do macro.monad
[raw-type (macro.find-type var-name)
compiler macro.get-compiler]
(case raw-type
@@ -66,23 +66,23 @@
(#.Product left right)
(if (n/= 0 idx)
- (:: check.Monad<Check> wrap left)
+ (:: check.monad wrap left)
(find-member-type (dec idx) right))
_
(if (n/= 0 idx)
- (:: check.Monad<Check> wrap sig-type)
+ (:: check.monad wrap sig-type)
(check.fail (format "Cannot find member type " (%n idx) " for " (%type sig-type))))))
(def: (find-member-name member)
(-> Name (Meta Name))
(case member
["" simple-name]
- (macro.either (do macro.Monad<Meta>
+ (macro.either (do macro.monad
[member (macro.normalize member)
_ (macro.resolve-tag member)]
(wrap member))
- (do macro.Monad<Meta>
+ (do macro.monad
[this-module-name macro.current-module-name
imp-mods (macro.imported-modules this-module-name)
tag-lists (monad.map @ macro.tag-lists imp-mods)
@@ -100,11 +100,11 @@
(macro.fail (format "Too many candidate tags: " (%list %name candidates))))))
_
- (:: macro.Monad<Meta> wrap member)))
+ (:: macro.monad wrap member)))
(def: (resolve-member member)
(-> Name (Meta [Nat Type]))
- (do macro.Monad<Meta>
+ (do macro.monad
[member (find-member-name member)
[idx tag-list sig-type] (macro.resolve-tag member)]
(wrap [idx sig-type])))
@@ -119,12 +119,12 @@
(def: local-env
(Meta (List [Name Type]))
- (do macro.Monad<Meta>
+ (do macro.monad
[local-batches macro.locals
#let [total-locals (list/fold (function (_ [name type] table)
(dict.put~ name type table))
(: (Dictionary Text Type)
- (dict.new text.Hash<Text>))
+ (dict.new text.hash))
(list/join local-batches))]]
(wrap (|> total-locals
dict.entries
@@ -132,14 +132,14 @@
(def: local-structs
(Meta (List [Name Type]))
- (do macro.Monad<Meta>
+ (do macro.monad
[this-module-name macro.current-module-name
definitions (macro.definitions this-module-name)]
(wrap (prepare-definitions this-module-name definitions))))
(def: import-structs
(Meta (List [Name Type]))
- (do macro.Monad<Meta>
+ (do macro.monad
[this-module-name macro.current-module-name
imp-mods (macro.imported-modules this-module-name)
export-batches (monad.map @ (function (_ imp-mod)
@@ -156,13 +156,13 @@
(apply-function-type func' arg)
(#.UnivQ _)
- (do check.Monad<Check>
+ (do check.monad
[[id var] check.var]
(apply-function-type (maybe.assume (type.apply (list var) func))
arg))
(#.Function input output)
- (do check.Monad<Check>
+ (do check.monad
[_ (check.check input arg)]
(wrap output))
@@ -173,19 +173,19 @@
(-> Type (Check [(List Nat) Type]))
(case type
(#.UnivQ _)
- (do check.Monad<Check>
+ (do check.monad
[[id var] check.var
[ids final-output] (concrete-type (maybe.assume (type.apply (list var) type)))]
(wrap [(#.Cons id ids)
final-output]))
_
- (:: check.Monad<Check> wrap [(list) type])))
+ (:: check.monad wrap [(list) type])))
(def: (check-apply member-type input-types output-type)
(-> Type (List Type) Type (Check []))
- (do check.Monad<Check>
- [member-type' (monad.fold check.Monad<Check>
+ (do check.monad
+ [member-type' (monad.fold check.monad
(function (_ input member)
(apply-function-type member input))
member-type
@@ -200,12 +200,12 @@
(-> (-> Lux Type-Context Type (Check Instance))
Type-Context Type (List [Name Type])
(Meta (List Instance)))
- (do macro.Monad<Meta>
+ (do macro.monad
[compiler macro.get-compiler]
(case (|> alts
(list/map (function (_ [alt-name alt-type])
(case (check.run context
- (do check.Monad<Check>
+ (do check.monad
[[tvars alt-type] (concrete-type alt-type)
#let [[deps alt-type] (type.flatten-function alt-type)]
_ (check.check dep alt-type)
@@ -228,9 +228,9 @@
(-> Lux Type-Context Type (Check Instance))
(case (macro.run compiler
($_ macro.either
- (do macro.Monad<Meta> [alts local-env] (test-provision provision context dep alts))
- (do macro.Monad<Meta> [alts local-structs] (test-provision provision context dep alts))
- (do macro.Monad<Meta> [alts import-structs] (test-provision provision context dep alts))))
+ (do macro.monad [alts local-env] (test-provision provision context dep alts))
+ (do macro.monad [alts local-structs] (test-provision provision context dep alts))
+ (do macro.monad [alts import-structs] (test-provision provision context dep alts))))
(#.Left error)
(check.fail error)
@@ -240,7 +240,7 @@
(check.fail (format "No candidates for provisioning: " (%type dep)))
(#.Cons winner #.Nil)
- (:: check.Monad<Check> wrap winner)
+ (:: check.monad wrap winner)
_
(check.fail (format "Too many candidates for provisioning: " (%type dep) " --- " (%list (|>> product.left %name) candidates))))
@@ -248,13 +248,13 @@
(def: (test-alternatives sig-type member-idx input-types output-type alts)
(-> Type Nat (List Type) Type (List [Name Type]) (Meta (List Instance)))
- (do macro.Monad<Meta>
+ (do macro.monad
[compiler macro.get-compiler
context macro.type-context]
(case (|> alts
(list/map (function (_ [alt-name alt-type])
(case (check.run context
- (do check.Monad<Check>
+ (do check.monad
[[tvars alt-type] (concrete-type alt-type)
#let [[deps alt-type] (type.flatten-function alt-type)]
_ (check.check alt-type sig-type)
@@ -279,9 +279,9 @@
(-> Type Nat (List Type) Type (Meta (List Instance)))
(let [test (test-alternatives sig-type member-idx input-types output-type)]
($_ macro.either
- (do macro.Monad<Meta> [alts local-env] (test alts))
- (do macro.Monad<Meta> [alts local-structs] (test alts))
- (do macro.Monad<Meta> [alts import-structs] (test alts)))))
+ (do macro.monad [alts local-env] (test alts))
+ (do macro.monad [alts local-structs] (test alts))
+ (do macro.monad [alts import-structs] (test alts)))))
(def: (var? input)
(-> Code Bit)
@@ -320,7 +320,7 @@
"a compile-time error will be raised, to alert the user."
"Examples:"
"Nat equivalence"
- (:: number.Equivalence<Nat> = x y)
+ (:: number.equivalence = x y)
(::: = x y)
"Can optionally add the prefix of the module where the signature was defined."
(::: eq.= x y)
@@ -366,7 +366,7 @@
(-> Nat (Meta (List Code)))
(|> (macro.gensym "g!implicit")
(list.repeat amount)
- (monad.seq macro.Monad<Meta>)))
+ (monad.seq macro.monad)))
(def: implicits
(Syntax (List Code))
diff --git a/stdlib/source/lux/type/quotient.lux b/stdlib/source/lux/type/quotient.lux
index 46f485720..7d56a1b24 100644
--- a/stdlib/source/lux/type/quotient.lux
+++ b/stdlib/source/lux/type/quotient.lux
@@ -49,7 +49,7 @@
(def: (quotient-type constructor-type)
(-> Type (Error Type))
(<| (poly.run constructor-type)
- (do p.Monad<Parser>
+ (do p.monad
[[valueT classT quotient-ex] (<| poly.apply (p.after (poly.exactly ..Class))
($_ p.and poly.any poly.any poly.existential))]
(wrap (.type (..Quotient valueT classT (:~ (#.Ex quotient-ex))))))))
diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux
index 4ccfd02be..5f5673785 100644
--- a/stdlib/source/lux/type/refinement.lux
+++ b/stdlib/source/lux/type/refinement.lux
@@ -6,7 +6,7 @@
["p" parser]]
[data
["." error (#+ Error)]]
- ["." type ("type/." Equivalence<Type>)
+ ["." type ("type/." equivalence)
abstract]
["." macro
["s" syntax (#+ syntax:)]
@@ -87,7 +87,7 @@
(def: (refinement-type constructor-type)
(-> Type (Error Type))
(<| (poly.run constructor-type)
- (do p.Monad<Parser>
+ (do p.monad
[[un-refinedT refined-ex] (poly.apply (p.after (poly.exactly ..Refiner)
(p.and poly.any poly.existential)))]
(wrap (.type (..Refined un-refinedT (#.Ex refined-ex)))))))
diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux
index d3f7b7ab0..963034dbb 100644
--- a/stdlib/source/lux/type/resource.lux
+++ b/stdlib/source/lux/type/resource.lux
@@ -16,7 +16,7 @@
["dict" dictionary (#+ Dictionary)]
["." set]
["." row (#+ Row)]
- ["." list ("list/." Functor<List> Fold<List>)]]]
+ ["." list ("list/." functor fold)]]]
[concurrency
["." promise (#+ Promise)]]
["." macro
@@ -40,7 +40,7 @@
(All [keys]
(Procedure monad [permissions keys] keys value)))
-(structure: (IxMonad<Procedure> Monad<m>)
+(structure: (indexed Monad<m>)
(All [m] (-> (Monad m) (IxMonad (Procedure m))))
(def: (wrap value)
@@ -56,7 +56,7 @@
(do-template [<name> <m> <monad> <execute> <lift>]
[(def: #export <name>
(IxMonad (Procedure <m>))
- (IxMonad<Procedure> <monad>))
+ (..indexed <monad>))
(def: #export (<execute> procedure)
(All [v] (-> (Linear <m> v) (<m> v)))
@@ -71,9 +71,9 @@
[output procedure]
(wrap [keys output]))))]
- [IxMonad<Pure> Identity identity.Monad<Identity> run-pure lift-pure]
- [IxMonad<Sync> IO io.Monad<IO> run-sync lift-sync]
- [IxMonad<Async> Promise promise.Monad<Promise> run-async lift-async]
+ [pure Identity identity.monad run-pure lift-pure]
+ [sync IO io.monad run-sync lift-sync]
+ [async Promise promise.monad run-async lift-async]
)
(abstract: #export Ordered {} [])
@@ -105,12 +105,12 @@
(function (_ keys)
(:: <monad> wrap [[(<key> []) keys] (:abstraction value)])))]
- [ordered-pure Identity identity.Monad<Identity> Ordered ordered-key]
- [ordered-sync IO io.Monad<IO> Ordered ordered-key]
- [ordered-async Promise promise.Monad<Promise> Ordered ordered-key]
- [commutative-sync IO io.Monad<IO> Commutative commutative-key]
- [commutative-pure Identity identity.Monad<Identity> Commutative commutative-key]
- [commutative-async Promise promise.Monad<Promise> Commutative commutative-key])
+ [ordered-pure Identity identity.monad Ordered ordered-key]
+ [ordered-sync IO io.monad Ordered ordered-key]
+ [ordered-async Promise promise.monad Ordered ordered-key]
+ [commutative-sync IO io.monad Commutative commutative-key]
+ [commutative-pure Identity identity.monad Commutative commutative-key]
+ [commutative-async Promise promise.monad Commutative commutative-key])
(do-template [<name> <m> <monad>]
[(def: #export (<name> resource)
@@ -119,9 +119,9 @@
(function (_ [key keys])
(:: <monad> wrap [keys (:representation resource)])))]
- [read-pure Identity identity.Monad<Identity>]
- [read-sync IO io.Monad<IO>]
- [read-async Promise promise.Monad<Promise>]))
+ [read-pure Identity identity.monad]
+ [read-sync IO io.monad]
+ [read-async Promise promise.monad]))
(exception: #export (index-cannot-be-repeated {index Nat})
(%n index))
@@ -130,8 +130,8 @@
(def: indices
(Syntax (List Nat))
- (s.tuple (loop [seen (set.new number.Hash<Nat>)]
- (do p.Monad<Parser>
+ (s.tuple (loop [seen (set.new number.hash)]
+ (do p.monad
[done? s.end?]
(if done?
(wrap (list))
@@ -154,12 +154,12 @@
(wrap (list (` ((~! no-op) <monad>))))
(#.Cons head tail)
- (do macro.Monad<Meta>
+ (do macro.monad
[#let [max-idx (list/fold n/max head tail)]
g!inputs (<| (monad.seq @) (list.repeat (inc max-idx)) (macro.gensym "input"))
- #let [g!outputs (|> (monad.fold maybe.Monad<Maybe>
+ #let [g!outputs (|> (monad.fold maybe.monad
(function (_ from to)
- (do maybe.Monad<Maybe>
+ (do maybe.monad
[input (list.nth from g!inputs)]
(wrap (row.add input to))))
(: (Row Code) row.empty)
@@ -176,13 +176,13 @@
(function ((~ g!_) [(~+ g!inputs) (~ g!context)])
(:: (~! <monad>) (~' wrap) [[(~+ g!outputs) (~ g!context)] []]))))))))))]
- [exchange-pure Identity identity.Monad<Identity>]
- [exchange-sync IO io.Monad<IO>]
- [exchange-async Promise promise.Monad<Promise>])
+ [exchange-pure Identity identity.monad]
+ [exchange-sync IO io.monad]
+ [exchange-async Promise promise.monad])
(def: amount
(Syntax Nat)
- (do p.Monad<Parser>
+ (do p.monad
[raw s.nat
_ (p.assert (ex.construct amount-cannot-be-zero [])
(n/> 0 raw))]
@@ -191,7 +191,7 @@
(do-template [<name> <m> <monad> <from> <to>]
[(syntax: #export (<name> {amount ..amount})
(macro.with-gensyms [g!_ g!context]
- (do macro.Monad<Meta>
+ (do macro.monad
[g!keys (<| (monad.seq @) (list.repeat amount) (macro.gensym "keys"))]
(wrap (list (` (: (All [(~+ g!keys) (~ g!context)]
(Procedure (~! <m>)
@@ -201,10 +201,10 @@
(function ((~ g!_) [<from> (~ g!context)])
(:: (~! <monad>) (~' wrap) [[<to> (~ g!context)] []])))))))))]
- [group-pure Identity identity.Monad<Identity> (~+ g!keys) [(~+ g!keys)]]
- [group-sync IO io.Monad<IO> (~+ g!keys) [(~+ g!keys)]]
- [group-async Promise promise.Monad<Promise> (~+ g!keys) [(~+ g!keys)]]
- [un-group-pure Identity identity.Monad<Identity> [(~+ g!keys)] (~+ g!keys)]
- [un-group-sync IO io.Monad<IO> [(~+ g!keys)] (~+ g!keys)]
- [un-group-async Promise promise.Monad<Promise> [(~+ g!keys)] (~+ g!keys)]
+ [group-pure Identity identity.monad (~+ g!keys) [(~+ g!keys)]]
+ [group-sync IO io.monad (~+ g!keys) [(~+ g!keys)]]
+ [group-async Promise promise.monad (~+ g!keys) [(~+ g!keys)]]
+ [un-group-pure Identity identity.monad [(~+ g!keys)] (~+ g!keys)]
+ [un-group-sync IO io.monad [(~+ g!keys)] (~+ g!keys)]
+ [un-group-async Promise promise.monad [(~+ g!keys)] (~+ g!keys)]
)
diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux
index d6cd4ac6b..3aece5ff1 100644
--- a/stdlib/source/lux/type/unit.lux
+++ b/stdlib/source/lux/type/unit.lux
@@ -2,7 +2,7 @@
(.module:
[lux #*
[control
- [monad (#+ do Monad)]
+ [monad (#+ Monad do)]
["p" parser]
[equivalence (#+ Equivalence)]
[order (#+ Order)]
@@ -83,7 +83,7 @@
(def: ratio^
(s.Syntax r.Ratio)
- (s.tuple (do p.Monad<Parser>
+ (s.tuple (do p.monad
[numerator s.int
_ (p.assert (format "Numerator must be positive: " (%i numerator))
(i/> +0 numerator))
@@ -164,12 +164,12 @@
(unit: #export Litre)
(unit: #export Second)
-(structure: #export Equivalence<Unit> (All [unit] (Equivalence (Qty unit)))
+(structure: #export equivalence (All [unit] (Equivalence (Qty unit)))
(def: (= reference sample)
(i/= (out reference) (out sample))))
-(`` (structure: #export Order<Unit> (All [unit] (Order (Qty unit)))
- (def: eq Equivalence<Unit>)
+(`` (structure: #export order (All [unit] (Order (Qty unit)))
+ (def: &equivalence ..equivalence)
(~~ (do-template [<name> <func>]
[(def: (<name> reference sample)
@@ -180,7 +180,7 @@
[> i/>]
[>= i/>=]))))
-(structure: #export Enum<Unit> (All [unit] (Enum (Qty unit)))
- (def: order Order<Unit>)
+(structure: #export enum (All [unit] (Enum (Qty unit)))
+ (def: &order ..order)
(def: succ (|>> ..out inc ..in))
(def: pred (|>> ..out dec ..in)))
diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux
index 8e5b3901d..7ccc9e1cb 100644
--- a/stdlib/source/lux/world/binary.lux
+++ b/stdlib/source/lux/world/binary.lux
@@ -159,12 +159,12 @@
(-> Nat Binary (Error Binary))
(slice from (dec (..!size binary)) binary))
-(structure: #export _ (Equivalence Binary)
+(structure: #export equivalence (Equivalence Binary)
(def: (= reference sample)
(Arrays::equals reference sample)))
(def: #export (copy bytes source-offset source target-offset target)
(-> Nat Nat Binary Nat Binary (Error Binary))
- (do error.Monad<Error>
+ (do error.monad
[_ (System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))]
(wrap target)))
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index b02f0f69d..dedf3603f 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -71,7 +71,7 @@
(def: #export system
(IO (Error (Console IO)))
- (do io.Monad<IO>
+ (do io.monad
[?jvm-console (System::console)]
(case ?jvm-console
#.None
@@ -87,12 +87,12 @@
(def: (read _)
(|> jvm-input
InputStream::read
- (:: io.Functor<Process> map (|>> .nat integrity.taint))))
+ (:: (error.with-error io.functor) map (|>> .nat integrity.taint))))
(def: (read-line _)
(|> jvm-console
java/io/Console::readLine
- (:: io.Functor<Process> map integrity.taint)))
+ (:: (error.with-error io.functor) map integrity.taint)))
(def: (write message)
(PrintStream::print message jvm-output))
diff --git a/stdlib/source/lux/world/db/jdbc.jvm.lux b/stdlib/source/lux/world/db/jdbc.jvm.lux
index 2d3721716..9dd3ce890 100644
--- a/stdlib/source/lux/world/db/jdbc.jvm.lux
+++ b/stdlib/source/lux/world/db/jdbc.jvm.lux
@@ -6,7 +6,7 @@
[monad (#+ Monad do)]
["ex" exception]
[concurrency
- ["." promise (#+ Promise) ("promise/." Monad<Promise>)]]
+ ["." promise (#+ Promise) ("promise/." monad)]]
[security
[capability (#+ Capability)]]]
[data
@@ -16,7 +16,7 @@
[text
format]
[collection
- [list ("list/." Fold<List>)]]]
+ [list ("list/." fold)]]]
["." io (#+ IO)]
[world
[net (#+ URL)]]
@@ -57,7 +57,7 @@
(type: #export ID Int)
-(def: #export Equivalence<ID> number.Equivalence<Int>)
+(def: #export equivalence number.int-equivalence)
(type: #export (Statement input)
{#sql sql.Statement
@@ -96,7 +96,7 @@
(-> (Statement i) java/sql/Connection
(-> java/sql/PreparedStatement (IO (Error a)))
(IO (Error a))))
- (do (error.ErrorT io.Monad<IO>)
+ (do (error.ErrorT io.monad)
[prepared (io.io (java/sql/Connection::prepareStatement (sql.sql (get@ #sql statement))
(java/sql/Statement::RETURN_GENERATED_KEYS)
conn))
@@ -115,7 +115,7 @@
(def: #export (connect creds)
(-> Credentials (IO (Error (DB IO))))
- (do (error.ErrorT io.Monad<IO>)
+ (do (error.ErrorT io.monad)
[connection (java/sql/DriverManager::getConnection (get@ #url creds)
(get@ #user creds)
(get@ #password creds))]
@@ -124,14 +124,14 @@
(def: (execute statement)
(with-statement statement connection
(function (_ prepared)
- (do (error.ErrorT io.Monad<IO>)
+ (do (error.ErrorT io.monad)
[row-count (java/sql/PreparedStatement::executeUpdate prepared)]
(wrap (.nat row-count))))))
(def: (insert statement)
(with-statement statement connection
(function (_ prepared)
- (do (error.ErrorT io.Monad<IO>)
+ (do (error.ErrorT io.monad)
[_ (java/sql/PreparedStatement::executeUpdate prepared)
result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))]
(/output.rows /output.long result-set)))))
@@ -142,7 +142,7 @@
(def: (query [statement output])
(with-statement statement connection
(function (_ prepared)
- (do (error.ErrorT io.Monad<IO>)
+ (do (error.ErrorT io.monad)
[result-set (java/sql/PreparedStatement::executeQuery prepared)]
(/output.rows output result-set)))))
)))))
@@ -152,7 +152,7 @@
(-> Credentials
(-> (DB IO) (IO (Error a)))
(IO (Error a))))
- (do (error.ErrorT io.Monad<IO>)
+ (do (error.ErrorT io.monad)
[db (..connect creds)
result (action db)
_ (:: db close [])]
@@ -163,7 +163,7 @@
(-> Credentials
(-> (DB Promise) (Promise (Error a)))
(Promise (Error a))))
- (do (error.ErrorT promise.Monad<Promise>)
+ (do (error.ErrorT promise.monad)
[db (promise.future (..connect creds))
result (action (..async db))
_ (promise/wrap (io.run (:: db close [])))]
diff --git a/stdlib/source/lux/world/db/jdbc/input.jvm.lux b/stdlib/source/lux/world/db/jdbc/input.jvm.lux
index d037d4234..ef9db9009 100644
--- a/stdlib/source/lux/world/db/jdbc/input.jvm.lux
+++ b/stdlib/source/lux/world/db/jdbc/input.jvm.lux
@@ -6,7 +6,7 @@
[data
["." error (#+ Error)]
[collection
- [list ("list/." Fold<List>)]]]
+ [list ("list/." fold)]]]
[time
["." instant (#+ Instant)]]
["." io (#+ IO)]
@@ -57,7 +57,7 @@
(def: #export (and pre post)
(All [l r] (-> (Input l) (Input r) (Input [l r])))
(function (_ [left right] context)
- (do error.Monad<Error>
+ (do error.monad
[context (pre left context)]
(post right context))))
@@ -75,7 +75,7 @@
[(def: #export <function>
(Input <type>)
(function (_ value [idx statement])
- (do error.Monad<Error>
+ (do error.monad
[_ (<setter> (.int idx) value statement)]
(wrap [(.inc idx) statement]))))]
@@ -97,7 +97,7 @@
[(def: #export <function>
(Input Instant)
(function (_ value [idx statement])
- (do error.Monad<Error>
+ (do error.monad
[_ (<setter> (.int idx)
(<constructor> (instant.to-millis value))
statement)]
diff --git a/stdlib/source/lux/world/db/jdbc/output.jvm.lux b/stdlib/source/lux/world/db/jdbc/output.jvm.lux
index a28a6254e..7a45011f5 100644
--- a/stdlib/source/lux/world/db/jdbc/output.jvm.lux
+++ b/stdlib/source/lux/world/db/jdbc/output.jvm.lux
@@ -50,7 +50,7 @@
(type: #export (Output a)
(-> [Nat java/sql/ResultSet] (Error [Nat a])))
-(structure: #export _ (Functor Output)
+(structure: #export functor (Functor Output)
(def: (map f fa)
(function (_ idx+rs)
(case (fa idx+rs)
@@ -60,8 +60,8 @@
(#error.Success [idx' value])
(#error.Success [idx' (f value)])))))
-(structure: #export _ (Apply Output)
- (def: functor Functor<Output>)
+(structure: #export apply (Apply Output)
+ (def: &functor ..functor)
(def: (apply ff fa)
(function (_ [idx rs])
@@ -77,8 +77,8 @@
(#error.Failure msg)
(#error.Failure msg)))))
-(structure: #export _ (Monad Output)
- (def: functor Functor<Output>)
+(structure: #export monad (Monad Output)
+ (def: &functor ..functor)
(def: (wrap a)
(function (_ [idx rs])
@@ -101,7 +101,7 @@
(def: #export (and left right)
(All [a b]
(-> (Output a) (Output b) (Output [a b])))
- (do Monad<Output>
+ (do ..monad
[=left left
=right right]
(wrap [=left =right])))
@@ -155,35 +155,35 @@
(if has-next?
(case (output [1 results])
(#.Some [_ head])
- (do io.Monad<IO>
+ (do io.monad
[?tail (rows output results)]
(case ?tail
(#error.Success tail)
(wrap (ex.return (#.Cons head tail)))
(#error.Failure error)
- (do io.Monad<IO>
+ (do io.monad
[temp (java/sql/ResultSet::close results)]
- (wrap (do error.Monad<Error>
+ (wrap (do error.monad
[_ temp]
(error.fail error))))))
(#error.Failure error)
- (do io.Monad<IO>
+ (do io.monad
[temp (java/sql/ResultSet::close results)]
- (wrap (do error.Monad<Error>
+ (wrap (do error.monad
[_ temp]
(error.fail error)))))
- (do io.Monad<IO>
+ (do io.monad
[temp (java/sql/ResultSet::close results)]
- (wrap (do error.Monad<Error>
+ (wrap (do error.monad
[_ temp]
(wrap (list))))))
(#error.Failure error)
- (do io.Monad<IO>
+ (do io.monad
[temp (java/sql/ResultSet::close results)]
- (wrap (do error.Monad<Error>
+ (wrap (do error.monad
[_ temp]
(error.fail error))))
))
diff --git a/stdlib/source/lux/world/db/sql.lux b/stdlib/source/lux/world/db/sql.lux
index f4704cd94..dad0e4893 100644
--- a/stdlib/source/lux/world/db/sql.lux
+++ b/stdlib/source/lux/world/db/sql.lux
@@ -3,10 +3,10 @@
[control
[monad (#+ do)]]
[data
- ["." text ("text/." Equivalence<Text>)
+ ["." text ("text/." equivalence)
format]
[collection
- [list ("list/." Functor<List>)]]]
+ [list ("list/." functor)]]]
[type
abstract]])
diff --git a/stdlib/source/lux/world/environment.jvm.lux b/stdlib/source/lux/world/environment.jvm.lux
index 1a373ba8c..3d1181614 100644
--- a/stdlib/source/lux/world/environment.jvm.lux
+++ b/stdlib/source/lux/world/environment.jvm.lux
@@ -52,5 +52,5 @@
Map::entrySet
Set::iterator
(consume-iterator entry-to-kv)
- (dictionary.from-list text.Hash<Text>)
+ (dictionary.from-list text.hash)
integrity.taint)))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 78556b742..32adc204c 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -10,12 +10,12 @@
["!" capability (#+ capability:)]]]
[data
["." maybe]
- ["." error (#+ Error) ("error/." Functor<Error>)]
+ ["." error (#+ Error) ("error/." functor)]
["." text
format]
[collection
["." array (#+ Array)]
- ["." list ("list/." Functor<List>)]]]
+ ["." list ("list/." functor)]]]
[time
["." instant (#+ Instant)]
["." duration]]
@@ -23,7 +23,7 @@
["." template]]
[world
["." binary (#+ Binary)]]
- ["." io (#+ IO) ("io/." Functor<IO>)]
+ ["." io (#+ IO) ("io/." functor)]
[host (#+ import:)]
[platform
[compiler
@@ -185,14 +185,14 @@
["Path" file]))
(template: (!delete path exception)
- (do io.Monad<IO>
+ (do io.monad
[outcome (java/io/File::delete (java/io/File::new path))]
(case outcome
(#error.Success #1)
(wrap (#error.Success []))
_
- (io.throw exception [path]))))
+ (io.io (ex.throw exception [path])))))
(`` (for {(~~ (static host.jvm))
(as-is (import: #long java/io/File
@@ -229,14 +229,14 @@
(import: java/io/FileInputStream
(new [java/io/File] #io #try))
- (structure: (File<IO> path)
+ (structure: (file path)
(-> Path (File IO))
(~~ (do-template [<name> <flag>]
[(def: <name>
(..can-modify
(function (<name> data)
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[stream (FileOutputStream::new (java/io/File::new path) <flag>)
_ (OutputStream::write data stream)
_ (OutputStream::flush stream)]
@@ -249,7 +249,7 @@
(def: content
(..can-query
(function (content _)
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[#let [file (java/io/File::new path)]
size (java/io/File::length file)
#let [data (binary.create (.nat size))]
@@ -266,7 +266,7 @@
(|> path
java/io/File::new
java/io/File::length
- (:: io.Monad<Process> map .nat)))))
+ (:: (error.with-error io.monad) map .nat)))))
(def: last-modified
(..can-query
@@ -274,7 +274,7 @@
(|> path
java/io/File::new
(java/io/File::lastModified)
- (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))))
+ (:: (error.with-error io.monad) map (|>> duration.from-millis instant.absolute))))))
(def: can-execute?
(..can-query
@@ -286,20 +286,20 @@
(def: move
(..can-open
(function (move destination)
- (do io.Monad<IO>
+ (do io.monad
[outcome (java/io/File::renameTo (java/io/File::new destination)
(java/io/File::new path))]
(case outcome
(#error.Success #1)
- (wrap (#error.Success (File<IO> destination)))
+ (wrap (#error.Success (file destination)))
_
- (io.throw cannot-move [destination path]))))))
+ (io.io (ex.throw cannot-move [destination path])))))))
(def: modify
(..can-modify
(function (modify time-stamp)
- (do io.Monad<IO>
+ (do io.monad
[outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis)
(java/io/File::new path))]
(case outcome
@@ -307,21 +307,21 @@
(wrap (#error.Success []))
_
- (io.throw cannot-modify [time-stamp path]))))))
+ (io.io (ex.throw cannot-modify [time-stamp path])))))))
(def: delete
(..can-delete
(function (delete _)
(!delete path cannot-delete-file)))))
- (structure: (Directory<IO> path)
+ (structure: (directory path)
(-> Path (Directory IO))
(~~ (do-template [<name> <method> <capability>]
[(def: <name>
(..can-query
(function (<name> _)
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[?children (java/io/File::listFiles (java/io/File::new path))]
(case ?children
(#.Some children)
@@ -332,10 +332,10 @@
(:: @ join))
#.None
- (io.throw not-a-directory [path]))))))]
+ (io.io (ex.throw not-a-directory [path])))))))]
- [files java/io/File::isFile File<IO>]
- [directories java/io/File::isDirectory Directory<IO>]
+ [files java/io/File::isFile file]
+ [directories java/io/File::isDirectory directory]
))
(def: discard
@@ -343,12 +343,12 @@
(function (discard _)
(!delete path cannot-discard-directory)))))
- (structure: #export _ (System IO)
+ (structure: #export system (System IO)
(~~ (do-template [<name> <method> <capability> <exception>]
[(def: <name>
(..can-open
(function (<name> path)
- (do io.Monad<IO>
+ (do io.monad
[#let [file (java/io/File::new path)]
outcome (<method> file)]
(case outcome
@@ -358,10 +358,10 @@
_
(wrap (ex.throw <exception> [path])))))))]
- [file java/io/File::isFile ..File<IO> cannot-find-file]
- [create-file java/io/File::createNewFile ..File<IO> cannot-create-file]
- [directory java/io/File::isDirectory ..Directory<IO> cannot-find-directory]
- [create-directory java/io/File::mkdir ..Directory<IO> cannot-create-directory]
+ [file java/io/File::isFile ..file cannot-find-file]
+ [create-file java/io/File::createNewFile ..file cannot-create-file]
+ [directory java/io/File::isDirectory ..directory cannot-find-directory]
+ [create-directory java/io/File::mkdir ..directory cannot-create-directory]
))
(def: separator (java/io/File::separator))
diff --git a/stdlib/source/lux/world/net/http/cookie.lux b/stdlib/source/lux/world/net/http/cookie.lux
index d6b0c979d..315a9e12f 100644
--- a/stdlib/source/lux/world/net/http/cookie.lux
+++ b/stdlib/source/lux/world/net/http/cookie.lux
@@ -2,7 +2,7 @@
[lux #*
[control
[monad (#+ do)]
- ["p" parser ("p/." Monad<Parser>)]]
+ ["p" parser ("p/." monad)]]
[data
["." error (#+ Error)]
[text
@@ -65,7 +65,7 @@
(def: (cookie context)
(-> Context (Lexer Context))
- (do p.Monad<Parser>
+ (do p.monad
[key (l.slice (l.many! (l.none-of! "=")))
_ (l.this "=")
value (l.slice (l.many! (l.none-of! ";")))]
@@ -74,7 +74,7 @@
(def: (cookies context)
(-> Context (Lexer Context))
($_ p.either
- (do p.Monad<Parser>
+ (do p.monad
[context' (..cookie context)
_ (l.this "; ")]
(cookies context'))
diff --git a/stdlib/source/lux/world/net/http/mime.lux b/stdlib/source/lux/world/net/http/mime.lux
index 191a998ff..272fd1f60 100644
--- a/stdlib/source/lux/world/net/http/mime.lux
+++ b/stdlib/source/lux/world/net/http/mime.lux
@@ -1,8 +1,9 @@
(.module:
[lux #*
[data
- [text
- ["." encoding (#+ Char-Set)]]]
+ ["." text
+ format
+ ["." encoding (#+ Encoding)]]]
[type
abstract]])
@@ -91,8 +92,8 @@
[!7z "application/x-7z-compressed"]
)
-(def: #export (text char-set)
- (-> Char-Set MIME)
- (..mime (format "text/plain; charset=" text.double-quotes (encoding.name char-set) text.double-quotes)))
+(def: #export (text encoding)
+ (-> Encoding MIME)
+ (..mime (format "text/plain; charset=" text.double-quote (encoding.name encoding) text.double-quote)))
(def: #export utf-8 MIME (..text encoding.utf-8))
diff --git a/stdlib/source/lux/world/net/http/query.lux b/stdlib/source/lux/world/net/http/query.lux
index 7d736f46e..716910c4a 100644
--- a/stdlib/source/lux/world/net/http/query.lux
+++ b/stdlib/source/lux/world/net/http/query.lux
@@ -6,7 +6,8 @@
["p" parser]]
[data
["." error (#+ Error)]
- ["." number]
+ [number
+ ["." nat]]
["." text
format
["l" lexer (#+ Lexer)]]
@@ -19,7 +20,7 @@
(Lexer Text)
(p.rec
(function (_ component)
- (do p.Monad<Parser>
+ (do p.monad
[head (l.some (l.none-of "+%&;"))]
($_ p.either
(p.after (p.either l.end
@@ -32,7 +33,7 @@
(do @
[_ (l.this "%")
code (|> (l.exactly 2 l.hexadecimal)
- (p.codec number.Hex@Codec<Text,Nat>)
+ (p.codec nat.hex)
(:: @ map text.from-code))
tail component]
(wrap (format head code tail))))))))
@@ -40,10 +41,10 @@
(def: (form context)
(-> Context (Lexer Context))
($_ p.either
- (do p.Monad<Parser>
+ (do p.monad
[_ l.end]
(wrap context))
- (do p.Monad<Parser>
+ (do p.monad
[key (l.some (l.none-of "=&;"))
key (l.local key ..component)]
(p.either (do @
@@ -56,7 +57,7 @@
l.end)]
(form (dictionary.put key "" context)))))
## if invalid form data, just stop parsing...
- (:: p.Monad<Parser> wrap context)))
+ (:: p.monad wrap context)))
(def: #export (parameters raw)
(-> Text (Error Context))
diff --git a/stdlib/source/lux/world/net/http/request.lux b/stdlib/source/lux/world/net/http/request.lux
index 03c78fca8..6025571f5 100644
--- a/stdlib/source/lux/world/net/http/request.lux
+++ b/stdlib/source/lux/world/net/http/request.lux
@@ -19,7 +19,7 @@
["." json (#+ JSON)]
["." context (#+ Context Property)]]
[collection
- [list ("list/." Functor<List> Fold<List>)]
+ [list ("list/." functor fold)]
["." dictionary]]]
[world
["." binary (#+ Binary)]]]
@@ -31,10 +31,10 @@
(def: (merge inputs)
(-> (List Binary) Binary)
(let [[_ output] (error.assume
- (monad.fold error.Monad<Error>
+ (monad.fold error.monad
(function (_ input [offset output])
(let [amount (binary.size input)]
- (:: error.Functor<Error> map (|>> [(n/+ amount offset)])
+ (:: error.functor map (|>> [(n/+ amount offset)])
(binary.copy amount 0 input offset output))))
[0 (|> inputs
(list/map binary.size)
@@ -45,7 +45,7 @@
(def: (read-text-body body)
(-> Body (Promise (Error Text)))
- (do promise.Monad<Promise>
+ (do promise.monad
[blobs (frp.consume body)]
(wrap (encoding.from-utf8 (merge blobs)))))
@@ -55,11 +55,11 @@
(-> (-> (Dirty JSON) Server) Server)
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
- (do promise.Monad<Promise>
+ (do promise.monad
[?raw (read-text-body (get@ #//.body message))]
- (case (do error.Monad<Error>
+ (case (do error.monad
[raw ?raw]
- (:: json.Codec<Text,JSON> decode raw))
+ (:: json.codec decode raw))
(#error.Success content)
(server (integrity.taint content) request)
@@ -70,7 +70,7 @@
(-> (-> (Dirty Text) Server) Server)
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
- (do promise.Monad<Promise>
+ (do promise.monad
[?raw (read-text-body (get@ #//.body message))]
(case ?raw
(#error.Success content)
@@ -87,7 +87,7 @@
[uri query] (|> full
(text.split-with "?")
(maybe.default [full ""]))]
- (case (do error.Monad<Error>
+ (case (do error.monad
[query (//query.parameters query)
input (context.run query property)]
(wrap [(integrity.taint [identification protocol (set@ #//.uri uri resource) message])
@@ -102,9 +102,9 @@
(All [a] (-> (Property a) (-> (Dirty a) Server) Server))
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
- (do promise.Monad<Promise>
+ (do promise.monad
[?body (read-text-body (get@ #//.body message))]
- (case (do error.Monad<Error>
+ (case (do error.monad
[body ?body
form (//query.parameters body)]
(context.run form property))
@@ -118,7 +118,7 @@
(All [a] (-> (Property a) (-> (Dirty a) Server) Server))
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
- (case (do error.Monad<Error>
+ (case (do error.monad
[cookies (|> (get@ #//.headers message)
(dictionary.get "Cookie")
(maybe.default "")
diff --git a/stdlib/source/lux/world/net/http/response.lux b/stdlib/source/lux/world/net/http/response.lux
index cac7866af..ef394613f 100644
--- a/stdlib/source/lux/world/net/http/response.lux
+++ b/stdlib/source/lux/world/net/http/response.lux
@@ -2,7 +2,7 @@
[lux #*
[control
[concurrency
- ["." frp ("channel/." Monad<Channel>)]]]
+ ["." frp ("channel/." monad)]]]
[data
["." text
format
@@ -27,7 +27,7 @@
[status
{#//.headers (|> context.empty
(header.content-length 0)
- (header.content-type mime.text))
+ (header.content-type mime.utf-8))
#//.body body}])))
(def: #export (temporary-redirect to)
@@ -49,20 +49,18 @@
(def: #export bad-request
(-> Text Response)
- (|>> encoding.to-utf8 (content status.bad-request mime.text)))
+ (|>> encoding.to-utf8 (content status.bad-request mime.utf-8)))
(def: #export ok
(-> MIME Binary Response)
(content status.ok))
-(def: #export text
- (-> Text Response)
- (|>> encoding.to-utf8 (..ok mime.text)))
-
-(def: #export html
- (-> html.Document Response)
- (|>> html.html encoding.to-utf8 (..ok mime.html)))
+(do-template [<name> <type> <mime> <pre>]
+ [(def: #export <name>
+ (-> <type> Response)
+ (|>> <pre> encoding.to-utf8 (..ok <mime>)))]
-(def: #export css
- (-> CSS Response)
- (|>> encoding.to-utf8 (..ok mime.css)))
+ [text Text mime.utf-8 (<|)]
+ [html html.Document mime.html html.html]
+ [css CSS mime.css css.css]
+ )
diff --git a/stdlib/source/lux/world/net/http/route.lux b/stdlib/source/lux/world/net/http/route.lux
index 1825b2795..d7b674366 100644
--- a/stdlib/source/lux/world/net/http/route.lux
+++ b/stdlib/source/lux/world/net/http/route.lux
@@ -8,7 +8,7 @@
["." integrity]]]
[data
["." maybe]
- ["." text ("text/." Equivalence<Text>)]]]
+ ["." text ("text/." equivalence)]]]
["." // (#+ URI Server)
["//." status]
["//." response]])
@@ -76,7 +76,7 @@
(def: #export (or primary alternative)
(-> Server Server Server)
(function (_ request)
- (do promise.Monad<Promise>
+ (do promise.monad
[response (primary request)
#let [[status message] response]]
(if (n/= //status.not-found status)
diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux
index de1d9ffef..bc8468c6b 100644
--- a/stdlib/source/lux/world/net/tcp.jvm.lux
+++ b/stdlib/source/lux/world/net/tcp.jvm.lux
@@ -64,39 +64,39 @@
(`` (for {(~~ (static host.jvm))
(as-is (def: (tcp socket)
(-> Socket (Error (TCP IO)))
- (do error.Monad<Error>
+ (do error.monad
[input (Socket::getInputStream socket)
output (Socket::getOutputStream socket)]
(wrap (: (TCP IO)
(structure (def: (read size)
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[#let [data (binary.create size)]
bytes-read (InputStream::read data +0 (.int size) input)]
(wrap [(.nat bytes-read)
(integrity.taint data)])))
(def: (write data)
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[_ (OutputStream::write data +0 (.int (binary.size data))
output)]
(Flushable::flush output)))
(def: (close _)
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[_ (AutoCloseable::close input)
_ (AutoCloseable::close output)]
(AutoCloseable::close socket))))))))
(def: #export (client address port)
(-> //.Address //.Port (IO (Error (TCP IO))))
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[socket (Socket::new address (.int port))]
(io.io (tcp socket))))
(def: #export (server port)
(-> //.Port (IO (Error [(Promise Any)
(frp.Channel (TCP IO))])))
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[server (ServerSocket::new (.int port))
#let [close-signal (: (Promise Any)
(promise #.None))
@@ -108,8 +108,8 @@
_ (: (Promise Any)
(promise.future
(loop [_ []]
- (do io.Monad<IO>
- [?client (do io.Monad<Process>
+ (do io.monad
+ [?client (do (error.with-error io.monad)
[socket (ServerSocket::accept server)]
(io.io (tcp socket)))]
(case ?client
diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux
index c474c5c79..231593de0 100644
--- a/stdlib/source/lux/world/net/udp.jvm.lux
+++ b/stdlib/source/lux/world/net/udp.jvm.lux
@@ -75,7 +75,7 @@
(`` (for {(~~ (static host.jvm))
(as-is (def: (resolve address)
(-> //.Address (IO (Error InetAddress)))
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[addresses (InetAddress::getAllByName address)]
(: (IO (Error InetAddress))
(case (array.size addresses)
@@ -88,7 +88,7 @@
(structure (def: (read size)
(let [data (binary.create size)
packet (DatagramPacket::new|receive data +0 (.int size))]
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[_ (DatagramSocket::receive packet socket)
#let [bytes-read (.nat (DatagramPacket::getLength packet))]]
(wrap [bytes-read
@@ -97,7 +97,7 @@
(integrity.taint data)]))))
(def: (write [location data])
- (do io.Monad<Process>
+ (do (error.with-error io.monad)
[address (resolve (get@ #//.address location))]
(DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
socket)))
@@ -108,11 +108,11 @@
(def: #export client
(IO (Error (UDP IO)))
(|> (DatagramSocket::new|client)
- (:: io.Monad<Process> map udp)))
+ (:: (error.with-error io.monad) map udp)))
(def: #export server
(-> //.Port (IO (Error (UDP IO))))
(|>> .int
DatagramSocket::new|server
- (:: io.Monad<Process> map udp)))
+ (:: (error.with-error io.monad) map udp)))
)}))