aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux148
-rw-r--r--stdlib/source/lux/control/parser/binary.lux2
-rw-r--r--stdlib/source/lux/control/parser/tree.lux29
-rw-r--r--stdlib/source/lux/control/pipe.lux3
-rw-r--r--stdlib/source/lux/control/writer.lux10
-rw-r--r--stdlib/source/lux/data/collection/tree.lux6
-rw-r--r--stdlib/source/lux/data/collection/tree/zipper.lux412
-rw-r--r--stdlib/source/lux/data/format/binary.lux54
-rw-r--r--stdlib/source/lux/data/format/json.lux12
-rw-r--r--stdlib/source/lux/data/format/tar.lux4
-rw-r--r--stdlib/source/lux/data/number/frac.lux405
-rw-r--r--stdlib/source/lux/debug.lux4
-rw-r--r--stdlib/source/lux/extension.lux14
-rw-r--r--stdlib/source/lux/host.jvm.lux4
-rw-r--r--stdlib/source/lux/host.old.lux32
-rw-r--r--stdlib/source/lux/locale.lux6
-rw-r--r--stdlib/source/lux/macro/code.lux60
-rw-r--r--stdlib/source/lux/macro/poly.lux30
-rw-r--r--stdlib/source/lux/macro/syntax.lux14
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux14
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux10
-rw-r--r--stdlib/source/lux/macro/template.lux32
-rw-r--r--stdlib/source/lux/math/logic/continuous.lux6
-rw-r--r--stdlib/source/lux/math/modular.lux18
-rw-r--r--stdlib/source/lux/math/random.lux50
-rw-r--r--stdlib/source/lux/meta.lux92
-rw-r--r--stdlib/source/lux/target/common-lisp.lux38
-rw-r--r--stdlib/source/lux/target/js.lux34
-rw-r--r--stdlib/source/lux/target/jvm/attribute.lux4
-rw-r--r--stdlib/source/lux/target/jvm/attribute/code.lux10
-rw-r--r--stdlib/source/lux/target/jvm/bytecode.lux24
-rw-r--r--stdlib/source/lux/target/jvm/bytecode/environment/limit.lux4
-rw-r--r--stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux18
-rw-r--r--stdlib/source/lux/target/jvm/class.lux4
-rw-r--r--stdlib/source/lux/target/jvm/constant.lux12
-rw-r--r--stdlib/source/lux/target/jvm/constant/pool.lux12
-rw-r--r--stdlib/source/lux/target/jvm/field.lux4
-rw-r--r--stdlib/source/lux/target/jvm/method.lux4
-rw-r--r--stdlib/source/lux/target/jvm/reflection.lux46
-rw-r--r--stdlib/source/lux/target/jvm/type.lux12
-rw-r--r--stdlib/source/lux/target/jvm/type/descriptor.lux8
-rw-r--r--stdlib/source/lux/target/jvm/type/lux.lux56
-rw-r--r--stdlib/source/lux/target/jvm/type/parser.lux10
-rw-r--r--stdlib/source/lux/target/jvm/type/reflection.lux4
-rw-r--r--stdlib/source/lux/target/jvm/type/signature.lux16
-rw-r--r--stdlib/source/lux/target/lua.lux24
-rw-r--r--stdlib/source/lux/target/php.lux28
-rw-r--r--stdlib/source/lux/target/python.lux32
-rw-r--r--stdlib/source/lux/target/ruby.lux32
-rw-r--r--stdlib/source/lux/target/scheme.lux22
-rw-r--r--stdlib/source/lux/test.lux74
-rw-r--r--stdlib/source/lux/time/day.lux4
-rw-r--r--stdlib/source/lux/time/month.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux58
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/analysis.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/case.lux38
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux62
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux72
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux46
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux36
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux46
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux22
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux28
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux28
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/synthesis.lux86
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/artifact.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/reference.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/reference/variable.lux10
-rw-r--r--stdlib/source/lux/type.lux68
-rw-r--r--stdlib/source/lux/type/check.lux60
-rw-r--r--stdlib/source/poly/lux/abstract/equivalence.lux34
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux162
-rw-r--r--stdlib/source/program/aedifex.lux48
-rw-r--r--stdlib/source/program/aedifex/cache.lux25
-rw-r--r--stdlib/source/program/aedifex/command/build.lux9
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux3
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux37
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux139
-rw-r--r--stdlib/source/program/aedifex/hash.lux10
-rw-r--r--stdlib/source/program/aedifex/package.lux32
-rw-r--r--stdlib/source/program/aedifex/profile.lux4
-rw-r--r--stdlib/source/program/aedifex/repository.lux43
-rw-r--r--stdlib/source/program/scriptum.lux46
-rw-r--r--stdlib/source/spec/lux/world/shell.lux4
-rw-r--r--stdlib/source/test/lux/control/parser/tree.lux92
-rw-r--r--stdlib/source/test/lux/data/collection/tree/zipper.lux335
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux24
-rw-r--r--stdlib/source/test/lux/type/check.lux4
111 files changed, 2078 insertions, 1986 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 3e373be35..c65384392 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -3096,8 +3096,8 @@
"(macro: #export (name-of tokens)" ..new-line
" (case tokens" ..new-line
" (^template [<tag>]" ..new-line
- " (^ (list [_ (<tag> [prefix name])]))" ..new-line
- " (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))" ..new-line
+ " [(^ (list [_ (<tag> [prefix name])]))" ..new-line
+ " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new-line
" ([#Identifier] [#Tag])"
__paragraph
" _" ..new-line
@@ -4773,23 +4773,23 @@
" (#.Primitive name (list@map (beta-reduce env) params))"
__paragraph
" (^template [<tag>]" ..new-line
- " (<tag> left right)" ..new-line
- " (<tag> (beta-reduce env left) (beta-reduce env right)))" ..new-line
+ " [(<tag> left right)" ..new-line
+ " (<tag> (beta-reduce env left) (beta-reduce env right))])" ..new-line
" ([#.Sum] [#.Product])"
__paragraph
" (^template [<tag>]" ..new-line
- " (<tag> left right)" ..new-line
- " (<tag> (beta-reduce env left) (beta-reduce env right)))" ..new-line
+ " [(<tag> left right)" ..new-line
+ " (<tag> (beta-reduce env left) (beta-reduce env right))])" ..new-line
" ([#.Function] [#.Apply])"
__paragraph
" (^template [<tag>]" ..new-line
- " (<tag> old-env def)" ..new-line
+ " [(<tag> old-env def)" ..new-line
" (case old-env" ..new-line
" #.Nil" ..new-line
" (<tag> env def)"
__paragraph
" _" ..new-line
- " type))" ..new-line
+ " type)])" ..new-line
" ([#.UnivQ] [#.ExQ])"
__paragraph
" (#.Parameter idx)" ..new-line
@@ -4799,7 +4799,8 @@
" type" ..new-line
" ))"))}
(case tokens
- (^ (list& [_ (#Form (list& [_ (#Tuple bindings)] templates))]
+ (^ (list& [_ (#Form (list [_ (#Tuple bindings)]
+ [_ (#Tuple templates)]))]
[_ (#Form data)]
branches))
(case (: (Maybe (List Code))
@@ -4829,8 +4830,8 @@
(-> Code Nat)
(case code
(^template [<tag>]
- [[_ _ column] (<tag> _)]
- column)
+ [[[_ _ column] (<tag> _)]
+ column])
([#Bit]
[#Nat]
[#Int]
@@ -4841,8 +4842,8 @@
[#Tag])
(^template [<tag>]
- [[_ _ column] (<tag> parts)]
- (list@fold n/min column (list@map find-baseline-column parts)))
+ [[[_ _ column] (<tag> parts)]
+ (list@fold n/min column (list@map find-baseline-column parts))])
([#Form]
[#Tuple])
@@ -4913,11 +4914,11 @@
(-> Location Nat Code [Location Text])
(case example
(^template [<tag> <encode>]
- [new-location (<tag> value)]
- (let [as-text (<encode> value)]
- [(update-location new-location as-text)
- (text@compose (location-padding baseline prev-location new-location)
- as-text)]))
+ [[new-location (<tag> value)]
+ (let [as-text (<encode> value)]
+ [(update-location new-location as-text)
+ (text@compose (location-padding baseline prev-location new-location)
+ as-text)])])
([#Bit bit@encode]
[#Nat nat@encode]
[#Int int@encode]
@@ -4927,17 +4928,17 @@
[#Tag tag@encode])
(^template [<tag> <open> <close> <prep>]
- [group-location (<tag> parts)]
- (let [[group-location' parts-text] (list@fold (function (_ part [last-location text-accum])
- (let [[part-location part-text] (doc-example->Text last-location baseline part)]
- [part-location (text@compose text-accum part-text)]))
- [(delim-update-location group-location) ""]
- (<prep> parts))]
- [(delim-update-location group-location')
- ($_ text@compose (location-padding baseline prev-location group-location)
- <open>
- parts-text
- <close>)]))
+ [[group-location (<tag> parts)]
+ (let [[group-location' parts-text] (list@fold (function (_ part [last-location text-accum])
+ (let [[part-location part-text] (doc-example->Text last-location baseline part)]
+ [part-location (text@compose text-accum part-text)]))
+ [(delim-update-location group-location) ""]
+ (<prep> parts))]
+ [(delim-update-location group-location')
+ ($_ text@compose (location-padding baseline prev-location group-location)
+ <open>
+ parts-text
+ <close>)])])
([#Form "(" ")" ..function@identity]
[#Tuple "[" "]" ..function@identity]
[#Record "{" "}" rejoin-all-pairs])
@@ -5004,21 +5005,21 @@
(` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list@map type-to-code params)))))
(^template [<tag>]
- (<tag> left right)
- (` (<tag> (~ (type-to-code left)) (~ (type-to-code right)))))
+ [(<tag> left right)
+ (` (<tag> (~ (type-to-code left)) (~ (type-to-code right))))])
([#.Sum] [#.Product]
[#.Function]
[#.Apply])
(^template [<tag>]
- (<tag> id)
- (` (<tag> (~ (nat$ id)))))
+ [(<tag> id)
+ (` (<tag> (~ (nat$ id))))])
([#.Parameter] [#.Var] [#.Ex])
(^template [<tag>]
- (<tag> env type)
- (let [env' (untemplate-list (list@map type-to-code env))]
- (` (<tag> (~ env') (~ (type-to-code type))))))
+ [(<tag> env type)
+ (let [env' (untemplate-list (list@map type-to-code env))]
+ (` (<tag> (~ env') (~ (type-to-code type)))))])
([#.UnivQ] [#.ExQ])
(#Named [module name] anonymous)
@@ -5077,7 +5078,8 @@
(function (_ _) (gensym "")))
inits)]
(return (list (` (let [(~+ (interleave aliases inits))]
- (.loop [(~+ (interleave vars aliases))]
+ (.loop (~ name)
+ [(~+ (interleave vars aliases))]
(~ body)))))))))
#.None
@@ -5137,10 +5139,10 @@
(#Some (list target)))
(^template [<tag>]
- [location (<tag> elems)]
- (do maybe-monad
- [placements (monad@map maybe-monad (place-tokens label tokens) elems)]
- (wrap (list [location (<tag> (list@join placements))]))))
+ [[location (<tag> elems)]
+ (do maybe-monad
+ [placements (monad@map maybe-monad (place-tokens label tokens) elems)]
+ (wrap (list [location (<tag> (list@join placements))])))])
([#Tuple]
[#Form])
@@ -5215,8 +5217,8 @@
(-> Type Type)
(case type
(^template [<name>]
- (#Named ["lux" <name>] _)
- type)
+ [(#Named ["lux" <name>] _)
+ type])
(["Bit"]
["Nat"]
["Int"]
@@ -5237,8 +5239,8 @@
#let [[type value] type+value]]
(case (flatten-alias type)
(^template [<name> <type> <wrapper>]
- (#Named ["lux" <name>] _)
- (wrap (<wrapper> (:coerce <type> value))))
+ [(#Named ["lux" <name>] _)
+ (wrap (<wrapper> (:coerce <type> value)))])
(["Bit" Bit bit$]
["Nat" Nat nat$]
["Int" Int int$]
@@ -5260,10 +5262,10 @@
(anti-quote-def [def-prefix def-name]))
(^template [<tag>]
- [meta (<tag> parts)]
- (do meta-monad
- [=parts (monad@map meta-monad anti-quote parts)]
- (wrap [meta (<tag> =parts)])))
+ [[meta (<tag> parts)]
+ (do meta-monad
+ [=parts (monad@map meta-monad anti-quote parts)]
+ (wrap [meta (<tag> =parts)]))])
([#Form]
[#Tuple])
@@ -5401,8 +5403,8 @@
["lux" "doc"])}
(case tokens
(^template [<tag>]
- (^ (list [_ (<tag> [prefix name])]))
- (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))
+ [(^ (list [_ (<tag> [prefix name])]))
+ (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])
([#Identifier] [#Tag])
_
@@ -5733,11 +5735,11 @@
(wrap [(list [g!expansion expansion]) g!expansion]))
(^template [<tag>]
- [ann (<tag> 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))]])))
+ [[ann (<tag> 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)]
@@ -5789,10 +5791,10 @@
(-> Code (Meta Code))
(case pattern
(^template [<tag> <name> <gen>]
- [_ (<tag> value)]
- (do meta-monad
- [g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))))
+ [[_ (<tag> value)]
+ (do meta-monad
+ [g!meta (gensym "g!meta")]
+ (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))])))])
([#Bit "Bit" bit$]
[#Nat "Nat" nat$]
[#Int "Int" int$]
@@ -5821,20 +5823,20 @@
(fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.")
(^template [<tag>]
- [_ (<tag> elems)]
- (case (list@reverse elems)
- (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
- 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)))])))
+ [[_ (<tag> elems)]
+ (case (list@reverse elems)
+ (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
+ 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 meta-monad
- [=elems (monad@map meta-monad untemplate-pattern elems)
- g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =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])
))
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux
index 30d99716c..4ed003882 100644
--- a/stdlib/source/lux/control/parser/binary.lux
+++ b/stdlib/source/lux/control/parser/binary.lux
@@ -107,7 +107,7 @@
..bits/8)]
(`` (case flag
(^template [<number> <tag> <parser>]
- <number> (:: ! map (|>> <tag>) <parser>))
+ [<number> (:: ! map (|>> <tag>) <parser>)])
((~~ (template.splice <case>+)))
_ (//.lift (exception.throw ..invalid-tag [(~~ (template.count <case>+)) flag]))))))
diff --git a/stdlib/source/lux/control/parser/tree.lux b/stdlib/source/lux/control/parser/tree.lux
index 5ca642b75..ac824638a 100644
--- a/stdlib/source/lux/control/parser/tree.lux
+++ b/stdlib/source/lux/control/parser/tree.lux
@@ -1,5 +1,7 @@
(.module:
[lux #*
+ [abstract
+ [monad (#+ do)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]]
@@ -14,12 +16,9 @@
(def: #export (run' parser zipper)
(All [t a] (-> (Parser t a) (Zipper t) (Try a)))
- (case (//.run parser zipper)
- (#try.Success [zipper output])
- (#try.Success output)
-
- (#try.Failure error)
- (#try.Failure error)))
+ (do try.monad
+ [[zipper output] (//.run parser zipper)]
+ (wrap output)))
(def: #export (run parser tree)
(All [t a] (-> (Parser t a) (Tree t) (Try a)))
@@ -36,19 +35,25 @@
[(def: #export <name>
(All [t] (Parser t []))
(function (_ zipper)
- (let [next (<direction> zipper)]
- (if (is? zipper next)
- (exception.throw cannot-move-further [])
- (#try.Success [next []])))))]
+ (case (<direction> zipper)
+ #.None
+ (exception.throw ..cannot-move-further [])
+
+ (#.Some next)
+ (#try.Success [next []]))))]
[down zipper.down]
[up zipper.up]
+
[right zipper.right]
- [left zipper.left]
[rightmost zipper.rightmost]
+
+ [left zipper.left]
[leftmost zipper.leftmost]
+
[next zipper.next]
- [prev zipper.prev]
[end zipper.end]
+
+ [previous zipper.previous]
[start zipper.start]
)
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index fb9a8c6f7..e852efca1 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -7,6 +7,7 @@
["p" parser
["s" code (#+ Parser)]]]
[data
+ ["." identity]
[number
["n" nat]
["i" int]]
@@ -94,7 +95,7 @@
{#.doc (doc "Monadic pipes."
"Each steps in the monadic computation is a pipe and must be given inside a tuple."
(|> +5
- (do> monad
+ (do> identity.monad
[(i.* +3)]
[(i.+ +4)]
[inc])))}
diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux
index e92748aa5..db9df51c3 100644
--- a/stdlib/source/lux/control/writer.lux
+++ b/stdlib/source/lux/control/writer.lux
@@ -3,8 +3,8 @@
["@" target]
[abstract
monoid
- ["." functor (#+ Functor)]
[apply (#+ Apply)]
+ ["." functor (#+ Functor)]
["." monad (#+ Monad do)]]])
(type: #export (Writer l a)
@@ -42,8 +42,8 @@
(def: &functor ..functor)
- (def: (wrap x)
- [(:: monoid identity) x])
+ (def: wrap
+ (|>> [(:: monoid identity)]))
(def: (join mma)
(let [[log1 [log2 a]] mma]
@@ -52,7 +52,9 @@
(structure: #export (with monoid monad)
(All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a))))))
- (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
+ (def: &functor
+ (functor.compose (get@ #monad.&functor monad)
+ ..functor))
(def: wrap
(let [writer (..monad monoid)]
diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux
index 375732b1b..16c394525 100644
--- a/stdlib/source/lux/data/collection/tree.lux
+++ b/stdlib/source/lux/data/collection/tree.lux
@@ -59,12 +59,12 @@
(` {#value (~ value)
#children (list (~+ (list@map recur children)))})))))))
-(structure: #export (equivalence Equivalence<a>)
+(structure: #export (equivalence super)
(All [a] (-> (Equivalence a) (Equivalence (Tree a))))
(def: (= tx ty)
- (and (:: Equivalence<a> = (get@ #value tx) (get@ #value ty))
- (:: (list.equivalence (equivalence Equivalence<a>)) = (get@ #children tx) (get@ #children ty)))))
+ (and (:: super = (get@ #value tx) (get@ #value ty))
+ (:: (list.equivalence (equivalence super)) = (get@ #children tx) (get@ #children ty)))))
(structure: #export functor
(Functor Tree)
diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux
index a0b9eca9c..cfa70718f 100644
--- a/stdlib/source/lux/data/collection/tree/zipper.lux
+++ b/stdlib/source/lux/data/collection/tree/zipper.lux
@@ -1,281 +1,303 @@
(.module:
[lux #*
["@" target]
- [type (#+ :share)]
[abstract
functor
comonad
- [equivalence (#+ Equivalence)]]
+ [monad (#+ do)]
+ ["." equivalence (#+ Equivalence)]]
[data
["." maybe ("#@." monad)]
+ [text
+ ["%" format (#+ format)]]
[collection
["." list ("#@." functor fold monoid)]]]]
["." // (#+ Tree) ("#@." functor)])
-(type: #export (Zipper a)
- {#.doc "Tree zippers, for easy navigation and editing over trees."}
- {#parent (Maybe (Zipper a))
+(type: (Family Zipper a)
+ {#parent (Zipper a)
#lefts (List (Tree a))
- #rights (List (Tree a))
+ #rights (List (Tree a))})
+
+(type: #export (Zipper a)
+ {#.doc "Tree zippers, for easy navigation and editing of trees."}
+ {#family (Maybe (Family Zipper a))
#node (Tree a)})
-(structure: #export (equivalence ,equivalence)
+(structure: #export (equivalence super)
(All [a]
(-> (Equivalence a)
(Equivalence (Zipper a))))
+
(def: (= reference sample)
- (and (:: (//.equivalence ,equivalence) =
- (get@ #node reference)
- (get@ #node sample))
- (:: (list.equivalence (//.equivalence ,equivalence)) =
- (get@ #lefts reference)
- (get@ #lefts sample))
- (:: (list.equivalence (//.equivalence ,equivalence)) =
- (get@ #rights reference)
- (get@ #rights sample))
- (:: (maybe.equivalence (equivalence ,equivalence)) =
- (get@ #parent reference)
- (get@ #parent sample))
- )))
+ (let [== ($_ equivalence.product
+ (maybe.equivalence
+ ($_ equivalence.product
+ =
+ (list.equivalence (//.equivalence super))
+ (list.equivalence (//.equivalence super))))
+ (//.equivalence super))]
+ (== reference sample))))
(def: #export (zip tree)
(All [a] (-> (Tree a) (Zipper a)))
- {#parent #.None
- #lefts #.Nil
- #rights #.Nil
+ {#family #.None
#node tree})
-(def: #export (unzip zipper)
+(def: #export unzip
(All [a] (-> (Zipper a) (Tree a)))
- (get@ #node zipper))
+ (get@ #node))
-(def: #export (value zipper)
+(def: #export value
(All [a] (-> (Zipper a) a))
- (|> zipper (get@ [#node #//.value])))
+ (get@ [#node #//.value]))
+
+(def: #export set
+ (All [a] (-> a (Zipper a) (Zipper a)))
+ (set@ [#node #//.value]))
+
+(def: #export update
+ (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
+ (update@ [#node #//.value]))
-(def: #export (children zipper)
+(def: children
(All [a] (-> (Zipper a) (List (Tree a))))
- (|> zipper (get@ [#node #//.children])))
+ (get@ [#node #//.children]))
-(def: #export (branch? zipper)
+(def: #export leaf?
(All [a] (-> (Zipper a) Bit))
- (|> zipper children list.empty? not))
+ (|>> ..children list.empty?))
-(def: #export (leaf? zipper)
+(def: #export branch?
(All [a] (-> (Zipper a) Bit))
- (|> zipper branch? not))
+ (|>> ..leaf? not))
(def: #export (start? zipper)
(All [a] (-> (Zipper a) Bit))
- (case (get@ #parent zipper)
+ (case (get@ #family zipper)
#.None
- #1
+ true
_
- #0))
+ false))
(def: #export (down zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (case (children zipper)
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (case (..children zipper)
#.Nil
- zipper
+ #.None
(#.Cons head tail)
- {#parent (#.Some zipper)
- #lefts #.Nil
- #rights tail
- #node head}))
+ (#.Some {#family (#.Some {#parent (set@ [#node #//.children] (list) zipper)
+ #lefts #.Nil
+ #rights tail})
+ #node head})))
(def: #export (up zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (case (get@ #parent zipper)
- #.None
- zipper
-
- (#.Some parent)
- (for {@.old
- (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0)))
- (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper))
- (#.Cons (get@ #node zipper)
- (get@ #rights zipper)))))
- parent)}
- (set@ [#node #//.children]
- (list@compose (list.reverse (get@ #lefts zipper))
- (#.Cons (get@ #node zipper)
- (get@ #rights zipper)))
- parent))))
-
-(def: #export (start zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (let [ancestor (..up zipper)]
- (if (is? zipper ancestor)
- zipper
- (start ancestor))))
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (do maybe.monad
+ [family (get@ #family zipper)]
+ (wrap (let [(^slots [#parent #lefts #rights]) family]
+ (for {@.old
+ (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0)))
+ (set@ #//.children (list@compose (list.reverse lefts)
+ (#.Cons (get@ #node zipper)
+ rights))))
+ parent)}
+ (set@ [#node #//.children]
+ (list@compose (list.reverse lefts)
+ (#.Cons (get@ #node zipper)
+ rights))
+ parent))))))
(template [<one> <all> <side> <op-side>]
[(def: #export (<one> zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (case (get@ <side> zipper)
- #.Nil
- zipper
-
- (#.Cons next side')
- (|> zipper
- (update@ <op-side> (function (_ op-side)
- (#.Cons (get@ #node zipper) op-side)))
- (set@ <side> side')
- (set@ #node next))))
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (case (get@ #family zipper)
+ #.None
+ #.None
+
+ (#.Some family)
+ (case (get@ <side> family)
+ #.Nil
+ #.None
+
+ (#.Cons next side')
+ (#.Some {#family (|> family
+ (set@ <side> side')
+ (update@ <op-side> (|>> (#.Cons (get@ #node zipper))))
+ #.Some)
+ #node next}))))
(def: #export (<all> zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (case (list.reverse (get@ <side> zipper))
- #.Nil
- zipper
-
- (#.Cons last prevs)
- (|> zipper
- (set@ <side> #.Nil)
- (set@ <op-side> (|> (get@ <op-side> zipper)
- (#.Cons (get@ #node zipper))
- (list@compose prevs)))
- (set@ #node last))))]
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (case (get@ #family zipper)
+ #.None
+ #.None
+
+ (#.Some family)
+ (case (list.reverse (get@ <side> family))
+ #.Nil
+ #.None
+
+ (#.Cons last prevs)
+ (#.Some {#family (#.Some (|> family
+ (set@ <side> #.Nil)
+ (update@ <op-side> (|>> (#.Cons (get@ #node zipper))
+ (list@compose prevs)))))
+ #node last}))))]
[right rightmost #rights #lefts]
[left leftmost #lefts #rights]
)
(def: #export (next zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (let [forward (..down zipper)]
- (if (is? zipper forward)
- (loop [zipper zipper]
- (let [jump (..right zipper)]
- (if (is? zipper jump)
- (let [backward (..up zipper)]
- (if (is? zipper backward)
- zipper
- (recur backward)))
- jump)))
- forward)))
-
-(def: #export (end zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (case (get@ #rights zipper)
- #.Nil
- (case (get@ [#node #//.children] zipper)
- #.Nil
- zipper
-
- (#.Cons _)
- (end (..down zipper)))
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (case (..down zipper)
+ (#.Some forward)
+ (#.Some forward)
- (#.Cons _)
- (end (..rightmost zipper))))
-
-(def: #export (end? zipper)
- (All [a] (-> (Zipper a) Bit))
- (is? zipper (end zipper)))
+ #.None
+ (loop [@ zipper]
+ (case (..right @)
+ (#.Some forward)
+ (#.Some forward)
+
+ #.None
+ (do maybe.monad
+ [@ (..up @)]
+ (recur @))))))
-(def: #export (prev zipper)
+(def: (bottom zipper)
(All [a] (-> (Zipper a) (Zipper a)))
- (let [forward (..left zipper)]
- (if (is? zipper forward)
- (..up zipper)
- (case (get@ [#node #//.children] forward)
- #.Nil
- forward
-
- (#.Cons _)
- (..end (..down forward))))))
+ (case (..right zipper)
+ (#.Some forward)
+ (bottom forward)
-(def: #export (set value zipper)
- (All [a] (-> a (Zipper a) (Zipper a)))
- (set@ [#node #//.value] value zipper))
+ #.None
+ (case (..down zipper)
+ (#.Some forward)
+ (bottom forward)
-(def: #export (update f zipper)
- (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
- (update@ [#node #//.value] f zipper))
+ #.None
+ zipper)))
+
+(def: #export (previous zipper)
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (case (..left zipper)
+ #.None
+ (..up zipper)
+
+ (#.Some backward)
+ (#.Some (case (..down backward)
+ (#.Some then)
+ (..bottom then)
+
+ #.None
+ backward))))
+
+(template [<name> <move>]
+ [(def: #export (<name> zipper)
+ (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+ (case (<move> zipper)
+ #.None
+ #.None
-(def: #export (prepend-child value zipper)
+ (#.Some @)
+ (loop [@ @]
+ (case (<move> @)
+ #.None
+ (#.Some @)
+
+ (#.Some @)
+ (recur @)))))]
+
+ [end ..next]
+ [start ..previous]
+ )
+
+(def: #export (end? zipper)
+ (All [a] (-> (Zipper a) Bit))
+ (case (..end zipper)
+ #.None
+ true
+
+ (#.Some _)
+ false))
+
+(def: #export (interpose value zipper)
(All [a] (-> a (Zipper a) (Zipper a)))
(update@ [#node #//.children]
- (function (_ children)
- (list& (for {@.old
- (: (Tree ($ 0))
- (//.tree value {}))}
- (//.tree value {}))
- children))
+ (|>> (//.branch value) list)
zipper))
-(def: #export (append-child value zipper)
+(def: #export (adopt value zipper)
(All [a] (-> a (Zipper a) (Zipper a)))
(update@ [#node #//.children]
- (function (_ children)
- (list@compose children
- (list (for {@.old
- (: (Tree ($ 0))
- (//.tree value {}))}
- (//.tree value {})))))
+ (|>> (#.Cons (//.leaf value)))
zipper))
(def: #export (remove zipper)
(All [a] (-> (Zipper a) (Maybe (Zipper a))))
- (case (get@ #lefts zipper)
- #.Nil
- (case (get@ #parent zipper)
- #.None
- #.None
-
- (#.Some next)
- (#.Some (|> next
- (update@ [#node #//.children] (|>> list.tail (maybe.default (list)))))))
+ (do maybe.monad
+ [family (get@ #family zipper)]
+ (case (get@ #lefts family)
+ #.Nil
+ (wrap (set@ [#node #//.children]
+ (get@ #rights family)
+ (get@ #parent family)))
- (#.Cons next side)
- (#.Some (|> zipper
- (set@ #lefts side)
- (set@ #node next)))))
+ (#.Cons next side)
+ (wrap (|> zipper
+ (set@ #family (|> family
+ (set@ #lefts side)
+ #.Some))
+ (set@ #node next))))))
(template [<name> <side>]
[(def: #export (<name> value zipper)
(All [a] (-> a (Zipper a) (Maybe (Zipper a))))
- (case (get@ #parent zipper)
+ (case (get@ #family zipper)
#.None
#.None
- _
- (#.Some (|> zipper
- (update@ <side> (function (_ side)
- (#.Cons (for {@.old
- (: (Tree ($ 0))
- (//.tree value {}))}
- (//.tree value {}))
- side)))))))]
+ (#.Some family)
+ (#.Some (set@ #family
+ (#.Some (update@ <side> (|>> (#.Cons (//.leaf value))) family))
+ zipper))))]
[insert-left #lefts]
[insert-right #rights]
)
-(structure: #export functor (Functor Zipper)
- (def: (map f fa)
- {#parent (|> fa (get@ #parent) (maybe@map (map f)))
- #lefts (|> fa (get@ #lefts) (list@map (//@map f)))
- #rights (|> fa (get@ #rights) (list@map (//@map f)))
- #node (//@map f (get@ #node fa))}))
-
-(for {@.old
- (as-is)}
- (structure: #export comonad (CoMonad Zipper)
- (def: &functor ..functor)
-
- (def: unwrap (get@ [#node #//.value]))
-
- (def: (split [parent lefts rights node])
- (let [tree-splitter (: (All [a] (-> (Tree a) (Tree (Zipper a))))
- (function (tree-splitter tree)
- {#//.value (zip tree)
- #//.children (list@map tree-splitter
- (get@ #//.children tree))}))]
- {#parent (maybe@map split parent)
- #lefts (list@map tree-splitter lefts)
- #rights (list@map tree-splitter rights)
- #node (tree-splitter node)}))))
+(structure: #export functor
+ (Functor Zipper)
+
+ (def: (map f (^slots [#family #node]))
+ {#family (maybe@map (function (_ (^slots [#parent #lefts #rights]))
+ {#parent (map f parent)
+ #lefts (list@map (//@map f) lefts)
+ #rights (list@map (//@map f) rights)})
+ family)
+ #node (//@map f node)}))
+
+(structure: #export comonad
+ (CoMonad Zipper)
+
+ (def: &functor ..functor)
+
+ (def: unwrap (get@ [#node #//.value]))
+
+ (def: (split (^slots [#family #node]))
+ (let [tree-splitter (: (All [a] (-> (Tree a) (Tree (Zipper a))))
+ (function (tree-splitter tree)
+ {#//.value (..zip tree)
+ #//.children (|> tree
+ (get@ #//.children)
+ (list@map tree-splitter))}))]
+ {#family (maybe@map (function (_ (^slots [#parent #lefts #rights]))
+ {#parent (split parent)
+ #lefts (list@map tree-splitter lefts)
+ #rights (list@map tree-splitter rights)})
+ family)
+ #node (tree-splitter node)})))
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index f629f8b52..111d6abe8 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -84,15 +84,15 @@
(function (_ altV)
(case altV
(^template [<number> <tag> <writer>]
- (<tag> caseV)
- (let [[caseS caseT] (<writer> caseV)]
- [(.inc caseS)
- (function (_ [offset binary])
- (|> binary
- (binary.write/8 offset <number>)
- try.assume
- [(.inc offset)]
- caseT))]))
+ [(<tag> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.inc caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8 offset <number>)
+ try.assume
+ [(.inc offset)]
+ caseT))])])
([0 #.Left left]
[1 #.Right right])
)))
@@ -232,15 +232,15 @@
(function (_ altV)
(case altV
(^template [<number> <tag> <writer>]
- (<tag> caseV)
- (let [[caseS caseT] (<writer> caseV)]
- [(.inc caseS)
- (function (_ [offset binary])
- (|> binary
- (binary.write/8 offset <number>)
- try.assume
- [(.inc offset)]
- caseT))]))
+ [(<tag> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.inc caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8 offset <number>)
+ try.assume
+ [(.inc offset)]
+ caseT))])])
([0 #.Primitive (..and ..text (..list recur))]
[1 #.Sum pair]
[2 #.Product pair]
@@ -267,15 +267,15 @@
(function (_ altV)
(case altV
(^template [<number> <tag> <writer>]
- (<tag> caseV)
- (let [[caseS caseT] (<writer> caseV)]
- [(.inc caseS)
- (function (_ [offset binary])
- (|> binary
- (binary.write/8 offset <number>)
- try.assume
- [(.inc offset)]
- caseT))]))
+ [(<tag> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.inc caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8 offset <number>)
+ try.assume
+ [(.inc offset)]
+ caseT))])])
([0 #.Bit ..bit]
[1 #.Nat ..nat]
[2 #.Int ..int]
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 2dbe32d91..7fae80334 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -68,8 +68,8 @@
wrapper (function (_ x) (` (..json (~ x))))]
(case token
(^template [<ast-tag> <ctor> <json-tag>]
- [_ (<ast-tag> value)]
- (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value))))))))
+ [[_ (<ast-tag> value)]
+ (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))])
([#.Bit code.bit #..Boolean]
[#.Frac code.frac #..Number]
[#.Text code.text #..String])
@@ -163,8 +163,8 @@
#1
(^template [<tag> <struct>]
- [(<tag> x') (<tag> y')]
- (:: <struct> = x' y'))
+ [[(<tag> x') (<tag> y')]
+ (:: <struct> = x' y')])
([#Boolean bit.equivalence]
[#Number f.equivalence]
[#String text.equivalence])
@@ -237,8 +237,8 @@
(-> JSON Text)
(case json
(^template [<tag> <format>]
- (<tag> value)
- (<format> value))
+ [(<tag> value)
+ (<format> value)])
([#Null format-null]
[#Boolean format-boolean]
[#Number format-number]
diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux
index 0e13e1ee6..65e25c528 100644
--- a/stdlib/source/lux/data/format/tar.lux
+++ b/stdlib/source/lux/data/format/tar.lux
@@ -420,8 +420,8 @@
[linkflag <b>.bits/8]
(case (.nat linkflag)
(^template [<value> <link-flag>]
- (^ <value>)
- (wrap <link-flag>))
+ [(^ <value>)
+ (wrap <link-flag>)])
(<options>)
_
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index 099d01d39..ac6ac4ea8 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -6,7 +6,8 @@
[equivalence (#+ Equivalence)]
[codec (#+ Codec)]
[predicate (#+ Predicate)]
- ["." order (#+ Order)]]
+ [order (#+ Order)]
+ [monad (#+ do)]]
[control
["." try (#+ Try)]]
[data
@@ -91,6 +92,9 @@
## else
+1.0))
+(def: min-exponent -1022)
+(def: max-exponent +1023)
+
(template [<name> <test> <doc>]
[(def: #export (<name> left right)
{#.doc <doc>}
@@ -120,7 +124,7 @@
(-> Frac Rev)
(|>> ..abs
(..% +1.0)
- (..* frac-denominator)
+ (..* ..frac-denominator)
"lux f64 i64"
("lux i64 left-shift" 11)))
@@ -135,14 +139,18 @@
(def: &equivalence ..equivalence)
(def: < ..<))
+(def: mantissa-size Nat 52)
+(def: exponent-size Nat 11)
+
(def: #export smallest
Frac
- (math.pow -1074.0 +2.0))
+ (math.pow (//int.frac (//int.- (.int ..mantissa-size) ..min-exponent))
+ +2.0))
(def: #export biggest
Frac
- (let [f2^-52 (math.pow -52.0 +2.0)
- f2^+1023 (math.pow +1023.0 +2.0)]
+ (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa-size 0)) +2.0)
+ f2^+1023 (math.pow (//int.frac ..max-exponent) +2.0)]
(|> +2.0
(..- f2^-52)
(..* f2^+1023))))
@@ -178,9 +186,9 @@
(def: #export (frac? value)
(-> Frac Bit)
- (not (or (not-a-number? value)
- (..= positive-infinity value)
- (..= negative-infinity value))))
+ (not (or (..not-a-number? value)
+ (..= ..positive-infinity value)
+ (..= ..negative-infinity value))))
(structure: #export decimal
(Codec Text Frac)
@@ -203,252 +211,29 @@
#.None
(#try.Failure "Could not decode Frac"))))
-(template [<struct> <int> <base> <char-set> <error>]
- [(structure: #export <struct>
- (Codec Text Frac)
-
- (def: (encode value)
- (let [whole (..int value)
- whole-part (:: <int> encode whole)
- decimal (|> value (..% +1.0) ..abs)
- decimal-part (if (..= +0.0 decimal)
- ".0"
- (loop [dec-left decimal
- output ""]
- (if (..= +0.0 dec-left)
- ("lux text concat" "." output)
- (let [shifted (..* <base> dec-left)
- digit-idx (|> shifted (..% <base>) ..int .nat)]
- (recur (..% +1.0 shifted)
- ("lux text concat" output ("lux text clip" digit-idx (inc digit-idx) <char-set>)))))))]
- ("lux text concat" whole-part decimal-part)))
-
- (def: (decode repr)
- (case ("lux text index" 0 "." repr)
- (#.Some split-index)
- (let [whole-part ("lux text clip" 0 split-index repr)
- decimal-part ("lux text clip" (inc split-index) ("lux text size" repr) repr)]
- (case [(:: <int> decode whole-part)
- (:: <int> decode ("lux text concat" "+" decimal-part))]
- (^multi [(#try.Success whole) (#try.Success decimal)]
- (//int.>= +0 decimal))
- (let [sign (if (//int.< +0 whole)
- -1.0
- +1.0)
- div-power (loop [muls-left ("lux text size" decimal-part)
- output +1.0]
- (if (//nat.= 0 muls-left)
- output
- (recur (dec muls-left)
- (..* <base> output))))
- adjusted-decimal (|> decimal //int.frac (../ div-power))
- dec-rev (case (:: //rev.hex decode ("lux text concat" "." decimal-part))
- (#try.Success dec-rev)
- dec-rev
-
- (#try.Failure error)
- (error! error))]
- (#try.Success (..+ (//int.frac whole)
- (..* sign adjusted-decimal))))
-
- _
- (#try.Failure ("lux text concat" <error> repr))))
-
- _
- (#try.Failure ("lux text concat" <error> repr)))))]
-
- [binary //int.binary +2.0 "01" "Invalid binary syntax: "]
- )
+(def: log/2
+ (-> Frac Frac)
+ (|>> math.log
+ (../ (math.log +2.0))))
-(def: (segment-digits chunk-size digits)
- (-> Nat Text (List Text))
- (case digits
- ""
- (list)
+(def: double-bias Nat 1023)
- _
- (let [num-digits ("lux text size" digits)]
- (if (//nat.<= chunk-size num-digits)
- (list digits)
- (let [boundary (//nat.- chunk-size num-digits)
- chunk ("lux text clip" boundary num-digits digits)
- remaining ("lux text clip" 0 boundary digits)]
- (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'))))
-
-(template [<from> <from-translator> <to> <to-translator> <base-bits>]
- [(def: (<from> on-left? input)
- (-> Bit Text Text)
- (let [max-num-chars (//nat./ <base-bits> 64)
- input-size ("lux text size" input)
- zero-padding (let [num-digits-that-need-padding (//nat.% <base-bits> input-size)]
- (if (//nat.= 0 num-digits-that-need-padding)
- ""
- (loop [zeroes-left (//nat.- num-digits-that-need-padding
- <base-bits>)
- output ""]
- (if (//nat.= 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]
- )
+(def: exponent-mask (//i64.mask ..exponent-size))
-(template [<struct> <error> <from> <to>]
- [(structure: #export <struct>
- (Codec Text Frac)
-
- (def: (encode value)
- (let [sign (..signum value)
- raw-bin (:: ..binary encode value)
- dot-idx (maybe.assume ("lux text index" 0 "." raw-bin))
- whole-part ("lux text clip" 1 dot-idx raw-bin)
- decimal-part ("lux text clip" (inc dot-idx) ("lux text size" raw-bin) raw-bin)]
- (|> (<from> #0 decimal-part)
- ("lux text concat" ".")
- ("lux text concat" (<from> #1 whole-part))
- ("lux text concat" (if (..= -1.0 sign) "-" "+")))))
-
- (def: (decode repr)
- (let [sign (case ("lux text index" 0 "-" repr)
- (#.Some 0)
- -1.0
-
- _
- +1.0)]
- (case ("lux text index" 0 "." repr)
- (#.Some split-index)
- (let [whole-part ("lux text clip" 1 split-index repr)
- decimal-part ("lux text clip" (inc split-index) ("lux text size" repr) repr)
- as-binary (|> (<to> decimal-part)
- ("lux text concat" ".")
- ("lux text concat" (<to> whole-part))
- ("lux text concat" (if (..= -1.0 sign) "-" "+")))]
- (case (:: ..binary decode as-binary)
- (#try.Failure _)
- (#try.Failure ("lux text concat" <error> repr))
+(def: exponent-offset ..mantissa-size)
+(def: sign-offset (//nat.+ ..exponent-size ..exponent-offset))
- output
- output))
-
- _
- (#try.Failure ("lux text concat" <error> repr))))))]
+(template [<getter> <size> <offset>]
+ [(def: <getter>
+ (-> (I64 Any) I64)
+ (let [mask (|> 1 (//i64.left-shift <size>) dec (//i64.left-shift <offset>))]
+ (|>> (//i64.and mask) (//i64.logic-right-shift <offset>) .i64)))]
- [octal "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary]
- [hex "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary]
+ [mantissa ..mantissa-size 0]
+ [exponent ..exponent-size ..mantissa-size]
+ [sign 1 ..sign-offset]
)
-(def: (log2 input)
- (-> Frac Frac)
- (../ (math.log +2.0)
- (math.log input)))
-
-(def: double-bias Nat 1023)
-
-(def: mantissa-size Nat 52)
-(def: exponent-size Nat 11)
-(def: sign-offset (//nat.+ ..exponent-size ..mantissa-size))
-
(template [<hex> <name>]
[(def: <name> (|> <hex> (:: //nat.hex decode) try.assume .i64))]
@@ -460,6 +245,12 @@
["7FF" special-exponent-bits]
)
+(def: normal
+ (math.pow (//nat.frac ..mantissa-size) +2.0))
+
+(def: smallest-exponent
+ (..log/2 ..smallest))
+
(def: #export (to-bits input)
(-> Frac I64)
(i64 (cond (not-a-number? input)
@@ -484,32 +275,30 @@
1
0)
input (..abs input)
- exponent (math.floor (log2 input))
- exponent-mask (|> 1 (//i64.left-shift ..exponent-size) dec)
- mantissa (|> input
- ## Normalize
- (../ (math.pow exponent +2.0))
- ## Make it int-equivalent
- (..* (math.pow +52.0 +2.0)))
- exponent-bits (|> exponent ..int .nat (//nat.+ ..double-bias) (//i64.and exponent-mask))
- mantissa-bits (|> mantissa ..int .nat)]
+ exponent (|> (math.floor (..log/2 input))
+ (..min (//int.frac ..max-exponent)))
+ tiny? (..= ..smallest-exponent exponent)
+ mantissa (..* (math.pow (if tiny?
+ (|> exponent ..abs (..- (//nat.frac ..mantissa-size)))
+ (..- exponent (//nat.frac ..mantissa-size)))
+ +2.0)
+ input)
+ exponent-bits (|> (if tiny?
+ (|> (..int exponent)
+ (//int.+ (.int ..mantissa-size))
+ dec)
+ (..int exponent))
+ (//int.+ (.int ..double-bias))
+ (//i64.and ..exponent-mask))
+ mantissa-bits (if tiny?
+ (|> mantissa (..* ..normal) ..int .nat)
+ (|> mantissa ..int .nat))]
($_ //i64.or
(//i64.left-shift ..sign-offset sign-bit)
- (//i64.left-shift ..mantissa-size exponent-bits)
+ (//i64.left-shift ..exponent-offset exponent-bits)
(//i64.clear ..mantissa-size mantissa-bits)))
)))
-(template [<getter> <size> <offset>]
- [(def: <getter>
- (-> (I64 Any) I64)
- (let [mask (|> 1 (//i64.left-shift <size>) dec (//i64.left-shift <offset>))]
- (|>> (//i64.and mask) (//i64.logic-right-shift <offset>) .i64)))]
-
- [mantissa ..mantissa-size 0]
- [exponent ..exponent-size ..mantissa-size]
- [sign 1 ..sign-offset]
- )
-
(def: #export (from-bits input)
(-> I64 Frac)
(let [S (..sign input)
@@ -533,13 +322,89 @@
.int (//int.* (if positive?
+1
-1)))
- denominator (math.pow +52.0 +2.0)
- power (math.pow (|> E (//nat.- ..double-bias) .int //int.frac)
+ denominator ..normal
+ power (math.pow (//int.frac (if (//nat.= 0 (.nat E))
+ (|> E (//nat.- ..double-bias) (//nat.- ..mantissa-size) inc .int)
+ (|> E (//nat.- ..double-bias) .int)))
+2.0)]
(|> (//int.frac numerator)
(../ denominator)
(..* power))))))
+(def: (split-exponent codec representation)
+ (-> (Codec Text Nat) Text (Try [Text Int]))
+ (case [("lux text index" 0 "e+" representation)
+ ("lux text index" 0 "E+" representation)
+ ("lux text index" 0 "e-" representation)
+ ("lux text index" 0 "E-" representation)]
+ (^template [<factor> <patterns>]
+ [<patterns>
+ (do try.monad
+ [exponent (|> representation
+ ("lux text clip" (//nat.+ 2 split-index) ("lux text size" representation))
+ (:: codec decode))]
+ (wrap [("lux text clip" 0 split-index representation)
+ (//int.* <factor> (.int exponent))]))])
+ ([+1 (^or [(#.Some split-index) #.None #.None #.None]
+ [#.None (#.Some split-index) #.None #.None])]
+ [-1 (^or [#.None #.None (#.Some split-index) #.None]
+ [#.None #.None #.None (#.Some split-index)])])
+
+ _
+ (#try.Success [representation +0])))
+
+(template [<struct> <nat> <int> <error>]
+ [(structure: #export <struct>
+ (Codec Text Frac)
+
+ (def: (encode value)
+ (let [bits (..to-bits value)
+ mantissa (..mantissa bits)
+ exponent (//int.- (.int ..double-bias) (..exponent bits))
+ sign (..sign bits)]
+ ($_ "lux text concat"
+ (case (.nat sign)
+ 1 "-"
+ 0 "+"
+ _ (undefined))
+ (:: <nat> encode (.nat mantissa))
+ ".0E"
+ (:: <int> encode exponent))))
+
+ (def: (decode representation)
+ (let [negative? (text.starts-with? "-" representation)
+ positive? (text.starts-with? "+" representation)]
+ (if (or negative? positive?)
+ (do {! try.monad}
+ [[mantissa exponent] (..split-exponent <nat> representation)
+ [whole decimal] (case ("lux text index" 0 "." mantissa)
+ (#.Some split-index)
+ (do !
+ [decimal (|> mantissa
+ ("lux text clip" (inc split-index) ("lux text size" mantissa))
+ (:: <nat> decode))]
+ (wrap [("lux text clip" 0 split-index mantissa)
+ decimal]))
+
+ #.None
+ (#try.Failure ("lux text concat" <error> representation)))
+ #let [whole ("lux text clip" 1 ("lux text size" whole) whole)]
+ mantissa (:: <nat> decode (case decimal
+ 0 whole
+ _ ("lux text concat" whole (:: <nat> encode decimal))))
+ #let [sign (if negative? 1 0)]]
+ (wrap (..from-bits
+ ($_ //i64.or
+ (//i64.left-shift ..sign-offset (.i64 sign))
+ (//i64.left-shift ..mantissa-size (.i64 (//int.+ (.int ..double-bias) exponent)))
+ (//i64.clear ..mantissa-size (.i64 mantissa))))))
+ (#try.Failure ("lux text concat" <error> representation))))))]
+
+ [binary //nat.binary //int.binary "Invalid binary syntax: "]
+ [octal //nat.octal //int.octal "Invalid octaladecimal syntax: "]
+ [hex //nat.hex //int.hex "Invalid hexadecimal syntax: "]
+ )
+
(structure: #export hash
(Hash Frac)
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index b34251760..5c7b31833 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -116,8 +116,8 @@
@.js
(case (host.type-of value)
(^template [<type-of> <then>]
- <type-of>
- (`` (|> value (~~ (template.splice <then>)))))
+ [<type-of>
+ (`` (|> value (~~ (template.splice <then>))))])
(["boolean" [(:coerce .Bit) %.bit]]
["string" [(:coerce .Text) %.text]]
["number" [(:coerce .Frac) %.frac]]
diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux
index cb9013f11..a295d83e8 100644
--- a/stdlib/source/lux/extension.lux
+++ b/stdlib/source/lux/extension.lux
@@ -3,14 +3,14 @@
[abstract
["." monad]]
[control
- ["<>" parser ("#//." monad)
+ ["<>" parser ("#\." monad)
["<c>" code (#+ Parser)]
["<a>" analysis]
["<s>" synthesis]]]
[data
["." product]
[collection
- ["." list ("#//." functor)]]]
+ ["." list ("#\." functor)]]]
[meta (#+ with-gensyms)]
[macro
["." code]
@@ -27,7 +27,7 @@
(-> Code (Parser Input))
($_ <>.and
<c>.local-identifier
- (<>//wrap default)))
+ (<>\wrap default)))
(def: complex
(Parser Input)
@@ -60,7 +60,7 @@
[(syntax: #export (<name>
{[name extension phase archive inputs] (..declaration (` <any>))}
body)
- (let [g!parser (case (list//map product.right inputs)
+ (let [g!parser (case (list\map product.right inputs)
#.Nil
(` <end>)
@@ -73,9 +73,9 @@
(wrap (list (` (<extension> (~ name)
(.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs))
(.case ((~! <run>) (~ g!parser) (~ g!inputs))
- (#.Right [(~+ (list//map (|>> product.left
- code.local-identifier)
- inputs))])
+ (#.Right [(~+ (list\map (|>> product.left
+ code.local-identifier)
+ inputs))])
(~ body)
(#.Left (~ g!error))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 87ec823d6..22fc14b28 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -400,8 +400,8 @@
(-> (-> Code Code) Code Code)
(case (f input)
(^template [<tag>]
- [meta (<tag> parts)]
- [meta (<tag> (list@map (pre-walk-replace f) parts))])
+ [[meta (<tag> parts)]
+ [meta (<tag> (list@map (pre-walk-replace f) parts))]])
([#.Form]
[#.Tuple])
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index b65058c88..af26b4372 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -231,8 +231,8 @@
(-> Text (Maybe Code))
(case class
(^template [<prim> <type>]
- <prim>
- (#.Some (' <type>)))
+ [<prim>
+ (#.Some (' <type>))])
(["boolean" (primitive "java.lang.Boolean")]
["byte" (primitive "java.lang.Byte")]
["short" (primitive "java.lang.Short")]
@@ -250,8 +250,8 @@
(-> Text (Maybe Code))
(case class
(^template [<prim> <type>]
- <prim>
- (#.Some (' <type>)))
+ [<prim>
+ (#.Some (' <type>))])
(["boolean" .Bit]
["byte" .Int]
["short" .Int]
@@ -369,8 +369,8 @@
(format "[" (simple-class$ env param))
(^template [<prim> <class>]
- (#GenericClass <prim> #.Nil)
- <class>)
+ [(#GenericClass <prim> #.Nil)
+ <class>])
(["boolean" "[Z"]
["byte" "[B"]
["short" "[S"]
@@ -410,8 +410,8 @@
(-> (-> Code Code) Code Code)
(case (f input)
(^template [<tag>]
- [meta (<tag> parts)]
- [meta (<tag> (list@map (pre-walk-replace f) parts))])
+ [[meta (<tag> parts)]
+ [meta (<tag> (list@map (pre-walk-replace f) parts))]])
([#.Form]
[#.Tuple])
@@ -551,8 +551,8 @@
[component recur^]
(case component
(^template [<class> <name>]
- (#GenericClass <name> #.Nil)
- (wrap (#GenericClass <class> (list))))
+ [(#GenericClass <name> #.Nil)
+ (wrap (#GenericClass <class> (list)))])
(["[Z" "boolean"]
["[B" "byte"]
["[S" "short"]
@@ -1701,8 +1701,8 @@
(array Object 10))}
(case type
(^template [<type> <array-op>]
- (^ (#GenericClass <type> (list)))
- (wrap (list (` (<array-op> (~ size))))))
+ [(^ (#GenericClass <type> (list)))
+ (wrap (list (` (<array-op> (~ size)))))])
(["boolean" "jvm znewarray"]
["byte" "jvm bnewarray"]
["short" "jvm snewarray"]
@@ -1752,8 +1752,8 @@
array-jvm-type (type->class-name array-type)]
(case array-jvm-type
(^template [<type> <array-op>]
- <type>
- (wrap (list (` (<array-op> (~ array) (~ idx))))))
+ [<type>
+ (wrap (list (` (<array-op> (~ array) (~ idx)))))])
(["[Z" "jvm zaload"]
["[B" "jvm baload"]
["[S" "jvm saload"]
@@ -1781,8 +1781,8 @@
array-jvm-type (type->class-name array-type)]
(case array-jvm-type
(^template [<type> <array-op>]
- <type>
- (wrap (list (` (<array-op> (~ array) (~ idx) (~ value))))))
+ [<type>
+ (wrap (list (` (<array-op> (~ array) (~ idx) (~ value)))))])
(["[Z" "jvm zastore"]
["[B" "jvm bastore"]
["[S" "jvm sastore"]
diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index 9946753b7..90d0653df 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -4,7 +4,7 @@
[equivalence (#+ Equivalence)]
[hash (#+ Hash)]]
[data
- ["." maybe ("#//." functor)]
+ ["." maybe ("#\." functor)]
["." text
["%" format (#+ format)]
["." encoding (#+ Encoding)]]]
@@ -24,10 +24,10 @@
(-> Language (Maybe Territory) (Maybe Encoding) Locale)
(:abstraction (format (language.code language)
(|> territory
- (maybe//map (|>> territory.long-code (format ..territory-separator)))
+ (maybe\map (|>> territory.long-code (format ..territory-separator)))
(maybe.default ""))
(|> encoding
- (maybe//map (|>> encoding.name (format ..encoding-separator)))
+ (maybe\map (|>> encoding.name (format ..encoding-separator)))
(maybe.default "")))))
(def: #export code
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index e2d528dad..839084537 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -10,9 +10,9 @@
["." int]
["." rev]
["." frac]]
- ["." text ("#//." monoid equivalence)]
+ ["." text ("#\." monoid equivalence)]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[meta
["." location]]])
@@ -65,8 +65,8 @@
(def: (= x y)
(case [x y]
(^template [<tag> <eq>]
- [[_ (<tag> x')] [_ (<tag> y')]]
- (:: <eq> = x' y'))
+ [[[_ (<tag> x')] [_ (<tag> y')]]
+ (:: <eq> = x' y')])
([#.Bit bit.equivalence]
[#.Nat nat.equivalence]
[#.Int int.equivalence]
@@ -77,8 +77,8 @@
[#.Tag name.equivalence])
(^template [<tag>]
- [[_ (<tag> xs')] [_ (<tag> ys')]]
- (:: (list.equivalence =) = xs' ys'))
+ [[[_ (<tag> xs')] [_ (<tag> ys')]]
+ (:: (list.equivalence =) = xs' ys')])
([#.Form]
[#.Tuple])
@@ -93,8 +93,8 @@
(-> Code Text)
(case ast
(^template [<tag> <struct>]
- [_ (<tag> value)]
- (:: <struct> encode value))
+ [[_ (<tag> value)]
+ (:: <struct> encode value)])
([#.Bit bit.codec]
[#.Nat nat.decimal]
[#.Int int.decimal]
@@ -106,33 +106,33 @@
(text.encode value)
[_ (#.Tag name)]
- (text//compose "#" (:: name.codec encode name))
+ (text\compose "#" (:: name.codec encode name))
(^template [<tag> <open> <close>]
- [_ (<tag> members)]
- ($_ text//compose
- <open>
- (list//fold (function (_ next prev)
+ [[_ (<tag> members)]
+ ($_ text\compose
+ <open>
+ (list\fold (function (_ next prev)
(let [next (format next)]
- (if (text//= "" prev)
+ (if (text\= "" prev)
next
- ($_ text//compose prev " " next))))
+ ($_ text\compose prev " " next))))
""
members)
- <close>))
+ <close>)])
([#.Form "(" ")"]
[#.Tuple "[" "]"])
[_ (#.Record pairs)]
- ($_ text//compose
+ ($_ text\compose
"{"
- (list//fold (function (_ [left right] prev)
- (let [next ($_ text//compose (format left) " " (format right))]
- (if (text//= "" prev)
- next
- ($_ text//compose prev " " next))))
- ""
- pairs)
+ (list\fold (function (_ [left right] prev)
+ (let [next ($_ text\compose (format left) " " (format right))]
+ (if (text\= "" prev)
+ next
+ ($_ text\compose prev " " next))))
+ ""
+ pairs)
"}")
))
@@ -143,16 +143,16 @@
substitute
(case ast
(^template [<tag>]
- [location (<tag> parts)]
- [location (<tag> (list//map (replace original substitute) parts))])
+ [[location (<tag> parts)]
+ [location (<tag> (list\map (replace original substitute) parts))]])
([#.Form]
[#.Tuple])
[location (#.Record parts)]
- [location (#.Record (list//map (function (_ [left right])
- [(replace original substitute left)
- (replace original substitute right)])
- parts))]
+ [location (#.Record (list\map (function (_ [left right])
+ [(replace original substitute left)
+ (replace original substitute right)])
+ parts))]
_
ast)))
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 328e74ef1..0b4964897 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -13,7 +13,7 @@
[number
["n" nat]]
[collection
- ["." list ("#//." fold functor)]
+ ["." list ("#\." fold functor)]
["." dictionary]]]
["." meta (#+ with-gensyms)]
[macro
@@ -50,7 +50,7 @@
(def: (derivation-name poly args)
(-> Text (List Text) (Maybe Text))
(if (common-poly-name? poly)
- (#.Some (list//fold (text.replace-once "?") poly args))
+ (#.Some (list\fold (text.replace-once "?") poly args))
#.None))
(syntax: #export (derived: {export csr.export}
@@ -64,7 +64,7 @@
(wrap name)
(^multi #.None
- [(derivation-name (product.right poly-func) (list//map product.right poly-args))
+ [(derivation-name (product.right poly-func) (list\map product.right poly-args))
(#.Some derived-name)])
(wrap derived-name)
@@ -75,7 +75,7 @@
custom-impl
#.None
- (` ((~ (code.identifier poly-func)) (~+ (list//map code.identifier poly-args)))))]]
+ (` ((~ (code.identifier poly-func)) (~+ (list\map code.identifier poly-args)))))]]
(wrap (.list (` (def: (~+ (csw.export export))
(~ (code.identifier ["" name]))
{#.struct? #1}
@@ -86,11 +86,11 @@
(case type
(#.Primitive name params)
(` (#.Primitive (~ (code.text name))
- (list (~+ (list//map (to-code env) params)))))
+ (list (~+ (list\map (to-code env) params)))))
(^template [<tag>]
- (<tag> idx)
- (` (<tag> (~ (code.nat idx)))))
+ [(<tag> idx)
+ (` (<tag> (~ (code.nat idx))))])
([#.Var] [#.Ex])
(#.Parameter idx)
@@ -106,14 +106,14 @@
(undefined)))
(^template [<tag>]
- (<tag> left right)
- (` (<tag> (~ (to-code env left))
- (~ (to-code env right)))))
+ [(<tag> left right)
+ (` (<tag> (~ (to-code env left))
+ (~ (to-code env right))))])
([#.Function] [#.Apply])
(^template [<macro> <tag> <flattener>]
- (<tag> left right)
- (` (<macro> (~+ (list//map (to-code env) (<flattener> type))))))
+ [(<tag> left right)
+ (` (<macro> (~+ (list\map (to-code env) (<flattener> type)))))])
([| #.Sum type.flatten-variant]
[& #.Product type.flatten-tuple])
@@ -121,8 +121,8 @@
(code.identifier name)
(^template [<tag>]
- (<tag> scope body)
- (` (<tag> (list (~+ (list//map (to-code env) scope)))
- (~ (to-code env body)))))
+ [(<tag> scope body)
+ (` (<tag> (list (~+ (list\map (to-code env) scope)))
+ (~ (to-code env body))))])
([#.UnivQ] [#.ExQ])
))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 78ae223d2..3c11a2a43 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -8,14 +8,14 @@
["</>" code (#+ Parser)]]]
[data
["." maybe]
- ["." text ("#//." monoid)]
+ ["." text ("#\." monoid)]
[number
["." nat]
["." int]
["." rev]
["." frac]]
[collection
- ["." list ("#//." functor)]]]
+ ["." list ("#\." functor)]]]
["." meta (#+ with-gensyms)]]
[//
["." code]])
@@ -28,7 +28,7 @@
(#try.Success [tokens output])
(#try.Failure error)
- (#try.Failure ($_ text//compose
+ (#try.Failure ($_ text\compose
"Failed to parse: " (code.format binding) text.new-line
error)))))
@@ -49,11 +49,11 @@
{interfaces (tuple (some (super-class-decl^ imports class-vars)))}
{constructor-args (constructor-args^ imports class-vars)}
{methods (some (overriden-method-def^ imports))})
- (let [def-code ($_ text//compose "anon-class:"
+ (let [def-code ($_ text\compose "anon-class:"
(spaced (list (super-class-decl$ (maybe.default object-super-class super))
- (with-brackets (spaced (list//map super-class-decl$ interfaces)))
- (with-brackets (spaced (list//map constructor-arg$ constructor-args)))
- (with-brackets (spaced (list//map (method-def$ id) methods))))))]
+ (with-brackets (spaced (list\map super-class-decl$ interfaces)))
+ (with-brackets (spaced (list\map constructor-arg$ constructor-args)))
+ (with-brackets (spaced (list\map (method-def$ id) methods))))))]
(wrap (list (` ((~ (code.text def-code)))))))))}
(let [[exported? tokens] (: [Bit (List Code)]
(case tokens
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 776674926..03fea57bc 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -3,10 +3,10 @@
[abstract
monad]
[control
- ["p" parser ("#//." monad)
+ ["p" parser ("#\." monad)
["s" code (#+ Parser)]]]
[data
- ["." name ("#//." equivalence)]
+ ["." name ("#\." equivalence)]
["." product]
["." maybe]
[collection
@@ -18,8 +18,8 @@
(def: #export export
(Parser Bit)
- (p.either (p.after (s.tag! (name-of #export)) (p//wrap #1))
- (p//wrap #0)))
+ (p.either (p.after (s.tag! (name-of #export)) (p\wrap #1))
+ (p\wrap #0)))
(def: #export declaration
{#.doc (doc "A reader for declaration syntax."
@@ -28,7 +28,7 @@
(foo bar baz))}
(Parser //.Declaration)
(p.either (p.and s.local-identifier
- (p//wrap (list)))
+ (p\wrap (list)))
(s.form (p.and s.local-identifier
(p.some s.local-identifier)))))
@@ -44,7 +44,7 @@
type s.any
value s.any]
(wrap [(#.Some type) value])))
- (p.and (p//wrap #.None)
+ (p.and (p\wrap #.None)
s.any)))
(def: _definition-anns-tag^
@@ -90,7 +90,7 @@
(-> (List [Name Code]) (List Text))
(<| (maybe.default (list))
(: (Maybe (List Text)))
- (case (list.find (|>> product.left (name//= ["lux" "func-args"])) meta-data)
+ (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta-data)
(^multi (#.Some [_ value])
[(p.run tuple-meta^ (list value))
(#.Right [_ args])]
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index e2e10f319..18abab65a 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -5,7 +5,7 @@
["." function]]
[data
[collection
- ["." list ("#//." functor)]]
+ ["." list ("#\." functor)]]
["." product]]
[macro
["." code]]]
@@ -20,12 +20,12 @@
(def: #export (declaration declaration)
(-> //.Declaration Code)
(` ((~ (code.local-identifier (get@ #//.declaration-name declaration)))
- (~+ (list//map code.local-identifier
- (get@ #//.declaration-args declaration))))))
+ (~+ (list\map code.local-identifier
+ (get@ #//.declaration-args declaration))))))
(def: #export annotations
(-> //.Annotations Code)
- (|>> (list//map (product.both code.tag function.identity))
+ (|>> (list\map (product.both code.tag function.identity))
code.record))
(def: #export (typed-input value)
@@ -35,4 +35,4 @@
(def: #export type-variables
(-> (List //.Type-Var) (List Code))
- (list//map code.local-identifier))
+ (list\map code.local-identifier))
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index c54f11d8c..12b3d9261 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -3,18 +3,18 @@
[abstract
["." monad (#+ do)]]
[control
- ["<>" parser ("#//." functor)
+ ["<>" parser ("#\." functor)
["<.>" code (#+ Parser)]]]
[data
- ["." bit ("#//." codec)]
+ ["." bit ("#\." codec)]
["." text]
[number
- ["." nat ("#//." decimal)]
- ["." int ("#//." decimal)]
- ["." rev ("#//." decimal)]
- ["." frac ("#//." decimal)]]
+ ["." nat ("#\." decimal)]
+ ["." int ("#\." decimal)]
+ ["." rev ("#\." decimal)]
+ ["." frac ("#\." decimal)]]
[collection
- ["." list ("#//." monad)]]]
+ ["." list ("#\." monad)]]]
["." meta]]
[//
[syntax (#+ syntax:)]
@@ -30,12 +30,12 @@
body)
(do {! meta.monad}
[g!locals (|> locals
- (list//map meta.gensym)
+ (list\map meta.gensym)
(monad.seq !))]
(wrap (list (` (.with-expansions [(~+ (|> (list.zip/2 locals g!locals)
- (list//map (function (_ [name identifier])
- (list (code.local-identifier name) (as-is identifier))))
- list//join))]
+ (list\map (function (_ [name identifier])
+ (list (code.local-identifier name) (as-is identifier))))
+ list\join))]
(~ body)))))))
(def: (name-side module-side? parser)
@@ -62,11 +62,11 @@
full-tag
(<>.either <code>.local-tag
full-tag))
- (<>//map bit//encode <code>.bit)
- (<>//map nat//encode <code>.nat)
- (<>//map int//encode <code>.int)
- (<>//map rev//encode <code>.rev)
- (<>//map frac//encode <code>.frac)
+ (<>\map bit\encode <code>.bit)
+ (<>\map nat\encode <code>.nat)
+ (<>\map int\encode <code>.int)
+ (<>\map rev\encode <code>.rev)
+ (<>\map frac\encode <code>.frac)
)))
(def: (part module-side?)
diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux
index 3ec4103e1..8fe207c65 100644
--- a/stdlib/source/lux/math/logic/continuous.lux
+++ b/stdlib/source/lux/math/logic/continuous.lux
@@ -2,10 +2,10 @@
[lux (#- false true or and not)
[data
[number
- ["r" rev ("#//." interval)]]]])
+ ["r" rev ("#\." interval)]]]])
-(def: #export true Rev r//top)
-(def: #export false Rev r//bottom)
+(def: #export true Rev r\top)
+(def: #export false Rev r\bottom)
(template [<name> <chooser>]
[(def: #export <name>
diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux
index e93569638..445789bde 100644
--- a/stdlib/source/lux/math/modular.lux
+++ b/stdlib/source/lux/math/modular.lux
@@ -11,8 +11,8 @@
["s" code]]]
[data
[number
- ["i" int ("#//." decimal)]]
- ["." text ("#//." monoid)]]
+ ["i" int ("#\." decimal)]]
+ ["." text ("#\." monoid)]]
[type
abstract]
[macro
@@ -40,13 +40,13 @@
(exception: #export [m] (incorrect-modulus {modulus (Modulus m)}
{parsed Int})
- (ex.report ["Expected" (i//encode (to-int modulus))]
- ["Actual" (i//encode parsed)]))
+ (ex.report ["Expected" (i\encode (to-int modulus))]
+ ["Actual" (i\encode parsed)]))
(exception: #export [rm sm] (cannot-equalize-moduli {reference (Modulus rm)}
{sample (Modulus sm)})
- (ex.report ["Reference" (i//encode (to-int reference))]
- ["Sample" (i//encode (to-int sample))]))
+ (ex.report ["Reference" (i\encode (to-int reference))]
+ ["Sample" (i\encode (to-int sample))]))
(def: #export (congruent? modulus reference sample)
(All [m] (-> (Modulus m) Int Int Bit))
@@ -91,10 +91,10 @@
(def: (encode modular)
(let [[remainder modulus] (:representation modular)]
- ($_ text//compose
- (i//encode remainder)
+ ($_ text\compose
+ (i\encode remainder)
separator
- (i//encode (to-int modulus)))))
+ (i\encode (to-int modulus)))))
(def: decode
(l.run (do p.monad
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index e1a51bcaf..e8a8d3263 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -15,10 +15,10 @@
["r" ratio]
["c" complex]
["f" frac]]
- ["." text (#+ Char) ("#//." monoid)
+ ["." text (#+ Char) ("#\." monoid)
["." unicode]]
[collection
- ["." list ("#//." fold)]
+ ["." list ("#\." fold)]
["." array (#+ Array)]
["." dictionary (#+ Dictionary)]
["." queue (#+ Queue)]
@@ -166,7 +166,7 @@
(do ..monad
[x char-gen
xs (text char-gen (dec size))]
- (wrap (text//compose (text.from-code x) xs)))))
+ (wrap (text\compose (text.from-code x) xs)))))
(template [<name> <set>]
[(def: #export <name>
@@ -263,7 +263,7 @@
[array Array array.from-list]
[queue Queue queue.from-list]
- [stack Stack (list//fold stack.push stack.empty)]
+ [stack Stack (list\fold stack.push stack.empty)]
)
(def: #export (set Hash<a> size value-gen)
@@ -309,30 +309,30 @@
(def: #export month
(Random Month)
- (let [(^open "//.") ..monad]
- (..either (..either (..either (//wrap #month.January)
- (..either (//wrap #month.February)
- (//wrap #month.March)))
- (..either (//wrap #month.April)
- (..either (//wrap #month.May)
- (//wrap #month.June))))
- (..either (..either (//wrap #month.July)
- (..either (//wrap #month.August)
- (//wrap #month.September)))
- (..either (//wrap #month.October)
- (..either (//wrap #month.November)
- (//wrap #month.December)))))))
+ (let [(^open "\.") ..monad]
+ (..either (..either (..either (\wrap #month.January)
+ (..either (\wrap #month.February)
+ (\wrap #month.March)))
+ (..either (\wrap #month.April)
+ (..either (\wrap #month.May)
+ (\wrap #month.June))))
+ (..either (..either (\wrap #month.July)
+ (..either (\wrap #month.August)
+ (\wrap #month.September)))
+ (..either (\wrap #month.October)
+ (..either (\wrap #month.November)
+ (\wrap #month.December)))))))
(def: #export day
(Random Day)
- (let [(^open "//.") ..monad]
- (..either (..either (//wrap #day.Sunday)
- (..either (//wrap #day.Monday)
- (//wrap #day.Tuesday)))
- (..either (..either (//wrap #day.Wednesday)
- (//wrap #day.Thursday))
- (..either (//wrap #day.Friday)
- (//wrap #day.Saturday))))))
+ (let [(^open "\.") ..monad]
+ (..either (..either (\wrap #day.Sunday)
+ (..either (\wrap #day.Monday)
+ (\wrap #day.Tuesday)))
+ (..either (..either (\wrap #day.Wednesday)
+ (\wrap #day.Thursday))
+ (..either (\wrap #day.Friday)
+ (\wrap #day.Saturday))))))
(def: #export (run prng calc)
(All [a] (-> PRNG (Random a) [PRNG a]))
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux
index 73d5fee2f..248cef7f2 100644
--- a/stdlib/source/lux/meta.lux
+++ b/stdlib/source/lux/meta.lux
@@ -9,13 +9,13 @@
[data
["." product]
["." maybe]
- ["." text ("#//." monoid equivalence)]
- ["." name ("#//." codec equivalence)]
+ ["." text ("#\." monoid equivalence)]
+ ["." name ("#\." codec equivalence)]
[number
["n" nat]
["i" int]]
[collection
- ["." list ("#//." monoid monad)]]]
+ ["." list ("#\." monoid monad)]]]
[macro
["." code]]]
[/
@@ -81,7 +81,7 @@
#.None
(#.Cons [k' v] plist')
- (if (text//= k k')
+ (if (text\= k k')
(#.Some v)
(get k plist'))))
@@ -132,7 +132,7 @@
(#try.Success [compiler module])
_
- (#try.Failure ($_ text//compose "Unknown module: " name)))))
+ (#try.Failure ($_ text\compose "Unknown module: " name)))))
(def: #export current-module-name
(Meta Text)
@@ -231,7 +231,7 @@
(do ..monad
[expansion ((:coerce Macro' macro) args)
expansion' (monad.map ..monad expand expansion)]
- (wrap (list//join expansion')))
+ (wrap (list\join expansion')))
#.None
(:: ..monad wrap (list syntax))))
@@ -251,23 +251,23 @@
(do ..monad
[expansion ((:coerce Macro' macro) args)
expansion' (monad.map ..monad expand-all expansion)]
- (wrap (list//join expansion')))
+ (wrap (list\join expansion')))
#.None
(do ..monad
[parts' (monad.map ..monad expand-all (list& (code.identifier name) args))]
- (wrap (list (code.form (list//join parts')))))))
+ (wrap (list (code.form (list\join parts')))))))
[_ (#.Form (#.Cons [harg targs]))]
(do ..monad
[harg+ (expand-all harg)
targs+ (monad.map ..monad expand-all targs)]
- (wrap (list (code.form (list//compose harg+ (list//join (: (List (List Code)) targs+)))))))
+ (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+)))))))
[_ (#.Tuple members)]
(do ..monad
[members' (monad.map ..monad expand-all members)]
- (wrap (list (code.tuple (list//join members')))))
+ (wrap (list (code.tuple (list\join members')))))
_
(:: ..monad wrap (list syntax))))
@@ -286,7 +286,7 @@
[id ..count]
(wrap (|> id
(:: n.decimal encode)
- ($_ text//compose "__gensym__" prefix)
+ ($_ text\compose "__gensym__" prefix)
[""] code.identifier))))
(def: (get-local-identifier ast)
@@ -296,12 +296,12 @@
(:: ..monad wrap name)
_
- (fail (text//compose "Code is not a local identifier: " (code.format ast)))))
+ (fail (text\compose "Code is not a local identifier: " (code.format ast)))))
(def: #export wrong-syntax-error
(-> Name Text)
- (|>> name//encode
- (text//compose "Wrong syntax for ")))
+ (|>> name\encode
+ (text\compose "Wrong syntax for ")))
(macro: #export (with-gensyms tokens)
{#.doc (doc "Creates new identifiers and offers them to the body expression."
@@ -317,9 +317,9 @@
(^ (list [_ (#.Tuple identifiers)] body))
(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))]]
+ #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)
[(~+ identifier-defs)]
(~ body))))))
@@ -389,7 +389,7 @@
(-> Text (Meta Type))
(function (_ compiler)
(let [test (: (-> [Text [Type Any]] Bit)
- (|>> product.left (text//= name)))]
+ (|>> product.left (text\= name)))]
(case (do maybe.monad
[scope (list.find (function (_ env)
(or (list.any? test (: (List [Text [Type Any]])
@@ -407,7 +407,7 @@
((clean-type var-type) compiler)
#.None
- (#try.Failure ($_ text//compose "Unknown variable: " name))))))
+ (#try.Failure ($_ text\compose "Unknown variable: " name))))))
(def: #export (find-def name)
{#.doc "Looks-up a definition's whole data in the available modules (including the current one)."}
@@ -425,19 +425,19 @@
_
(let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))
- separator ($_ text//compose text.new-line " ")]
- (#try.Failure ($_ text//compose
- "Unknown definition: " (name//encode name) text.new-line
+ separator ($_ text\compose text.new-line " ")]
+ (#try.Failure ($_ text\compose
+ "Unknown definition: " (name\encode name) text.new-line
" Current module: " current-module text.new-line
(case (get current-module (get@ #.modules compiler))
(#.Some this-module)
- ($_ text//compose
+ ($_ text\compose
" Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line
- " Aliases: " (|> this-module (get@ #.module-aliases) (list//map (function (_ [alias real]) ($_ text//compose alias " => " real))) (text.join-with separator)) text.new-line)
+ " Aliases: " (|> this-module (get@ #.module-aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (text.join-with separator)) text.new-line)
_
"")
- " All Known modules: " (|> compiler (get@ #.modules) (list//map product.left) (text.join-with separator)) text.new-line)))))))
+ " All Known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join-with separator)) text.new-line)))))))
(def: #export (find-export name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -446,15 +446,15 @@
[definition (..find-def name)]
(case definition
(#.Left de-aliased)
- (fail ($_ text//compose
+ (fail ($_ text\compose
"Aliases are not considered exports: "
- (name//encode name)))
+ (name\encode name)))
(#.Right definition)
(let [[exported? def-type def-data def-value] definition]
(if exported?
(wrap definition)
- (fail ($_ text//compose "Definition is not an export: " (name//encode name))))))))
+ (fail ($_ text\compose "Definition is not an export: " (name\encode name))))))))
(def: #export (find-def-type name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -499,7 +499,7 @@
(function (_ compiler)
(case (get module (get@ #.modules compiler))
#.None
- (#try.Failure ($_ text//compose "Unknown module: " module))
+ (#try.Failure ($_ text\compose "Unknown module: " module))
(#.Some module)
(#try.Success [compiler (get@ #.definitions module)]))))
@@ -578,14 +578,14 @@
(-> Text Text (Meta Bit))
(do ..monad
[(^slots [#.imports]) (..find-module module)]
- (wrap (list.any? (text//= import) imports))))
+ (wrap (list.any? (text\= import) imports))))
(def: #export (imported? import)
(-> Text (Meta Bit))
(let [(^open ".") ..monad]
(|> ..current-module-name
(map ..find-module) join
- (map (|>> (get@ #.imports) (list.any? (text//= import)))))))
+ (map (|>> (get@ #.imports) (list.any? (text\= import)))))))
(def: #export (resolve-tag tag)
{#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."}
@@ -597,17 +597,17 @@
imported! (..imported? module)]
(case (get name (get@ #.tags =module))
(#.Some [idx tag-list exported? type])
- (if (or (text//= this-module-name module)
+ (if (or (text\= this-module-name module)
(and imported! exported?))
(wrap [idx tag-list type])
- (..fail ($_ text//compose "Cannot access tag: " (name//encode tag) " from module " this-module-name)))
+ (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this-module-name)))
_
- (..fail ($_ text//compose
- "Unknown tag: " (name//encode tag) text.new-line
+ (..fail ($_ text\compose
+ "Unknown tag: " (name\encode tag) text.new-line
" Known tags: " (|> =module
(get@ #.tags)
- (list//map (|>> product.left [module] name//encode (text.prefix text.new-line)))
+ (list\map (|>> product.left [module] name\encode (text.prefix text.new-line)))
(text.join-with ""))
)))))
@@ -620,9 +620,9 @@
(wrap (|> (get@ #.types =module)
(list.filter (function (_ [type-name [tag-list exported? type]])
(or exported?
- (text//= this-module-name module))))
- (list//map (function (_ [type-name [tag-list exported? type]])
- [tag-list type]))))))
+ (text\= this-module-name module))))
+ (list\map (function (_ [type-name [tag-list exported? type]])
+ [tag-list type]))))))
(def: #export locals
{#.doc "All the local variables currently in scope, separated in different scopes."}
@@ -634,10 +634,10 @@
(#.Some scopes)
(#try.Success [compiler
- (list//map (|>> (get@ [#.locals #.mappings])
- (list//map (function (_ [name [type _]])
- [name type])))
- scopes)]))))
+ (list\map (|>> (get@ [#.locals #.mappings])
+ (list\map (function (_ [name [type _]])
+ [name type])))
+ scopes)]))))
(def: #export (un-alias def-name)
{#.doc "Given an aliased definition's name, returns the original definition being referenced."}
@@ -686,9 +686,9 @@
(do ..monad
[location ..location
output (<func> token)
- #let [_ (log! ($_ text//compose (name//encode (name-of <macro>)) " @ " (location.format location)))
- _ (list//map (|>> code.format log!)
- output)
+ #let [_ (log! ($_ text\compose (name\encode (name-of <macro>)) " @ " (location.format location)))
+ _ (list\map (|>> code.format log!)
+ output)
_ (log! "")]]
(wrap (if omit?
(list)
diff --git a/stdlib/source/lux/target/common-lisp.lux b/stdlib/source/lux/target/common-lisp.lux
index b1853a42f..38788c49a 100644
--- a/stdlib/source/lux/target/common-lisp.lux
+++ b/stdlib/source/lux/target/common-lisp.lux
@@ -8,7 +8,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." monad fold)]]]
+ ["." list ("#\." monad fold)]]]
[macro
["." template]]
[type
@@ -141,7 +141,7 @@
(def: #export args
(-> (List Var/1) Var/*)
- (|>> (list//map ..code)
+ (|>> (list\map ..code)
(text.join-with " ")
..as-form
:abstraction))
@@ -149,7 +149,7 @@
(def: #export (args& singles rest)
(-> (List Var/1) Var/1 Var/*)
(|> (format (|> singles
- (list//map ..code)
+ (list\map ..code)
(text.join-with " "))
" &rest " (:representation rest))
..as-form
@@ -157,7 +157,7 @@
(def: form
(-> (List (Expression Any)) Expression)
- (|>> (list//map ..code)
+ (|>> (list\map ..code)
(text.join-with " ")
..as-form
:abstraction))
@@ -178,9 +178,9 @@
(def: #export (labels definitions body)
(-> (List [Var/1 Lambda]) (Expression Any) (Computation Any))
(..form (list (..var "labels")
- (..form (list//map (function (_ [def-name [def-args def-body]])
- (..form (list def-name (:transmutation def-args) def-body)))
- definitions))
+ (..form (list\map (function (_ [def-name [def-args def-body]])
+ (..form (list def-name (:transmutation def-args) def-body)))
+ definitions))
body)))
(def: #export (destructuring-bind [bindings expression] body)
@@ -334,8 +334,8 @@
(-> (List [Var/1 (Expression Any)]) (Expression Any) (Computation Any))
(..form (list (..var <host-name>)
(|> bindings
- (list//map (function (_ [name value])
- (..form (list name value))))
+ (list\map (function (_ [name value])
+ (..form (list name value))))
..form)
body)))]
@@ -372,11 +372,11 @@
(-> (List Handler) (Expression Any) (Computation Any))
(..form (list& (..var "handler-case")
body
- (list//map (function (_ [type condition handler])
- (..form (list type
- (:transmutation (..args (list condition)))
- handler)))
- handlers))))
+ (list\map (function (_ [type condition handler])
+ (..form (list type
+ (:transmutation (..args (list condition)))
+ handler)))
+ handlers))))
(template [<name> <prefix>]
[(def: #export (<name> conditions expression)
@@ -391,7 +391,7 @@
_
(:abstraction
- (format <prefix> (|> conditions (list//map ..symbol)
+ (format <prefix> (|> conditions (list\map ..symbol)
(list& (..symbol "or")) ..form
:representation)
" " (:representation expression)))))]
@@ -413,10 +413,10 @@
(def: #export (cond clauses else)
(-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any))
- (list//fold (function (_ [test then] next)
- (..if test then next))
- (:transmutation else)
- (list.reverse clauses)))
+ (list\fold (function (_ [test then] next)
+ (..if test then next))
+ (:transmutation else)
+ (list.reverse clauses)))
)
(def: #export (while condition body)
diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux
index 41eba97bb..687a6d632 100644
--- a/stdlib/source/lux/target/js.lux
+++ b/stdlib/source/lux/target/js.lux
@@ -9,7 +9,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[macro
["." template]]
[type
@@ -110,7 +110,7 @@
(def: #export array
(-> (List Expression) Computation)
- (|>> (list//map ..code)
+ (|>> (list\map ..code)
(text.join-with ..argument-separator)
..element
:abstraction))
@@ -130,7 +130,7 @@
(def: #export (apply/* function inputs)
(-> Expression (List Expression) Computation)
(|> inputs
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..argument-separator)
..expression
(format (:representation function))
@@ -142,8 +142,8 @@
(def: #export object
(-> (List [Text Expression]) Computation)
- (|>> (list//map (.function (_ [key val])
- (format (:representation (..string key)) ..field-separator (:representation val))))
+ (|>> (list\map (.function (_ [key val])
+ (format (:representation (..string key)) ..field-separator (:representation val))))
(text.join-with ..argument-separator)
(text.enclose ["{" "}"])
..expression
@@ -175,7 +175,7 @@
..block
(format "function " (:representation name)
(|> inputs
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..argument-separator)
..expression)
" ")
@@ -194,7 +194,7 @@
..block
(format "function"
(|> inputs
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..argument-separator)
..expression)
" ")
@@ -276,7 +276,7 @@
(-> Expression (List Expression) Computation)
(|> (format "new " (:representation constructor)
(|> inputs
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..argument-separator)
..expression))
..expression
@@ -399,11 +399,11 @@
(-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement)
(:abstraction (format "switch (" (:representation input) ") "
(|> (format (|> cases
- (list//map (.function (_ [when then])
- (format (|> when
- (list//map (|>> :representation (text.enclose ["case " ":"])))
- (text.join-with text.new-line))
- (..nest (:representation then)))))
+ (list\map (.function (_ [when then])
+ (format (|> when
+ (list\map (|>> :representation (text.enclose ["case " ":"])))
+ (text.join-with text.new-line))
+ (..nest (:representation then)))))
(text.join-with text.new-line))
text.new-line
(case default
@@ -418,10 +418,10 @@
(def: #export (cond clauses else!)
(-> (List [Expression Statement]) Statement Statement)
- (list//fold (.function (_ [test then!] next!)
- (..if test then! next!))
- else!
- (list.reverse clauses)))
+ (list\fold (.function (_ [test then!] next!)
+ (..if test then! next!))
+ else!
+ (list.reverse clauses)))
(template [<apply> <arg>+ <type>+ <function>+]
[(`` (def: #export (<apply> function)
diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux
index 99ceeafb5..cf00f2b33 100644
--- a/stdlib/source/lux/target/jvm/attribute.lux
+++ b/stdlib/source/lux/target/jvm/attribute.lux
@@ -76,8 +76,8 @@
(-> Attribute Nat)
(case attribute
(^template [<tag>]
- (<tag> [name length info])
- (|> length //unsigned.value (n.+ ..common-attribute-length)))
+ [(<tag> [name length info])
+ (|> length //unsigned.value (n.+ ..common-attribute-length))])
([#Constant] [#Code])))
## TODO: Inline ASAP
diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux
index 012c25809..251eca660 100644
--- a/stdlib/source/lux/target/jvm/attribute/code.lux
+++ b/stdlib/source/lux/target/jvm/attribute/code.lux
@@ -8,9 +8,9 @@
[number
["n" nat]]
[format
- [".F" binary (#+ Writer) ("#//." monoid)]]
+ [".F" binary (#+ Writer) ("#\." monoid)]]
[collection
- ["." row (#+ Row) ("#//." functor fold)]]]]
+ ["." row (#+ Row) ("#\." functor fold)]]]]
["." /// #_
[bytecode
[environment
@@ -48,8 +48,8 @@
## attribute_info attributes[attributes_count];
(|> code
(get@ #attributes)
- (row//map length)
- (row//fold n.+ 0))))
+ (row\map length)
+ (row\fold n.+ 0))))
(def: #export (equivalence attribute-equivalence)
(All [attribute]
@@ -64,7 +64,7 @@
## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
(def: #export (writer writer code)
(All [Attribute] (-> (Writer Attribute) (Writer (Code Attribute))))
- ($_ binaryF//compose
+ ($_ binaryF\compose
## u2 max_stack;
## u2 max_locals;
(///limit.writer (get@ #limit code))
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 31b99e9cf..008610b11 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -20,7 +20,7 @@
["i" int]
["." i32 (#+ I32)]]
[collection
- ["." list ("#//." functor fold)]
+ ["." list ("#\." functor fold)]
["." dictionary (#+ Dictionary)]
["." row (#+ Row)]]]
[macro
@@ -28,7 +28,7 @@
["." / #_
["#." address (#+ Address)]
["#." jump (#+ Jump Big-Jump)]
- ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#//." monoid)]
+ ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#\." monoid)]
["#." environment (#+ Environment)
[limit
["/." registry (#+ Register Registry)]
@@ -93,7 +93,7 @@
[[left-exceptions left-instruction] (left resolver)
[right-exceptions right-instruction] (right resolver)]
(wrap [(:: row.monoid compose left-exceptions right-exceptions)
- (_//compose left-instruction right-instruction)]))))))
+ (_\compose left-instruction right-instruction)]))))))
(type: #export (Bytecode a)
(State' Try [Pool Environment Tracker] (Writer Relative a)))
@@ -467,7 +467,7 @@
(-> <type> (Bytecode Any))
(case (|> value <to-lux>)
(^template [<special> <instruction>]
- <special> (..bytecode $0 $1 @_ <instruction> []))
+ [<special> (..bytecode $0 $1 @_ <instruction> [])])
<specializations>
_ (do ..monad
@@ -517,7 +517,7 @@
(..arbitrary-float value)
(case (|> value host.float-to-double (:coerce Frac))
(^template [<special> <instruction>]
- <special> (..bytecode $0 $1 @_ <instruction> []))
+ [<special> (..bytecode $0 $1 @_ <instruction> [])])
([+0.0 _.fconst-0]
[+1.0 _.fconst-1]
[+2.0 _.fconst-2])
@@ -529,7 +529,7 @@
(-> <type> (Bytecode Any))
(case (|> value <to-lux>)
(^template [<special> <instruction>]
- <special> (..bytecode $0 $2 @_ <instruction> []))
+ [<special> (..bytecode $0 $2 @_ <instruction> [])])
<specializations>
_ (do ..monad
@@ -563,7 +563,7 @@
(..arbitrary-double value)
(case value
(^template [<special> <instruction>]
- <special> (..bytecode $0 $2 @_ <instruction> []))
+ [<special> (..bytecode $0 $2 @_ <instruction> [])])
([+0.0 _.dconst-0]
[+1.0 _.dconst-1])
@@ -843,7 +843,7 @@
(wrap (let [@from (get@ #program-counter tracker)]
[[pool
environment'
- (|> (list//fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards))
+ (|> (list\fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards))
(set@ #program-counter program-counter'))]
[(function (_ resolver)
(let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
@@ -886,7 +886,7 @@
(wrap (let [@from (get@ #program-counter tracker)]
[[pool
environment'
- (|> (list//fold (..acknowledge-label actual) tracker (list& default (list//map product.right cases)))
+ (|> (list\fold (..acknowledge-label actual) tracker (list& default (list\map product.right cases)))
(set@ #program-counter program-counter'))]
[(function (_ resolver)
(let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
@@ -903,7 +903,7 @@
[>default (:: ! map ..big-jump (..jump @from @default))
>cases (|> @cases
(monad.map ! (|>> (..jump @from) (:: ! map ..big-jump)))
- (:: ! map (|>> (list.zip/2 (list//map product.left cases)))))]
+ (:: ! map (|>> (list.zip/2 (list\map product.left cases)))))]
(wrap [..no-exceptions (bytecode >default >cases)]))
#.None
@@ -970,8 +970,8 @@
{#//constant/pool.name method
#//constant/pool.descriptor (type.descriptor type)})
#let [consumption (|> inputs
- (list//map ..type-size)
- (list//fold n.+ (if <static?> 0 1))
+ (list\map ..type-size)
+ (list\fold n.+ (if <static?> 0 1))
//unsigned.u1
try.assume)
production (|> output ..type-size //unsigned.u1 try.assume)]]
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux
index 7ca0f0e83..7b75c3593 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux
@@ -9,7 +9,7 @@
[number
["n" nat]]
["." format #_
- ["#" binary (#+ Writer) ("#//." monoid)]]]]
+ ["#" binary (#+ Writer) ("#\." monoid)]]]]
["." / #_
["#." stack (#+ Stack)]
["#." registry (#+ Registry)]
@@ -49,7 +49,7 @@
(def: #export (writer limit)
(Writer Limit)
- ($_ format//compose
+ ($_ format\compose
(/stack.writer (get@ #stack limit))
(/registry.writer (get@ #registry limit))
))
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
index c192a3fdd..0550897db 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
@@ -3,14 +3,14 @@
[abstract
["." equivalence (#+ Equivalence)]]
[control
- ["." try (#+ Try) ("#//." functor)]]
+ ["." try (#+ Try) ("#\." functor)]]
[data
[number
["n" nat]]
[format
[binary (#+ Writer)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[type
abstract]]
["." ///// #_
@@ -36,12 +36,12 @@
(-> (Type Method) Nat)
(let [[inputs output exceptions] (/////type/parser.method type)]
(|> inputs
- (list//map (function (_ input)
- (if (or (is? /////type.long input)
- (is? /////type.double input))
- ..wide
- ..normal)))
- (list//fold n.+ 0))))
+ (list\map (function (_ input)
+ (if (or (is? /////type.long input)
+ (is? /////type.double input))
+ ..wide
+ ..normal)))
+ (list\fold n.+ 0))))
(template [<start> <name>]
[(def: #export <name>
@@ -49,7 +49,7 @@
(|>> ..minimal
(n.+ <start>)
/////unsigned.u2
- (try//map ..registry)))]
+ (try\map ..registry)))]
[0 static]
[1 virtual]
diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux
index 08bd81e56..9ed001534 100644
--- a/stdlib/source/lux/target/jvm/class.lux
+++ b/stdlib/source/lux/target/jvm/class.lux
@@ -11,7 +11,7 @@
[number (#+)
[i64 (#+)]]
[format
- [".F" binary (#+ Writer) ("#//." monoid)]]
+ [".F" binary (#+ Writer) ("#\." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -115,7 +115,7 @@
(def: #export (writer class)
(Writer Class)
- (`` ($_ binaryF//compose
+ (`` ($_ binaryF\compose
(~~ (template [<writer> <slot>]
[(<writer> (get@ <slot> class))]
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index d62100634..894de4367 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -13,7 +13,7 @@
["." frac]]
["." text]
[format
- [".F" binary (#+ Writer) ("#//." monoid)]]
+ [".F" binary (#+ Writer) ("#\." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -175,8 +175,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <equivalence>]
- [(<tag> reference) (<tag> sample)]
- (:: <equivalence> = reference sample))
+ [[(<tag> reference) (<tag> sample)]
+ (:: <equivalence> = reference sample)])
([#UTF8 text.equivalence]
[#Integer (..value-equivalence i32.equivalence)]
[#Long (..value-equivalence int.equivalence)]
@@ -233,8 +233,8 @@
(function (_ value)
(case value
(^template [<case> <tag> <writer>]
- (<case> value)
- (binaryF//compose (/tag.writer <tag>)
- (<writer> value)))
+ [(<case> value)
+ (binaryF\compose (/tag.writer <tag>)
+ (<writer> value))])
(<constants>)
))))
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index 17e3f0302..b47eb51ab 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -15,9 +15,9 @@
["." frac]]
["." text]
["." format #_
- ["#" binary (#+ Writer) ("specification//." monoid)]]
+ ["#" binary (#+ Writer) ("specification\." monoid)]]
[collection
- ["." row (#+ Row) ("#//." fold)]]]
+ ["." row (#+ Row) ("#\." fold)]]]
[type
abstract]
[macro
@@ -144,10 +144,10 @@
(def: #export writer
(Writer Pool)
(function (_ [next pool])
- (row//fold (function (_ [_index post] pre)
- (specification//compose pre (//.writer post)))
- (format.bits/16 (!index next))
- pool)))
+ (row\fold (function (_ [_index post] pre)
+ (specification\compose pre (//.writer post)))
+ (format.bits/16 (!index next))
+ pool)))
(def: #export empty
Pool
diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux
index c5231ea26..f77469e82 100644
--- a/stdlib/source/lux/target/jvm/field.lux
+++ b/stdlib/source/lux/target/jvm/field.lux
@@ -8,7 +8,7 @@
[number (#+)
[i64 (#+)]]
[format
- [".F" binary (#+ Writer) ("#//." monoid)]]
+ [".F" binary (#+ Writer) ("#\." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -51,7 +51,7 @@
(def: #export (writer field)
(Writer Field)
- (`` ($_ binaryF//compose
+ (`` ($_ binaryF\compose
(~~ (template [<writer> <slot>]
[(<writer> (get@ <slot> field))]
diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux
index 823cb1e11..2fcf44784 100644
--- a/stdlib/source/lux/target/jvm/method.lux
+++ b/stdlib/source/lux/target/jvm/method.lux
@@ -10,7 +10,7 @@
[number (#+)
[i64 (#+)]]
["." format #_
- ["#" binary (#+ Writer) ("#//." monoid)]]
+ ["#" binary (#+ Writer) ("#\." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -95,7 +95,7 @@
(def: #export (writer field)
(Writer Method)
- (`` ($_ format//compose
+ (`` ($_ format\compose
(~~ (template [<writer> <slot>]
[(<writer> (get@ <slot> field))]
diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux
index b87230b07..12c310bca 100644
--- a/stdlib/source/lux/target/jvm/reflection.lux
+++ b/stdlib/source/lux/target/jvm/reflection.lux
@@ -12,10 +12,10 @@
[data
[number
["n" nat]]
- ["." text ("#//." equivalence)
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
- ["." list ("#//." fold functor)]
+ ["." list ("#\." fold functor)]
["." array]
["." dictionary]]]]
["." // #_
@@ -131,8 +131,8 @@
(:coerce (java/lang/Class java/lang/Object))
java/lang/Class::getName)]
(`` (if (or (~~ (template [<reflection>]
- [(text//= (/reflection.reflection <reflection>)
- class-name)]
+ [(text\= (/reflection.reflection <reflection>)
+ class-name)]
[/reflection.boolean]
[/reflection.byte]
@@ -180,15 +180,15 @@
(case [(array.read 0 (java/lang/reflect/WildcardType::getLowerBounds reflection))
(array.read 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))]
(^template [<pattern> <kind>]
- <pattern>
- (case (host.check java/lang/reflect/GenericArrayType bound)
- (#.Some _)
- ## TODO: Array bounds should not be "erased" as they
- ## are right now.
- (#try.Success /.wildcard)
-
- _
- (:: try.monad map <kind> (..class' parameter bound))))
+ [<pattern>
+ (case (host.check java/lang/reflect/GenericArrayType bound)
+ (#.Some _)
+ ## TODO: Array bounds should not be "erased" as they
+ ## are right now.
+ (#try.Success /.wildcard)
+
+ _
+ (:: try.monad map <kind> (..class' parameter bound)))])
([[_ (#.Some bound)] /.upper]
[[(#.Some bound) _] /.lower])
@@ -210,8 +210,8 @@
(:coerce (java/lang/Class java/lang/Object))
java/lang/Class::getName)]
(`` (cond (~~ (template [<reflection> <type>]
- [(text//= (/reflection.reflection <reflection>)
- class-name)
+ [(text\= (/reflection.reflection <reflection>)
+ class-name)
(#try.Success <type>)]
[/reflection.boolean /.boolean]
@@ -244,8 +244,8 @@
(let [class-name (|> reflection
(:coerce (java/lang/Class java/lang/Object))
java/lang/Class::getName)]
- (if (text//= (/reflection.reflection /reflection.void)
- class-name)
+ (if (text\= (/reflection.reflection /reflection.void)
+ class-name)
(#try.Success /.void)
<else>))
@@ -280,14 +280,14 @@
class-params (array.to-list (java/lang/Class::getTypeParameters class))
num-class-params (list.size class-params)
num-type-params (list.size params)]
- (if (text//= class-name name)
+ (if (text\= class-name name)
(if (n.= num-class-params num-type-params)
(|> params
- (list.zip/2 (list//map (|>> java/lang/reflect/TypeVariable::getName)
- class-params))
- (list//fold (function (_ [name paramT] mapping)
- (dictionary.put name paramT mapping))
- /lux.fresh)
+ (list.zip/2 (list\map (|>> java/lang/reflect/TypeVariable::getName)
+ class-params))
+ (list\fold (function (_ [name paramT] mapping)
+ (dictionary.put name paramT mapping))
+ /lux.fresh)
#try.Success)
(exception.throw ..type-parameter-mismatch [num-class-params num-type-params class type]))
(exception.throw ..cannot-correspond [class type])))
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index 9dbcb12c2..389bc5559 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -10,7 +10,7 @@
[number
["n" nat]]
[collection
- ["." list ("#//." functor)]]]
+ ["." list ("#\." functor)]]]
[type
abstract]]
["." // #_
@@ -79,14 +79,14 @@
(def: #export (class name parameters)
(-> External (List (Type Parameter)) (Type Class))
(:abstraction
- [(/signature.class name (list//map ..signature parameters))
+ [(/signature.class name (list\map ..signature parameters))
(/descriptor.class name)
(/reflection.class name)]))
(def: #export (declaration name variables)
(-> External (List (Type Var)) (Type Declaration))
(:abstraction
- [(/signature.declaration name (list//map ..signature variables))
+ [(/signature.declaration name (list\map ..signature variables))
(/descriptor.declaration name)
(/reflection.declaration name)]))
@@ -134,10 +134,10 @@
(List (Type Class))]
(Type Method))
(:abstraction
- [(/signature.method [(list//map ..signature inputs)
+ [(/signature.method [(list\map ..signature inputs)
(..signature output)
- (list//map ..signature exceptions)])
- (/descriptor.method [(list//map ..descriptor inputs)
+ (list\map ..signature exceptions)])
+ (/descriptor.method [(list\map ..descriptor inputs)
(..descriptor output)])
(:assume ..void)]))
diff --git a/stdlib/source/lux/target/jvm/type/descriptor.lux b/stdlib/source/lux/target/jvm/type/descriptor.lux
index 27e44ec7f..88feb606f 100644
--- a/stdlib/source/lux/target/jvm/type/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/type/descriptor.lux
@@ -6,10 +6,10 @@
["." maybe]
[number
["n" nat]]
- ["." text ("#//." equivalence)
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor)]]]
+ ["." list ("#\." functor)]]]
[type
abstract]]
["." // #_
@@ -92,7 +92,7 @@
(Descriptor Method))
(:abstraction
(format (|> inputs
- (list//map ..descriptor)
+ (list\map ..descriptor)
(text.join-with "")
(text.enclose ["(" ")"]))
(:representation output))))
@@ -101,7 +101,7 @@
(All [category] (Equivalence (Descriptor category)))
(def: (= parameter subject)
- (text//= (:representation parameter) (:representation subject))))
+ (text\= (:representation parameter) (:representation subject))))
(def: #export class-name
(-> (Descriptor Object) Internal)
diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux
index cbaf50a99..44562bb1a 100644
--- a/stdlib/source/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/lux/target/jvm/type/lux.lux
@@ -5,18 +5,18 @@
[control
["." try]
["." exception (#+ exception:)]
- ["<>" parser ("#//." monad)
+ ["<>" parser ("#\." monad)
["<t>" text (#+ Parser)]]]
[data
["." product]
- ["." text ("#//." equivalence)
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
["." array]
["." dictionary (#+ Dictionary)]]]
[type
abstract
- ["." check (#+ Check) ("#//." monad)]]]
+ ["." check (#+ Check) ("#\." monad)]]]
["." //
[category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
["#." descriptor]
@@ -47,13 +47,13 @@
(def: void
(Parser (Check Type))
(<>.after //parser.void
- (<>//wrap (check//wrap .Any))))
+ (<>\wrap (check\wrap .Any))))
(template [<name> <parser> <reflection>]
[(def: <name>
(Parser (Check Type))
(<>.after <parser>
- (<>//wrap (check//wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))]
+ (<>\wrap (check\wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))]
[boolean //parser.boolean //reflection.boolean]
[byte //parser.byte //reflection.byte]
@@ -81,8 +81,8 @@
(def: wildcard
(Parser (Check Type))
(<>.after //parser.wildcard
- (<>//wrap (check//map product.right
- check.existential))))
+ (<>\wrap (check\map product.right
+ check.existential))))
(def: (var mapping)
(-> Mapping (Parser (Check Type)))
@@ -93,7 +93,7 @@
(check.throw ..unknown-var [var])
(#.Some type)
- (check//wrap type)))))
+ (check\wrap type)))))
(def: (class' parameter)
(-> (Parser (Check Type)) (Parser (Check Type)))
@@ -114,7 +114,7 @@
(-> (Parser (Check Type)) (Parser (Check Type)))
(|> (<>.after (<t>.this <prefix>))
## TODO: Re-enable Lower and Upper, instead of using the simplified limit.
- ## (<>//map (check//map (|>> <ctor> .type)))
+ ## (<>\map (check\map (|>> <ctor> .type)))
))]
[lower //signature.lower-prefix ..Lower]
@@ -140,25 +140,25 @@
(def: array
(-> (Parser (Check Type)) (Parser (Check Type)))
- (|>> (<>//map (check//map (function (_ elementT)
- (case elementT
- (#.Primitive name #.Nil)
- (if (`` (or (~~ (template [<reflection>]
- [(text//= (//reflection.reflection <reflection>) name)]
-
- [//reflection.boolean]
- [//reflection.byte]
- [//reflection.short]
- [//reflection.int]
- [//reflection.long]
- [//reflection.float]
- [//reflection.double]
- [//reflection.char]))))
- (#.Primitive (|> name //reflection.class //reflection.array //reflection.reflection) #.Nil)
- (|> elementT array.Array .type))
-
- _
- (|> elementT array.Array .type)))))
+ (|>> (<>\map (check\map (function (_ elementT)
+ (case elementT
+ (#.Primitive name #.Nil)
+ (if (`` (or (~~ (template [<reflection>]
+ [(text\= (//reflection.reflection <reflection>) name)]
+
+ [//reflection.boolean]
+ [//reflection.byte]
+ [//reflection.short]
+ [//reflection.int]
+ [//reflection.long]
+ [//reflection.float]
+ [//reflection.double]
+ [//reflection.char]))))
+ (#.Primitive (|> name //reflection.class //reflection.array //reflection.reflection) #.Nil)
+ (|> elementT array.Array .type))
+
+ _
+ (|> elementT array.Array .type)))))
(<>.after (<t>.this //descriptor.array-prefix))))
(def: #export (type mapping)
diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux
index d57bd41a3..db1c018b8 100644
--- a/stdlib/source/lux/target/jvm/type/parser.lux
+++ b/stdlib/source/lux/target/jvm/type/parser.lux
@@ -5,7 +5,7 @@
[control
["." try]
["." function]
- ["<>" parser ("#//." monad)
+ ["<>" parser ("#\." monad)
["<t>" text (#+ Parser)]]]
[data
["." product]
@@ -25,7 +25,7 @@
[(def: #export <name>
(Parser (Type <category>))
(<>.after (<t>.this (//signature.signature <signature>))
- (<>//wrap <type>)))]
+ (<>\wrap <type>)))]
[Void void //signature.void //.void]
[Primitive boolean //signature.boolean //.boolean]
@@ -86,7 +86,7 @@
(def: #export var
(Parser (Type Var))
- (<>//map //.var ..var'))
+ (<>\map //.var ..var'))
(def: #export var?
(-> (Type Value) (Maybe Text))
@@ -106,7 +106,7 @@
[(def: <name>
(-> (Parser (Type Class)) (Parser (Type Parameter)))
(|>> (<>.after (<t>.this <prefix>))
- (<>//map <constructor>)))]
+ (<>\map <constructor>)))]
[lower //signature.lower-prefix //.lower]
[upper //signature.upper-prefix //.upper]
@@ -145,7 +145,7 @@
(def: #export array'
(-> (Parser (Type Value)) (Parser (Type Array)))
(|>> (<>.after (<t>.this //descriptor.array-prefix))
- (<>//map //.array)))
+ (<>\map //.array)))
(def: #export class
(Parser (Type Class))
diff --git a/stdlib/source/lux/target/jvm/type/reflection.lux b/stdlib/source/lux/target/jvm/type/reflection.lux
index a0e0b0f5e..b21451d93 100644
--- a/stdlib/source/lux/target/jvm/type/reflection.lux
+++ b/stdlib/source/lux/target/jvm/type/reflection.lux
@@ -3,7 +3,7 @@
[abstract
[equivalence (#+ Equivalence)]]
[data
- ["." text ("#//." equivalence)
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]]
[type
abstract]]
@@ -25,7 +25,7 @@
(All [category] (Equivalence (Reflection category)))
(def: (= parameter subject)
- (text//= (:representation parameter) (:representation subject))))
+ (text\= (:representation parameter) (:representation subject))))
(template [<category> <name> <reflection>]
[(def: #export <name>
diff --git a/stdlib/source/lux/target/jvm/type/signature.lux b/stdlib/source/lux/target/jvm/type/signature.lux
index 2fc8aa7c7..eb4253c7a 100644
--- a/stdlib/source/lux/target/jvm/type/signature.lux
+++ b/stdlib/source/lux/target/jvm/type/signature.lux
@@ -4,10 +4,10 @@
[equivalence (#+ Equivalence)]
[hash (#+ Hash)]]
[data
- ["." text ("#//." hash)
+ ["." text ("#\." hash)
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor)]]]
+ ["." list ("#\." functor)]]]
[type
abstract]]
["." // #_
@@ -84,7 +84,7 @@
_
(format ..parameters-start
(|> parameters
- (list//map ..signature)
+ (list\map ..signature)
(text.join-with ""))
..parameters-end))
//descriptor.class-suffix)))
@@ -109,25 +109,25 @@
(Signature Method))
(:abstraction
(format (|> inputs
- (list//map ..signature)
+ (list\map ..signature)
(text.join-with "")
(text.enclose [..arguments-start
..arguments-end]))
(:representation output)
(|> exceptions
- (list//map (|>> :representation (format ..exception-prefix)))
+ (list\map (|>> :representation (format ..exception-prefix)))
(text.join-with "")))))
(structure: #export equivalence
(All [category] (Equivalence (Signature category)))
(def: (= parameter subject)
- (text//= (:representation parameter)
- (:representation subject))))
+ (text\= (:representation parameter)
+ (:representation subject))))
(structure: #export hash
(All [category] (Hash (Signature category)))
(def: &equivalence ..equivalence)
- (def: hash (|>> :representation text//hash)))
+ (def: hash (|>> :representation text\hash)))
)
diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux
index 68c961ef7..fe4d0eb92 100644
--- a/stdlib/source/lux/target/lua.lux
+++ b/stdlib/source/lux/target/lua.lux
@@ -11,7 +11,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[macro
["." template]
["." code]
@@ -114,15 +114,15 @@
(def: #export array
(-> (List (Expression Any)) Literal)
- (|>> (list//map ..code)
+ (|>> (list\map ..code)
(text.join-with ..input-separator)
(text.enclose ["{" "}"])
:abstraction))
(def: #export table
(-> (List [Text (Expression Any)]) Literal)
- (|>> (list//map (.function (_ [key value])
- (format key " = " (:representation value))))
+ (|>> (list\map (.function (_ [key value])
+ (format key " = " (:representation value))))
(text.join-with ..input-separator)
(text.enclose ["{" "}"])
:abstraction))
@@ -144,7 +144,7 @@
(def: #export (apply/* args func)
(-> (List (Expression Any)) (Expression Any) (Computation Any))
(|> args
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..input-separator)
(text.enclose ["(" ")"])
(format (:representation func))
@@ -153,7 +153,7 @@
(def: #export (do method table args)
(-> Text (Expression Any) (List (Expression Any)) (Computation Any))
(|> args
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..input-separator)
(text.enclose ["(" ")"])
(format (:representation table) ":" method)
@@ -212,7 +212,7 @@
(def: locations
(-> (List (Location Any)) Text)
- (|>> (list//map ..code)
+ (|>> (list\map ..code)
(text.join-with ..input-separator)))
(def: #export (local vars)
@@ -253,7 +253,7 @@
(-> (List Var) (Expression Any) Statement Statement)
(:abstraction
(format "for " (|> vars
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..input-separator))
" in " (:representation source) " do"
(..nest (:representation body!))
@@ -303,7 +303,7 @@
(def: #export (cond clauses else!)
(-> (List [(Expression Any) Statement]) Statement Statement)
- (list//fold (.function (_ [test then!] next!)
- (..if test then! next!))
- else!
- (list.reverse clauses)))
+ (list\fold (.function (_ [test then!] next!)
+ (..if test then! next!))
+ else!
+ (list.reverse clauses)))
diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux
index 67a893bab..d0622f6c8 100644
--- a/stdlib/source/lux/target/php.lux
+++ b/stdlib/source/lux/target/php.lux
@@ -8,7 +8,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[macro
["." template]]
[type
@@ -137,7 +137,7 @@
(def: arguments
(-> (List (Expression Any)) Text)
- (|>> (list//map ..code) (text.join-with ..input-separator) ..group))
+ (|>> (list\map ..code) (text.join-with ..input-separator) ..group))
(def: #export (apply/* args func)
(-> (List (Expression Any)) (Expression Any) (Computation Any))
@@ -146,10 +146,10 @@
(def: parameters
(-> (List Argument) Text)
- (|>> (list//map (function (_ [reference? var])
- (.if reference?
- (format "&" (:representation var))
- (:representation var))))
+ (|>> (list\map (function (_ [reference? var])
+ (.if reference?
+ (format "&" (:representation var))
+ (:representation var))))
(text.join-with ..input-separator)
..group))
@@ -220,7 +220,7 @@
(def: #export (array/* values)
(-> (List (Expression Any)) Literal)
(|> values
- (list//map ..code)
+ (list\map ..code)
(text.join-with ..input-separator)
..group
(format "array")
@@ -233,8 +233,8 @@
(def: #export (array/** kvs)
(-> (List [(Expression Any) (Expression Any)]) Literal)
(|> kvs
- (list//map (function (_ [key value])
- (format (:representation key) " => " (:representation value))))
+ (list\map (function (_ [key value])
+ (format (:representation key) " => " (:representation value))))
(text.join-with ..input-separator)
..group
(format "array")
@@ -386,7 +386,7 @@
(format "try " (..block (:representation body!))
text.new-line
(|> excepts
- (list//map catch)
+ (list\map catch)
(text.join-with text.new-line)))))
(template [<name> <keyword>]
@@ -432,10 +432,10 @@
(def: #export (cond clauses else!)
(-> (List [(Expression Any) Statement]) Statement Statement)
- (list//fold (function (_ [test then!] next!)
- (..if test then! next!))
- else!
- (list.reverse clauses)))
+ (list\fold (function (_ [test then!] next!)
+ (..if test then! next!))
+ else!
+ (list.reverse clauses)))
(def: #export command-line-arguments
Var
diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux
index 393ac68cf..b71947d0b 100644
--- a/stdlib/source/lux/target/python.lux
+++ b/stdlib/source/lux/target/python.lux
@@ -13,7 +13,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[macro
["." template]
["." code]
@@ -151,7 +151,7 @@
..expression
(format left-delimiter
(|> entries
- (list//map entry-serializer)
+ (list\map entry-serializer)
(text.join-with ", "))
right-delimiter))))
@@ -184,7 +184,7 @@
(-> (Expression Any) (List (Expression Any)) (Computation Any))
(<| :abstraction
..expression
- (format (:representation func) "(" (text.join-with ", " (list//map ..code args)) ")")))
+ (format (:representation func) "(" (text.join-with ", " (list\map ..code args)) ")")))
(template [<name> <brand> <prefix>]
[(def: (<name> var)
@@ -202,7 +202,7 @@
..expression
(format (:representation func)
(format "(" (|> args
- (list//map (function (_ arg) (format (:representation arg) ", ")))
+ (list\map (function (_ arg) (format (:representation arg) ", ")))
(text.join-with ""))
(<splat> extra) ")"))))]
@@ -277,13 +277,13 @@
(-> (List (Var Any)) (Expression Any) (Computation Any))
(<| :abstraction
..expression
- (format "lambda " (|> arguments (list//map ..code) (text.join-with ", ")) ": "
+ (format "lambda " (|> arguments (list\map ..code) (text.join-with ", ")) ": "
(:representation body))))
(def: #export (set vars value)
(-> (List (Location Any)) (Expression Any) (Statement Any))
(:abstraction
- (format (|> vars (list//map ..code) (text.join-with ", "))
+ (format (|> vars (list\map ..code) (text.join-with ", "))
" = "
(:representation value))))
@@ -352,10 +352,10 @@
(format "try:"
(..nest (:representation body!))
(|> excepts
- (list//map (function (_ [classes exception catch!])
- (format text.new-line "except (" (text.join-with ", " (list//map ..code classes))
- ") as " (:representation exception) ":"
- (..nest (:representation catch!)))))
+ (list\map (function (_ [classes exception catch!])
+ (format text.new-line "except (" (text.join-with ", " (list\map ..code classes))
+ ") as " (:representation exception) ":"
+ (..nest (:representation catch!)))))
(text.join-with "")))))
(template [<name> <keyword>]
@@ -373,7 +373,7 @@
(-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any))
(:abstraction
(format "def " (:representation name)
- "(" (|> args (list//map ..code) (text.join-with ", ")) "):"
+ "(" (|> args (list\map ..code) (text.join-with ", ")) "):"
(..nest (:representation body)))))
(def: #export (import module-name)
@@ -388,17 +388,17 @@
(def: #export (cond clauses else!)
(-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any))
- (list//fold (.function (_ [test then!] next!)
- (..if test then! next!))
- else!
- (list.reverse clauses)))
+ (list\fold (.function (_ [test then!] next!)
+ (..if test then! next!))
+ else!
+ (list.reverse clauses)))
(syntax: (arity-inputs {arity s.nat})
(wrap (case arity
0 (.list)
_ (|> (dec arity)
(enum.range n.enum 0)
- (list//map (|>> %.nat code.local-identifier))))))
+ (list\map (|>> %.nat code.local-identifier))))))
(syntax: (arity-types {arity s.nat})
(wrap (list.repeat arity (` (Expression Any)))))
diff --git a/stdlib/source/lux/target/ruby.lux b/stdlib/source/lux/target/ruby.lux
index 21ac6f73d..e1df6bba6 100644
--- a/stdlib/source/lux/target/ruby.lux
+++ b/stdlib/source/lux/target/ruby.lux
@@ -8,7 +8,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[macro
["." template]]
[type
@@ -171,15 +171,15 @@
(def: #export array
(-> (List (Expression Any)) Literal)
- (|>> (list//map (|>> :representation))
+ (|>> (list\map (|>> :representation))
(text.join-with ..input-separator)
(text.enclose ["[" "]"])
:abstraction))
(def: #export hash
(-> (List [(Expression Any) (Expression Any)]) Literal)
- (|>> (list//map (.function (_ [k v])
- (format (:representation k) " => " (:representation v))))
+ (|>> (list\map (.function (_ [k v])
+ (format (:representation k) " => " (:representation v))))
(text.join-with ..input-separator)
(text.enclose ["{" "}"])
:abstraction))
@@ -187,7 +187,7 @@
(def: #export (apply/* args func)
(-> (List (Expression Any)) (Expression Any) (Computation Any))
(|> args
- (list//map (|>> :representation))
+ (list\map (|>> :representation))
(text.join-with ..input-separator)
(text.enclose ["(" ")"])
(format (:representation func))
@@ -229,7 +229,7 @@
(-> (List (Location Any)) (Expression Any) (Statement Any))
(:abstraction
(format (|> vars
- (list//map (|>> :representation))
+ (list\map (|>> :representation))
(text.join-with ..input-separator))
" = " (:representation value) ..statement-suffix)))
@@ -280,10 +280,10 @@
(format "begin"
text.new-line (:representation body!)
(|> rescues
- (list//map (.function (_ [classes exception rescue])
- (format text.new-line "rescue " (text.join-with ..input-separator classes)
- " => " (:representation exception)
- text.new-line (..nest (:representation rescue)))))
+ (list\map (.function (_ [classes exception rescue])
+ (format text.new-line "rescue " (text.join-with ..input-separator classes)
+ " => " (:representation exception)
+ text.new-line (..nest (:representation rescue)))))
(text.join-with text.new-line)))))
(def: #export (return value)
@@ -312,7 +312,7 @@
..block
(format "def " (:representation name)
(|> args
- (list//map (|>> :representation))
+ (list\map (|>> :representation))
(text.join-with ..input-separator)
(text.enclose ["(" ")"]))
text.new-line (:representation body!))))
@@ -320,7 +320,7 @@
(def: #export (lambda name args body!)
(-> (Maybe LVar) (List (Var Any)) (Statement Any) Literal)
(let [proc (|> (format (|> args
- (list//map (|>> :representation))
+ (list\map (|>> :representation))
(text.join-with ..input-separator)
(text.enclose' "|"))
" "
@@ -380,7 +380,7 @@
(def: #export (cond clauses else!)
(-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any))
- (list//fold (.function (_ [test then!] next!)
- (..if test then! next!))
- else!
- (list.reverse clauses)))
+ (list\fold (.function (_ [test then!] next!)
+ (..if test then! next!))
+ else!
+ (list.reverse clauses)))
diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux
index 342338450..b5cf7c76d 100644
--- a/stdlib/source/lux/target/scheme.lux
+++ b/stdlib/source/lux/target/scheme.lux
@@ -8,7 +8,7 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]]]
+ ["." list ("#\." functor fold)]]]
[macro
["." template]]
[type
@@ -52,14 +52,14 @@
_
(|> (format " . " (:representation rest))
(format (|> mandatory
- (list//map ..code)
+ (list\map ..code)
(text.join-with " ")))
(text.enclose ["(" ")"])
:abstraction))
#.None
(|> mandatory
- (list//map ..code)
+ (list\map ..code)
(text.join-with " ")
(text.enclose ["(" ")"])
:abstraction)))
@@ -127,7 +127,7 @@
(def: form
(-> (List (Code Any)) Code)
- (|>> (list//map ..code)
+ (|>> (list\map ..code)
(text.join-with " ")
(text.enclose ["(" ")"])
:abstraction))
@@ -264,9 +264,9 @@
(-> (List [<var> Expression]) Expression Computation)
(..form (list (..global <scheme-name>)
(|> bindings
- (list//map (.function (_ [binding/name binding/value])
- (..form (list (|> binding/name <pre>)
- binding/value))))
+ (list\map (.function (_ [binding/name binding/value])
+ (..form (list (|> binding/name <pre>)
+ binding/value))))
..form)
body)))]
@@ -288,10 +288,10 @@
(def: #export (cond clauses else)
(-> (List [Expression Expression]) Expression Computation)
- (|> (list//fold (.function (_ [test then] next)
- (if test then next))
- else
- (list.reverse clauses))
+ (|> (list\fold (.function (_ [test then] next)
+ (if test then next))
+ else
+ (list.reverse clauses))
:representation
:abstraction))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 24b05c1fa..7eaa97342 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -7,7 +7,7 @@
["." exception (#+ exception:)]
["." io]
[concurrency
- ["." promise (#+ Promise) ("#//." monad)]]
+ ["." promise (#+ Promise) ("#\." monad)]]
["<>" parser
["<c>" code]]]
[data
@@ -20,13 +20,13 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor fold)]
+ ["." list ("#\." functor fold)]
["." set (#+ Set)]]]
[time
["." instant]
["." duration (#+ Duration)]]
[math
- ["." random (#+ Random) ("#//." monad)]]
+ ["." random (#+ Random) ("#\." monad)]]
["." meta]
[macro
[syntax (#+ syntax:)]
@@ -90,12 +90,12 @@
(def: #export (context description)
(-> Text Test Test)
- (random//map (promise//map (function (_ [counters documentation])
- [counters (|> documentation
- (text.split-all-with ..separator)
- (list//map (|>> (format context-prefix)))
- (text.join-with ..separator)
- (format description ..separator))]))))
+ (random\map (promise\map (function (_ [counters documentation])
+ [counters (|> documentation
+ (text.split-all-with ..separator)
+ (list\map (|>> (format context-prefix)))
+ (text.join-with ..separator)
+ (format description ..separator))]))))
(def: failure-prefix "[Failure] ")
(def: success-prefix "[Success] ")
@@ -104,13 +104,13 @@
(-> Text Test)
(|>> (format ..failure-prefix)
[failure]
- promise//wrap
- random//wrap))
+ promise\wrap
+ random\wrap))
(def: #export (assert message condition)
{#.doc "Check that a condition is #1, and fail with the given message otherwise."}
(-> Text Bit Assertion)
- (<| promise//wrap
+ (<| promise\wrap
(if condition
[success (format ..success-prefix message)]
[failure (format ..failure-prefix message)])))
@@ -239,13 +239,13 @@
(def: (claim' coverage condition)
(-> (List Name) Bit Assertion)
(let [message (|> coverage
- (list//map %.name)
+ (list\map %.name)
(text.join-with " & "))
coverage (set.from-list name.hash coverage)]
(|> (..assert message condition)
- (promise//map (function (_ [counters documentation])
- [(update@ #actual-coverage (set.union coverage) counters)
- documentation])))))
+ (promise\map (function (_ [counters documentation])
+ [(update@ #actual-coverage (set.union coverage) counters)
+ documentation])))))
(def: (cover' coverage condition)
(-> (List Name) Bit Test)
@@ -255,13 +255,13 @@
(def: (with-cover' coverage test)
(-> (List Name) Test Test)
(let [context (|> coverage
- (list//map %.name)
+ (list\map %.name)
(text.join-with " & "))
coverage (set.from-list name.hash coverage)]
- (random//map (promise//map (function (_ [counters documentation])
- [(update@ #actual-coverage (set.union coverage) counters)
- documentation]))
- (..context context test))))
+ (random\map (promise\map (function (_ [counters documentation])
+ [(update@ #actual-coverage (set.union coverage) counters)
+ documentation]))
+ (..context context test))))
(def: (name-code name)
(-> Name Code)
@@ -276,9 +276,9 @@
(template [<macro> <function>]
[(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))}
condition)
- (let [coverage (list//map (function (_ definition)
- (` ((~! ..reference) (~ definition))))
- coverage)]
+ (let [coverage (list\map (function (_ definition)
+ (` ((~! ..reference) (~ definition))))
+ coverage)]
(wrap (list (` ((~! <function>)
(: (.List .Name)
(.list (~+ coverage)))
@@ -290,9 +290,9 @@
(syntax: #export (with-cover {coverage (<c>.tuple (<>.many <c>.any))}
test)
- (let [coverage (list//map (function (_ definition)
- (` ((~! ..reference) (~ definition))))
- coverage)]
+ (let [coverage (list\map (function (_ definition)
+ (` ((~! ..reference) (~ definition))))
+ coverage)]
(wrap (list (` ((~! ..with-cover')
(: (.List .Name)
(.list (~+ coverage)))
@@ -306,12 +306,12 @@
(-> Text Text Test Test)
(let [coverage (|> coverage
(text.split-all-with ..coverage-separator)
- (list//map (|>> [module]))
+ (list\map (|>> [module]))
(set.from-list name.hash))]
(|> (..context module test)
- (random//map (promise//map (function (_ [counters documentation])
- [(update@ #expected-coverage (set.union coverage) counters)
- documentation]))))))
+ (random\map (promise\map (function (_ [counters documentation])
+ [(update@ #expected-coverage (set.union coverage) counters)
+ documentation]))))))
(syntax: #export (covering {module <c>.identifier}
test)
@@ -320,7 +320,7 @@
definitions (meta.definitions module)
#let [coverage (|> definitions
(list.filter (|>> product.right product.left))
- (list//map product.left)
+ (list\map product.left)
(text.join-with ..coverage-separator))]]
(wrap (list (` ((~! ..covering')
(~ (code.text module))
@@ -350,12 +350,12 @@
(..assert (exception.construct ..error-during-execution [error]) false))
io.io
promise.future
- promise//join)))]]
+ promise\join)))]]
(wrap (do {! promise.monad}
- [assertions (monad.seq ! (list//map run! tests))]
+ [assertions (monad.seq ! (list\map run! tests))]
(wrap [(|> assertions
- (list//map product.left)
- (list//fold ..add-counters ..start))
+ (list\map product.left)
+ (list\fold ..add-counters ..start))
(|> assertions
- (list//map product.right)
+ (list\map product.right)
(text.join-with ..separator))])))))
diff --git a/stdlib/source/lux/time/day.lux b/stdlib/source/lux/time/day.lux
index 3e7098e4c..3011e841c 100644
--- a/stdlib/source/lux/time/day.lux
+++ b/stdlib/source/lux/time/day.lux
@@ -23,8 +23,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
- [<tag> <tag>]
- #1)
+ [[<tag> <tag>]
+ #1])
([#Sunday]
[#Monday]
[#Tuesday]
diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux
index 5baa8efa9..41c85e981 100644
--- a/stdlib/source/lux/time/month.lux
+++ b/stdlib/source/lux/time/month.lux
@@ -28,8 +28,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
- [<tag> <tag>]
- true)
+ [[<tag> <tag>]
+ true])
([#January]
[#February]
[#March]
@@ -109,7 +109,7 @@
(-> Month Nat)
(case month
(^template [<days> <month>]
- <month> <days>)
+ [<month> <days>])
([31 #January]
[28 #February]
[31 #March]
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 441be4bed..43614dce3 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -9,13 +9,13 @@
[data
[binary (#+ Binary)]
["." product]
- ["." text ("#//." hash)
+ ["." text ("#\." hash)
["%" format (#+ format)]]
[collection
- ["." list ("#//." functor)]
+ ["." list ("#\." functor)]
["." dictionary]
["." set]
- ["." row ("#//." functor)]]]
+ ["." row ("#\." functor)]]]
["." meta]
[world
["." file]]]
@@ -208,7 +208,7 @@
(def: (default-dependencies prelude input)
(-> Module ///.Input (List Module))
(list& archive.runtime-module
- (if (text//= prelude (get@ #///.module input))
+ (if (text\= prelude (get@ #///.module input))
(list)
(list prelude))))
@@ -226,7 +226,7 @@
{#///.dependencies dependencies
#///.process (function (_ state archive)
(do {! try.monad}
- [#let [hash (text//hash (get@ #///.code input))]
+ [#let [hash (text\hash (get@ #///.code input))]
[state [source buffer]] (<| (///phase.run' state)
(..begin dependencies hash input))
#let [module (get@ #///.module input)]]
@@ -247,15 +247,15 @@
(wrap [state
(#.Right [[descriptor (document.write key analysis-module)]
(|> final-buffer
- (row//map (function (_ [name directive])
- [name (write-directive directive)])))])]))
+ (row\map (function (_ [name directive])
+ [name (write-directive directive)])))])]))
(#.Some [source requirements temporary-payload])
(let [[temporary-buffer temporary-registry] temporary-payload]
(wrap [state
(#.Left {#///.dependencies (|> requirements
(get@ #///directive.imports)
- (list//map product.left))
+ (list\map product.left))
#///.process (function (_ state archive)
(recur (<| (///phase.run' state)
(do {! ///phase.monad}
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 3e9d7a647..b2225c718 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -9,20 +9,20 @@
["." try (#+ Try)]
["." exception (#+ exception:)]
[concurrency
- ["." promise (#+ Promise Resolver) ("#//." monad)]
+ ["." promise (#+ Promise Resolver) ("#\." monad)]
["." stm (#+ Var STM)]]]
[data
["." binary (#+ Binary)]
["." bit]
["." product]
["." maybe]
- ["." text ("#//." equivalence)
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
["." dictionary (#+ Dictionary)]
- ["." row (#+ Row) ("#//." fold)]
+ ["." row (#+ Row) ("#\." fold)]
["." set (#+ Set)]
- ["." list ("#//." monoid functor fold)]]
+ ["." list ("#\." monoid functor fold)]]
[format
["_" binary (#+ Writer)]]]
[world
@@ -210,13 +210,13 @@
extender)]
_ (ioW.enable (get@ #&file-system platform) static)
[archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static import compilation-sources)
- state (promise//wrap (initialize-state extender bundles analysis-state state))]
+ state (promise\wrap (initialize-state extender bundles analysis-state state))]
(if (archive.archived? archive archive.runtime-module)
(wrap [state archive])
(do (try.with promise.monad)
[[state [archive payload]] (|> (..process-runtime archive platform)
(///phase.run' state)
- promise//wrap)
+ promise\wrap)
_ (..cache-module static platform 0 payload)]
(wrap [state archive])))))
@@ -228,9 +228,9 @@
#///directive.state
#extension.state
#///generation.log])
- (row//fold (function (_ right left)
- (format left text.new-line right))
- "")))
+ (row\fold (function (_ right left)
+ (format left text.new-line right))
+ "")))
(def: with-reset-log
(All [<type-vars>]
@@ -277,10 +277,10 @@
(|> mapping
(dictionary.upsert source ..empty (set.add target))
(dictionary.update source (set.union forward)))]
- (list//fold (function (_ previous)
- (dictionary.upsert previous ..empty (set.add target)))
- with-dependence+transitives
- (set.to-list backward))))))]
+ (list\fold (function (_ previous)
+ (dictionary.upsert previous ..empty (set.add target)))
+ with-dependence+transitives
+ (set.to-list backward))))))]
(|> dependence
(update@ #depends-on
(update-dependence
@@ -315,7 +315,7 @@
(def: (verify-dependencies importer importee dependence)
(-> Module Module Dependence (Try Any))
- (cond (text//= importer importee)
+ (cond (text\= importer importee)
(exception.throw ..module-cannot-import-itself [importer])
(..circular-dependency? importer importee dependence)
@@ -355,7 +355,7 @@
(:assume
(stm.commit
(do {! stm.monad}
- [dependence (if (text//= archive.runtime-module importer)
+ [dependence (if (text\= archive.runtime-module importer)
(stm.read dependence)
(do !
[[_ dependence] (stm.update (..depend importer module) dependence)]
@@ -369,7 +369,7 @@
(do !
[[archive state] (stm.read current)]
(if (archive.archived? archive module)
- (wrap [(promise//wrap (#try.Success [archive state]))
+ (wrap [(promise\wrap (#try.Success [archive state]))
#.None])
(do !
[@pending (stm.read pending)]
@@ -399,7 +399,7 @@
signal])]))
(#try.Failure error)
- (wrap [(promise//wrap (#try.Failure error))
+ (wrap [(promise\wrap (#try.Failure error))
#.None]))))))))))})
_ (case signal
#.None
@@ -435,7 +435,7 @@
(wrap [module lux-module])))
(archive.archived archive))
#let [additions (|> modules
- (list//map product.left)
+ (list\map product.left)
(set.from-list text.hash))]]
(wrap (update@ [#extension.state
#///directive.analysis
@@ -445,11 +445,11 @@
(|> analysis-state
(:coerce .Lux)
(update@ #.modules (function (_ current)
- (list//compose (list.filter (|>> product.left
- (set.member? additions)
- not)
- current)
- modules)))
+ (list\compose (list.filter (|>> product.left
+ (set.member? additions)
+ not)
+ current)
+ modules)))
:assume))
state))))
@@ -486,7 +486,7 @@
all-dependencies (: (List Module)
(list))]
(let [new-dependencies (get@ #///.dependencies compilation)
- all-dependencies (list//compose new-dependencies all-dependencies)
+ all-dependencies (list\compose new-dependencies all-dependencies)
continue! (:share [<type-vars>]
{<Platform>
platform}
@@ -502,11 +502,11 @@
(#.Cons _)
(do !
[archive,document+ (|> new-dependencies
- (list//map (import! module))
+ (list\map (import! module))
(monad.seq ..monad))
#let [archive (|> archive,document+
- (list//map product.left)
- (list//fold archive.merge archive))]]
+ (list\map product.left)
+ (list\fold archive.merge archive))]]
(wrap [archive (try.assume
(..updated-state archive state))])))]
(case ((get@ #///.process compilation)
@@ -533,11 +533,11 @@
(..with-reset-log state)])
(#try.Failure error)
- (promise//wrap (#try.Failure error)))))
+ (promise\wrap (#try.Failure error)))))
(#try.Failure error)
(do !
[_ (ioW.freeze (get@ #&file-system platform) static archive)]
- (promise//wrap (#try.Failure error))))))))))]
+ (promise\wrap (#try.Failure error))))))))))]
(compiler archive.runtime-module compilation-module)))
))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
index 18189b405..07cd29140 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
@@ -29,9 +29,9 @@
[///
[arity (#+ Arity)]
[version (#+ Version)]
+ ["." phase]
["." reference (#+ Reference)
- ["." variable (#+ Register Variable)]]
- ["." phase]]])
+ ["." variable (#+ Register Variable)]]]])
(type: #export #rec Primitive
#Unit
@@ -114,8 +114,8 @@
true
(^template [<tag> <=>]
- [(<tag> reference) (<tag> sample)]
- (<=> reference sample))
+ [[(<tag> reference) (<tag> sample)]
+ (<=> reference sample)])
([#Bit bit@=]
[#Nat n.=]
[#Int i.=]
@@ -336,8 +336,8 @@
"[]"
(^template [<tag> <format>]
- (<tag> value)
- (<format> value))
+ [(<tag> value)
+ (<format> value)])
([#Bit %.bit]
[#Nat %.nat]
[#Int %.int]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux
index 2d3b61280..3d71e7c51 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -40,8 +40,8 @@
(Fix (-> (Code' (Ann Location)) (Operation Analysis)))
(case code'
(^template [<tag> <analyser>]
- (<tag> value)
- (<analyser> value))
+ [(<tag> value)
+ (<analyser> value)])
([#.Bit /primitive.bit]
[#.Nat /primitive.nat]
[#.Int /primitive.int]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux
index 2996ed6d0..b71d60f05 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -169,8 +169,8 @@
(wrap [(#/.Bind idx) outputA])))
(^template [<type> <input> <output>]
- [location <input>]
- (analyse-primitive <type> inputT location (#/.Simple <output>) next))
+ [[location <input>]
+ (analyse-primitive <type> inputT location (#/.Simple <output>) next)])
([Bit (#.Bit pattern-value) (#/.Bit pattern-value)]
[Nat (#.Nat pattern-value) (#/.Nat pattern-value)]
[Int (#.Int pattern-value) (#/.Int pattern-value)]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
index 792a779ab..9d1c396e9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
@@ -102,8 +102,8 @@
## Primitive patterns always have partial coverage because there
## are too many possibilities as far as values go.
(^template [<tag>]
- (#/.Simple (<tag> _))
- (////@wrap #Partial))
+ [(#/.Simple (<tag> _))
+ (////@wrap #Partial)])
([#/.Nat]
[#/.Int]
[#/.Rev]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux
index e06265806..6ad18d63d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -60,10 +60,10 @@
(/.fail (ex.construct cannot-analyse [expectedT function-name arg-name body])))
(^template [<tag> <instancer>]
- (<tag> _)
- (do !
- [[_ instanceT] (//type.with-env <instancer>)]
- (recur (maybe.assume (type.apply (list instanceT) expectedT)))))
+ [(<tag> _)
+ (do !
+ [[_ instanceT] (//type.with-env <instancer>)]
+ (recur (maybe.assume (type.apply (list instanceT) expectedT))))])
([#.UnivQ check.existential]
[#.ExQ check.var])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
index 839fe1617..7c4d49340 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
@@ -63,9 +63,9 @@
(#.Primitive name (list@map (replace parameter-idx replacement) params))
(^template [<tag>]
- (<tag> left right)
- (<tag> (replace parameter-idx replacement left)
- (replace parameter-idx replacement right)))
+ [(<tag> left right)
+ (<tag> (replace parameter-idx replacement left)
+ (replace parameter-idx replacement right))])
([#.Sum]
[#.Product]
[#.Function]
@@ -77,9 +77,9 @@
type)
(^template [<tag>]
- (<tag> env quantified)
- (<tag> (list@map (replace parameter-idx replacement) env)
- (replace (n.+ 2 parameter-idx) replacement quantified)))
+ [(<tag> env quantified)
+ (<tag> (list@map (replace parameter-idx replacement) env)
+ (replace (n.+ 2 parameter-idx) replacement quantified))])
([#.UnivQ]
[#.ExQ])
@@ -184,8 +184,8 @@
(#.Primitive name (list@map recur parameters))
(^template [<tag>]
- (<tag> left right)
- (<tag> (recur left) (recur right)))
+ [(<tag> left right)
+ (<tag> (recur left) (recur right))])
([#.Sum] [#.Product] [#.Function] [#.Apply])
(#.Parameter index)
@@ -194,8 +194,8 @@
base)
(^template [<tag>]
- (<tag> environment quantified)
- (<tag> (list@map recur environment) quantified))
+ [(<tag> environment quantified)
+ (<tag> (list@map recur environment) quantified)])
([#.UnivQ] [#.ExQ])
_
@@ -209,10 +209,10 @@
(record' target originalT unnamedT)
(^template [<tag>]
- (<tag> env bodyT)
- (do ///.monad
- [bodyT+ (record' (n.+ 2 target) originalT bodyT)]
- (wrap (<tag> env bodyT+))))
+ [(<tag> env bodyT)
+ (do ///.monad
+ [bodyT+ (record' (n.+ 2 target) originalT bodyT)]
+ (wrap (<tag> env bodyT+)))])
([#.UnivQ]
[#.ExQ])
@@ -248,10 +248,10 @@
(wrap unnamedT+))
(^template [<tag>]
- (<tag> env bodyT)
- (do ///.monad
- [bodyT+ (recur (inc depth) bodyT)]
- (wrap (<tag> env bodyT+))))
+ [(<tag> env bodyT)
+ (do ///.monad
+ [bodyT+ (recur (inc depth) bodyT)]
+ (wrap (<tag> env bodyT+)))])
([#.UnivQ]
[#.ExQ])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux
index 3f8f023aa..03ce1c90b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux
@@ -130,11 +130,11 @@
(/.throw ..cannot-infer-numeric-tag [expectedT tag valueC])))
(^template [<tag> <instancer>]
- (<tag> _)
- (do !
- [[instance-id instanceT] (//type.with-env <instancer>)]
- (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
- (recur valueC))))
+ [(<tag> _)
+ (do !
+ [[instance-id instanceT] (//type.with-env <instancer>)]
+ (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
+ (recur valueC)))])
([#.UnivQ check.existential]
[#.ExQ check.var])
@@ -223,11 +223,11 @@
(wrap (/.tuple (list@map product.right membersTA))))))
(^template [<tag> <instancer>]
- (<tag> _)
- (do !
- [[instance-id instanceT] (//type.with-env <instancer>)]
- (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
- (product archive analyse membersC))))
+ [(<tag> _)
+ (do !
+ [[instance-id instanceT] (//type.with-env <instancer>)]
+ (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
+ (product archive analyse membersC)))])
([#.UnivQ check.existential]
[#.ExQ check.var])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index cd8784056..618fbbfc9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -418,14 +418,14 @@
(check-parameter anonymous)
(^template [<tag>]
- (<tag> id)
- (phase@wrap (jvm.class ..object-class (list))))
+ [(<tag> id)
+ (phase@wrap (jvm.class ..object-class (list)))])
([#.Var]
[#.Ex])
(^template [<tag>]
- (<tag> env unquantified)
- (check-parameter unquantified))
+ [(<tag> env unquantified)
+ (check-parameter unquantified)])
([#.UnivQ]
[#.ExQ])
@@ -493,8 +493,8 @@
(check-jvm anonymous)
(^template [<tag>]
- (<tag> env unquantified)
- (check-jvm unquantified))
+ [(<tag> env unquantified)
+ (check-jvm unquantified)])
([#.UnivQ]
[#.ExQ])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
index b86c2488c..8f44551d1 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
@@ -187,11 +187,11 @@
(#Constant [name annotations type value])
(case value
(^template [<tag> <type> <constant>]
- [_ (<tag> value)]
- (do pool.monad
- [constant (`` (|> value (~~ (template.splice <constant>))))
- attribute (attribute.constant constant)]
- (field.field ..constant::modifier name <type> (row.row attribute))))
+ [[_ (<tag> value)]
+ (do pool.monad
+ [constant (`` (|> value (~~ (template.splice <constant>))))
+ attribute (attribute.constant constant)]
+ (field.field ..constant::modifier name <type> (row.row attribute)))])
([#.Bit type.boolean [(case> #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]]
[#.Int type.byte [.i64 i32.i32 constant.integer pool.integer]]
[#.Int type.short [.i64 i32.i32 constant.integer pool.integer]]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index f0f2fa635..e584bd1e4 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -854,14 +854,14 @@
(//////synthesis.path/then (normalize bodyS))
(^template [<tag>]
- (^ (<tag> leftP rightP))
- (<tag> (recur leftP) (recur rightP)))
+ [(^ (<tag> leftP rightP))
+ (<tag> (recur leftP) (recur rightP))])
([#//////synthesis.Alt]
[#//////synthesis.Seq])
(^template [<tag>]
- (^ (<tag> value))
- path)
+ [(^ (<tag> value))
+ path])
([#//////synthesis.Pop]
[#//////synthesis.Bind]
[#//////synthesis.Access])
@@ -874,8 +874,8 @@
(function (recur body)
(case body
(^template [<tag>]
- (^ (<tag> value))
- body)
+ [(^ (<tag> value))
+ body])
([#//////synthesis.Primitive]
[//////synthesis.constant])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp.lux
index 6d3500416..ad04cefdb 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp.lux
@@ -20,8 +20,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (:: ///.monad wrap (<generator> value)))
+ [(^ (<tag> value))
+ (:: ///.monad wrap (<generator> value))])
([synthesis.bit primitive.bit]
[synthesis.i64 primitive.i64]
[synthesis.f64 primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/case.lux
index 6fdb37e34..dcd47a26d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/case.lux
@@ -49,8 +49,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.int (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -143,23 +143,23 @@
(////@wrap (_.setq (..register register) ..peek))
(^template [<tag> <format> <=>]
- (^ (<tag> value))
- (////@wrap (_.if (|> value <format> (<=> ..peek))
- _.nil
- fail!)))
+ [(^ (<tag> value))
+ (////@wrap (_.if (|> value <format> (<=> ..peek))
+ _.nil
+ fail!))])
([/////synthesis.path/bit //primitive.bit _.equal]
[/////synthesis.path/i64 //primitive.i64 _.=]
[/////synthesis.path/f64 //primitive.f64 _.=]
[/////synthesis.path/text //primitive.text _.string=])
(^template [<complex> <simple> <choice>]
- (^ (<complex> idx))
- (////@wrap (<choice> false idx))
+ [(^ (<complex> idx))
+ (////@wrap (<choice> false idx))
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate)
- (:: ////.monad map (_.progn (<choice> true idx)))))
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate)
+ (:: ////.monad map (_.progn (<choice> true idx))))])
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
@@ -167,8 +167,8 @@
(////@wrap (..push! (_.elt/2 [..peek (_.int +0)])))
(^template [<pm> <getter>]
- (^ (<pm> lefts))
- (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!)))
+ [(^ (<pm> lefts))
+ (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
@@ -181,11 +181,11 @@
next!))))
(^template [<tag> <combinator>]
- (^ (<tag> preP postP))
- (do ////.monad
- [pre! (pattern-matching' generate preP)
- post! (pattern-matching' generate postP)]
- (wrap (<combinator> pre! post!))))
+ [(^ (<tag> preP postP))
+ (do ////.monad
+ [pre! (pattern-matching' generate preP)
+ post! (pattern-matching' generate postP)]
+ (wrap (<combinator> pre! post!)))])
([/////synthesis.path/alt ..alternation]
[/////synthesis.path/seq _.progn])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
index 76496ae82..e9ecc6435 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
@@ -30,8 +30,8 @@
Phase!
(case synthesis
(^template [<tag>]
- (^ (<tag> value))
- (//////phase@map _.return (expression archive synthesis)))
+ [(^ (<tag> value))
+ (//////phase@map _.return (expression archive synthesis))])
([synthesis.bit]
[synthesis.i64]
[synthesis.f64]
@@ -66,8 +66,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (//////phase@wrap (<generator> value)))
+ [(^ (<tag> value))
+ (//////phase@wrap (<generator> value))])
([synthesis.bit /primitive.bit]
[synthesis.i64 /primitive.i64]
[synthesis.f64 /primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
index 6d66678ac..50730cdda 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
@@ -77,8 +77,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.i32 (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.i32 (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -160,10 +160,10 @@
(-> Path (Operation (Maybe Statement))))
(.case pathP
(^template [<simple> <choice>]
- (^ (<simple> idx nextP))
- (|> nextP
- recur
- (:: ///////phase.monad map (|>> (_.then (<choice> true idx)) #.Some))))
+ [(^ (<simple> idx nextP))
+ (|> nextP
+ recur
+ (:: ///////phase.monad map (|>> (_.then (<choice> true idx)) #.Some)))])
([/////synthesis.simple-left-side ..left-choice]
[/////synthesis.simple-right-side ..right-choice])
@@ -182,14 +182,14 @@
## Extra optimization
(^template [<pm> <getter>]
- (^ (/////synthesis.path/seq
- (<pm> lefts)
- (/////synthesis.!bind-top register thenP)))
- (do ///////phase.monad
- [then! (recur thenP)]
- (wrap (#.Some ($_ _.then
- (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
- then!)))))
+ [(^ (/////synthesis.path/seq
+ (<pm> lefts)
+ (/////synthesis.!bind-top register thenP)))
+ (do ///////phase.monad
+ [then! (recur thenP)]
+ (wrap (#.Some ($_ _.then
+ (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
+ then!))))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
@@ -258,14 +258,14 @@
(wrap (_.cond clauses ..fail-pm!)))
(^template [<tag> <format> <type>]
- (<tag> cons)
- (do {! ///////phase.monad}
- [cases (monad.map ! (function (_ [match then])
- (:: ! map (|>> [(list (<format> match))]) (recur then)))
- (#.Cons cons))]
- (wrap (_.switch ..peek-cursor
- cases
- (#.Some ..fail-pm!)))))
+ [(<tag> cons)
+ (do {! ///////phase.monad}
+ [cases (monad.map ! (function (_ [match then])
+ (:: ! map (|>> [(list (<format> match))]) (recur then)))
+ (#.Cons cons))]
+ (wrap (_.switch ..peek-cursor
+ cases
+ (#.Some ..fail-pm!))))])
([#/////synthesis.F64-Fork //primitive.f64 Frac]
[#/////synthesis.Text-Fork //primitive.text Text])
@@ -273,23 +273,23 @@
(statement expression archive bodyS)
(^template [<complex> <choice>]
- (^ (<complex> idx))
- (///////phase@wrap (<choice> false idx)))
+ [(^ (<complex> idx))
+ (///////phase@wrap (<choice> false idx))])
([/////synthesis.side/left ..left-choice]
[/////synthesis.side/right ..right-choice])
(^template [<pm> <getter>]
- (^ (<pm> lefts))
- (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor))))
+ [(^ (<pm> lefts))
+ (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
(^template [<tag> <combinator>]
- (^ (<tag> leftP rightP))
- (do ///////phase.monad
- [left! (recur leftP)
- right! (recur rightP)]
- (wrap (<combinator> left! right!))))
+ [(^ (<tag> leftP rightP))
+ (do ///////phase.monad
+ [left! (recur leftP)
+ right! (recur rightP)]
+ (wrap (<combinator> left! right!)))])
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation]))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux
index 5ede5f926..c93bced64 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux
@@ -23,8 +23,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (///@wrap (<generator> value)))
+ [(^ (<tag> value))
+ (///@wrap (<generator> value))])
([synthesis.bit /primitive.bit]
[synthesis.i64 /primitive.i64]
[synthesis.f64 /primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux
index a81e9f244..7e7cccc72 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux
@@ -108,34 +108,34 @@
(_.goto @end))))
(^template [<pattern> <right?>]
- (^ (<pattern> lefts))
- (operation@wrap
- (do _.monad
- [@success _.new-label
- @fail _.new-label]
- ($_ _.compose
- ..peek
- (_.checkcast //type.variant)
- (//structure.tag lefts <right?>)
- (//structure.flag <right?>)
- //runtime.case
- _.dup
- (_.ifnull @fail)
- (_.goto @success)
- (_.set-label @fail)
- _.pop
- (_.goto @else)
- (_.set-label @success)
- //runtime.push))))
+ [(^ (<pattern> lefts))
+ (operation@wrap
+ (do _.monad
+ [@success _.new-label
+ @fail _.new-label]
+ ($_ _.compose
+ ..peek
+ (_.checkcast //type.variant)
+ (//structure.tag lefts <right?>)
+ (//structure.flag <right?>)
+ //runtime.case
+ _.dup
+ (_.ifnull @fail)
+ (_.goto @success)
+ (_.set-label @fail)
+ _.pop
+ (_.goto @else)
+ (_.set-label @success)
+ //runtime.push)))])
([synthesis.side/left false]
[synthesis.side/right true])
(^template [<pattern> <projection>]
- (^ (<pattern> lefts))
- (operation@wrap ($_ _.compose
- ..peek
- (<projection> lefts)
- //runtime.push)))
+ [(^ (<pattern> lefts))
+ (operation@wrap ($_ _.compose
+ ..peek
+ (<projection> lefts)
+ //runtime.push))])
([synthesis.member/left ..left-projection]
[synthesis.member/right ..right-projection])
@@ -155,18 +155,18 @@
## Extra optimization
(^template [<pm> <projection>]
- (^ (synthesis.path/seq
- (<pm> lefts)
- (synthesis.!bind-top register thenP)))
- (do phase.monad
- [then! (path' stack-depth @else @end phase archive thenP)]
- (wrap ($_ _.compose
- ..peek
- (_.checkcast //type.tuple)
- (..int lefts)
- <projection>
- (_.astore register)
- then!))))
+ [(^ (synthesis.path/seq
+ (<pm> lefts)
+ (synthesis.!bind-top register thenP)))
+ (do phase.monad
+ [then! (path' stack-depth @else @end phase archive thenP)]
+ (wrap ($_ _.compose
+ ..peek
+ (_.checkcast //type.tuple)
+ (..int lefts)
+ <projection>
+ (_.astore register)
+ then!)))])
([synthesis.member/left //runtime.left-projection]
[synthesis.member/right //runtime.right-projection])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux
index b6004b6c6..3b12fe741 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux
@@ -27,19 +27,19 @@
(-> (I64 Any) (Bytecode Any))
(case (.int value)
(^template [<int> <instruction>]
- <int>
- (do _.monad
- [_ <instruction>]
- ..wrap-i64))
+ [<int>
+ (do _.monad
+ [_ <instruction>]
+ ..wrap-i64)])
([+0 _.lconst-0]
[+1 _.lconst-1])
(^template [<int> <instruction>]
- <int>
- (do _.monad
- [_ <instruction>
- _ _.i2l]
- ..wrap-i64))
+ [<int>
+ (do _.monad
+ [_ <instruction>
+ _ _.i2l]
+ ..wrap-i64)])
([-1 _.iconst-m1]
## [+0 _.iconst-0]
## [+1 _.iconst-1]
@@ -79,26 +79,26 @@
(-> Frac (Bytecode Any))
(case value
(^template [<int> <instruction>]
- <int>
- (do _.monad
- [_ <instruction>]
- ..wrap-f64))
+ [<int>
+ (do _.monad
+ [_ <instruction>]
+ ..wrap-f64)])
([+1.0 _.dconst-1])
(^template [<int> <instruction>]
- <int>
- (do _.monad
- [_ <instruction>
- _ _.f2d]
- ..wrap-f64))
+ [<int>
+ (do _.monad
+ [_ <instruction>
+ _ _.f2d]
+ ..wrap-f64)])
([+2.0 _.fconst-2])
(^template [<int> <instruction>]
- <int>
- (do _.monad
- [_ <instruction>
- _ _.i2d]
- ..wrap-f64))
+ [<int>
+ (do _.monad
+ [_ <instruction>
+ _ _.i2d]
+ ..wrap-f64)])
([-1.0 _.iconst-m1]
## [+0.0 _.iconst-0]
## [+1.0 _.iconst-1]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
index a455b13b9..c6cd63bf3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
@@ -22,8 +22,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (//////phase@wrap (<generator> value)))
+ [(^ (<tag> value))
+ (//////phase@wrap (<generator> value))])
([synthesis.bit /primitive.bit]
[synthesis.i64 /primitive.i64]
[synthesis.f64 /primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
index 6271955ed..f13750e56 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux
@@ -52,8 +52,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.int (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -144,22 +144,22 @@
(///////phase@wrap (_.let (list (..register register)) ..peek))
(^template [<tag> <format>]
- (^ (<tag> value))
- (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not)
- fail!)))
+ [(^ (<tag> value))
+ (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not)
+ fail!))])
([/////synthesis.path/bit //primitive.bit]
[/////synthesis.path/i64 //primitive.i64]
[/////synthesis.path/f64 //primitive.f64]
[/////synthesis.path/text //primitive.text])
(^template [<complex> <simple> <choice>]
- (^ (<complex> idx))
- (///////phase@wrap (<choice> false idx))
+ [(^ (<complex> idx))
+ (///////phase@wrap (<choice> false idx))
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate archive)
- (///////phase@map (_.then (<choice> true idx)))))
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate archive)
+ (///////phase@map (_.then (<choice> true idx))))])
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
@@ -167,8 +167,8 @@
(///////phase@wrap (|> ..peek (_.nth (_.int +1)) ..push!))
(^template [<pm> <getter>]
- (^ (<pm> lefts))
- (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!)))
+ [(^ (<pm> lefts))
+ (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
@@ -180,11 +180,11 @@
then!)))
(^template [<tag> <combinator>]
- (^ (<tag> preP postP))
- (do ///////phase.monad
- [pre! (pattern-matching' generate archive preP)
- post! (pattern-matching' generate archive postP)]
- (wrap (<combinator> pre! post!))))
+ [(^ (<tag> preP postP))
+ (do ///////phase.monad
+ [pre! (pattern-matching' generate archive preP)
+ post! (pattern-matching' generate archive postP)]
+ (wrap (<combinator> pre! post!)))])
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux
index 6d3500416..ad04cefdb 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux
@@ -20,8 +20,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (:: ///.monad wrap (<generator> value)))
+ [(^ (<tag> value))
+ (:: ///.monad wrap (<generator> value))])
([synthesis.bit primitive.bit]
[synthesis.i64 primitive.i64]
[synthesis.f64 primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
index 811ce3c93..738912f52 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux
@@ -54,8 +54,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.int (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -149,22 +149,22 @@
(////@wrap (_.; (_.set (..register register) ..peek)))
(^template [<tag> <format>]
- (^ (<tag> value))
- (////@wrap (_.when (|> value <format> (_.= ..peek) _.not)
- fail!)))
+ [(^ (<tag> value))
+ (////@wrap (_.when (|> value <format> (_.= ..peek) _.not)
+ fail!))])
([/////synthesis.path/bit //primitive.bit]
[/////synthesis.path/i64 //primitive.i64]
[/////synthesis.path/f64 //primitive.f64]
[/////synthesis.path/text //primitive.text])
(^template [<complex> <simple> <choice>]
- (^ (<complex> idx))
- (////@wrap (<choice> false idx))
+ [(^ (<complex> idx))
+ (////@wrap (<choice> false idx))
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate)
- (:: ////.monad map (_.then (<choice> true idx)))))
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate)
+ (:: ////.monad map (_.then (<choice> true idx))))])
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
@@ -172,8 +172,8 @@
(////@wrap (|> ..peek (_.nth (_.int +0)) ..push!))
(^template [<pm> <getter>]
- (^ (<pm> lefts))
- (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!)))
+ [(^ (<pm> lefts))
+ (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
@@ -193,11 +193,11 @@
## next!))))
(^template [<tag> <combinator>]
- (^ (<tag> preP postP))
- (do ////.monad
- [pre! (pattern-matching' generate preP)
- post! (pattern-matching' generate postP)]
- (wrap (<combinator> pre! post!))))
+ [(^ (<tag> preP postP))
+ (do ////.monad
+ [pre! (pattern-matching' generate preP)
+ post! (pattern-matching' generate postP)]
+ (wrap (<combinator> pre! post!)))])
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
index 19013715b..f2bfbd4d5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
@@ -22,8 +22,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (//////phase@wrap (<generator> value)))
+ [(^ (<tag> value))
+ (//////phase@wrap (<generator> value))])
([////synthesis.bit /primitive.bit]
[////synthesis.i64 /primitive.i64]
[////synthesis.f64 /primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index dd99cb47a..e25155d4a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -55,8 +55,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.int (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -147,22 +147,22 @@
(///////phase@wrap (_.set (list (..register register)) ..peek))
(^template [<tag> <format>]
- (^ (<tag> value))
- (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not)
- fail-pm!)))
+ [(^ (<tag> value))
+ (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not)
+ fail-pm!))])
([/////synthesis.path/bit //primitive.bit]
[/////synthesis.path/i64 //primitive.i64]
[/////synthesis.path/f64 //primitive.f64]
[/////synthesis.path/text //primitive.text])
(^template [<complex> <simple> <choice>]
- (^ (<complex> idx))
- (///////phase@wrap (<choice> false idx))
+ [(^ (<complex> idx))
+ (///////phase@wrap (<choice> false idx))
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate archive)
- (///////phase@map (_.then (<choice> true idx)))))
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate archive)
+ (///////phase@map (_.then (<choice> true idx))))])
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
@@ -170,8 +170,8 @@
(///////phase@wrap (|> ..peek (_.nth (_.int +0)) ..push!))
(^template [<pm> <getter>]
- (^ (<pm> lefts))
- (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!)))
+ [(^ (<pm> lefts))
+ (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
@@ -191,11 +191,11 @@
next!))))
(^template [<tag> <combinator>]
- (^ (<tag> preP postP))
- (do ///////phase.monad
- [pre! (pattern-matching' generate archive preP)
- post! (pattern-matching' generate archive postP)]
- (wrap (<combinator> pre! post!))))
+ [(^ (<tag> preP postP))
+ (do ///////phase.monad
+ [pre! (pattern-matching' generate archive preP)
+ post! (pattern-matching' generate archive postP)]
+ (wrap (<combinator> pre! post!)))])
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux
index 19013715b..f2bfbd4d5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux
@@ -22,8 +22,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (//////phase@wrap (<generator> value)))
+ [(^ (<tag> value))
+ (//////phase@wrap (<generator> value))])
([////synthesis.bit /primitive.bit]
[////synthesis.i64 /primitive.i64]
[////synthesis.f64 /primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
index 082f9c334..921769c00 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
@@ -55,8 +55,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.int (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -148,22 +148,22 @@
(///////phase@wrap (_.set (list (..register register)) ..peek))
(^template [<tag> <format>]
- (^ (<tag> value))
- (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not)
- fail!)))
+ [(^ (<tag> value))
+ (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not)
+ fail!))])
([/////synthesis.path/bit //primitive.bit]
[/////synthesis.path/i64 //primitive.i64]
[/////synthesis.path/f64 //primitive.f64]
[/////synthesis.path/text //primitive.text])
(^template [<complex> <simple> <choice>]
- (^ (<complex> idx))
- (///////phase@wrap (<choice> false idx))
+ [(^ (<complex> idx))
+ (///////phase@wrap (<choice> false idx))
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate archive)
- (///////phase@map (_.then (<choice> true idx)))))
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate archive)
+ (///////phase@map (_.then (<choice> true idx))))])
([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
[/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
@@ -171,8 +171,8 @@
(///////phase@wrap (|> ..peek (_.nth (_.int +0)) ..push!))
(^template [<pm> <getter>]
- (^ (<pm> lefts))
- (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!)))
+ [(^ (<pm> lefts))
+ (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
@@ -192,11 +192,11 @@
next!))))
(^template [<tag> <combinator>]
- (^ (<tag> preP postP))
- (do ///////phase.monad
- [pre! (pattern-matching' generate archive preP)
- post! (pattern-matching' generate archive postP)]
- (wrap (<combinator> pre! post!))))
+ [(^ (<tag> preP postP))
+ (do ///////phase.monad
+ [pre! (pattern-matching' generate archive preP)
+ post! (pattern-matching' generate archive postP)]
+ (wrap (<combinator> pre! post!)))])
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
index 0152ffbcd..950b3b74b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
@@ -20,8 +20,8 @@
Phase
(case synthesis
(^template [<tag> <generator>]
- (^ (<tag> value))
- (:: ///.monad wrap (<generator> value)))
+ [(^ (<tag> value))
+ (:: ///.monad wrap (<generator> value))])
([synthesis.bit primitive.bit]
[synthesis.i64 primitive.i64]
[synthesis.f64 primitive.f64]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux
index 034c72a19..a6f3b3760 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux
@@ -41,8 +41,8 @@
(wrap (list@fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
- (<side> lefts)
- (<accessor> (_.int (.int lefts))))
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
([#.Left //runtime.tuple//left]
[#.Right //runtime.tuple//right]))]
(method source)))
@@ -98,9 +98,9 @@
(def: (pm-catch handler)
(-> Expression Computation)
(_.lambda [(list @alt-error) #.None]
- (_.if (|> @alt-error (_.eqv?/2 pm-error))
- handler
- (_.raise/1 @alt-error))))
+ (_.if (|> @alt-error (_.eqv?/2 pm-error))
+ handler
+ (_.raise/1 @alt-error))))
(def: (pattern-matching' generate pathP)
(-> Phase Path (Operation Expression))
@@ -115,43 +115,43 @@
(////@wrap (_.define-constant (..register register) ..cursor-top))
(^template [<tag> <format> <=>]
- (^ (<tag> value))
- (////@wrap (_.when (|> value <format> (<=> cursor-top) _.not/1)
- fail-pm!)))
+ [(^ (<tag> value))
+ (////@wrap (_.when (|> value <format> (<=> cursor-top) _.not/1)
+ fail-pm!))])
([/////synthesis.path/bit //primitive.bit _.eqv?/2]
[/////synthesis.path/i64 (<| //primitive.i64 .int) _.=/2]
[/////synthesis.path/f64 //primitive.f64 _.=/2]
[/////synthesis.path/text //primitive.text _.eqv?/2])
(^template [<pm> <flag> <prep>]
- (^ (<pm> idx))
- (////@wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))])
- (_.if (_.null?/1 @temp)
- fail-pm!
- (push-cursor! @temp)))))
+ [(^ (<pm> idx))
+ (////@wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))])
+ (_.if (_.null?/1 @temp)
+ fail-pm!
+ (push-cursor! @temp))))])
([/////synthesis.side/left _.nil (<|)]
[/////synthesis.side/right (_.string "") inc])
(^template [<pm> <getter>]
- (^ (<pm> idx))
- (////@wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top))))
+ [(^ (<pm> idx))
+ (////@wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top)))])
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
(^template [<tag> <computation>]
- (^ (<tag> leftP rightP))
- (do ////.monad
- [leftO (pattern-matching' generate leftP)
- rightO (pattern-matching' generate rightP)]
- (wrap <computation>)))
+ [(^ (<tag> leftP rightP))
+ (do ////.monad
+ [leftO (pattern-matching' generate leftP)
+ rightO (pattern-matching' generate rightP)]
+ (wrap <computation>))])
([/////synthesis.path/seq (_.begin (list leftO
rightO))]
[/////synthesis.path/alt (_.with-exception-handler
(pm-catch (_.begin (list restore-cursor!
rightO)))
(_.lambda [(list) #.None]
- (_.begin (list save-cursor!
- leftO))))])))
+ (_.begin (list save-cursor!
+ leftO))))])))
(def: (pattern-matching generate pathP)
(-> Phase Path (Operation Computation))
@@ -160,7 +160,7 @@
(wrap (_.with-exception-handler
(pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching.")))
(_.lambda [(list) #.None]
- pattern-matching!)))))
+ pattern-matching!)))))
(def: #export (case generate [valueS pathP])
(-> Phase [Synthesis Path] (Operation Computation))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux
index 497261cf0..e6a587f9f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux
@@ -31,15 +31,15 @@
(#/.Text /.unit)
(^template [<analysis> <synthesis>]
- (<analysis> value)
- (<synthesis> value))
+ [(<analysis> value)
+ (<synthesis> value)])
([#///analysis.Bit #/.Bit]
[#///analysis.Frac #/.F64]
[#///analysis.Text #/.Text])
(^template [<analysis> <synthesis>]
- (<analysis> value)
- (<synthesis> (.i64 value)))
+ [(<analysis> value)
+ (<synthesis> (.i64 value))])
([#///analysis.Nat #/.I64]
[#///analysis.Int #/.I64]
[#///analysis.Rev #/.I64])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 268937c12..448c37b02 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -45,10 +45,10 @@
thenC)
(^template [<from> <to> <conversion>]
- (<from> test)
- (///@map (function (_ then)
- (<to> [(<conversion> test) then] (list)))
- thenC))
+ [(<from> test)
+ (///@map (function (_ then)
+ (<to> [(<conversion> test) then] (list)))
+ thenC)])
([#///analysis.Nat #/.I64-Fork .i64]
[#///analysis.Int #/.I64-Fork .i64]
[#///analysis.Rev #/.I64-Fork .i64]
@@ -161,18 +161,18 @@
(weave new-then old-else)))))
(^template [<tag> <equivalence>]
- [(<tag> new-fork) (<tag> old-fork)]
- (<tag> (..weave-fork weave <equivalence> new-fork old-fork)))
+ [[(<tag> new-fork) (<tag> old-fork)]
+ (<tag> (..weave-fork weave <equivalence> new-fork old-fork))])
([#/.I64-Fork i64.equivalence]
[#/.F64-Fork frac.equivalence]
[#/.Text-Fork text.equivalence])
(^template [<access> <side>]
- [(#/.Access (<access> (<side> newL)))
- (#/.Access (<access> (<side> oldL)))]
- (if (n.= newL oldL)
- old
- <default>))
+ [[(#/.Access (<access> (<side> newL)))
+ (#/.Access (<access> (<side> oldL)))]
+ (if (n.= newL oldL)
+ old
+ <default>)])
([#/.Side #.Left]
[#/.Side #.Right]
[#/.Member #.Left]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index 6c70612b4..864001655 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -95,11 +95,11 @@
(phase@wrap (#/.Bind (inc register)))
(^template [<tag>]
- (<tag> left right)
- (do phase.monad
- [left' (grow-path grow left)
- right' (grow-path grow right)]
- (wrap (<tag> left' right'))))
+ [(<tag> left right)
+ (do phase.monad
+ [left' (grow-path grow left)
+ right' (grow-path grow right)]
+ (wrap (<tag> left' right')))])
([#/.Alt] [#/.Seq])
(#/.Bit-Fork when then else)
@@ -114,15 +114,15 @@
(wrap (#/.Bit-Fork when then else)))
(^template [<tag>]
- (<tag> [[test then] elses])
- (do {! phase.monad}
- [then (grow-path grow then)
- elses (monad.map ! (function (_ [else-test else-then])
- (do !
- [else-then (grow-path grow else-then)]
- (wrap [else-test else-then])))
- elses)]
- (wrap (<tag> [[test then] elses]))))
+ [(<tag> [[test then] elses])
+ (do {! phase.monad}
+ [then (grow-path grow then)
+ elses (monad.map ! (function (_ [else-test else-then])
+ (do !
+ [else-then (grow-path grow else-then)]
+ (wrap [else-test else-then])))
+ elses)]
+ (wrap (<tag> [[test then] elses])))])
([#/.I64-Fork]
[#/.F64-Fork]
[#/.Text-Fork])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
index eca662b25..f2559460a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
@@ -31,11 +31,11 @@
(#.Some (#/.Bind (register-optimization offset register)))
(^template [<tag>]
- (<tag> left right)
- (do maybe.monad
- [left' (recur left)
- right' (recur right)]
- (wrap (<tag> left' right'))))
+ [(<tag> left right)
+ (do maybe.monad
+ [left' (recur left)
+ right' (recur right)]
+ (wrap (<tag> left' right')))])
([#/.Alt] [#/.Seq])
(#/.Bit-Fork when then else)
@@ -50,15 +50,15 @@
(wrap (#/.Bit-Fork when then else)))
(^template [<tag>]
- (<tag> [[test then] elses])
- (do {! maybe.monad}
- [then (recur then)
- elses (monad.map ! (function (_ [else-test else-then])
- (do !
- [else-then (recur else-then)]
- (wrap [else-test else-then])))
- elses)]
- (wrap (<tag> [[test then] elses]))))
+ [(<tag> [[test then] elses])
+ (do {! maybe.monad}
+ [then (recur then)
+ elses (monad.map ! (function (_ [else-test else-then])
+ (do !
+ [else-then (recur else-then)]
+ (wrap [else-test else-then])))
+ elses)]
+ (wrap (<tag> [[test then] elses])))])
([#/.I64-Fork]
[#/.F64-Fork]
[#/.Text-Fork])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
index ab0858583..c18c26246 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
@@ -63,8 +63,8 @@
(recur post))))
(^template [<tag>]
- (<tag> left right)
- (<tag> (recur left) (recur right)))
+ [(<tag> left right)
+ (<tag> (recur left) (recur right))])
([#/.Seq]
[#/.Alt])
@@ -72,11 +72,11 @@
(#/.Bit-Fork when (recur then) (maybe@map recur else))
(^template [<tag>]
- (<tag> [[test then] tail])
- (<tag> [[test (recur then)]
- (list@map (function (_ [test' then'])
- [test' (recur then')])
- tail)]))
+ [(<tag> [[test then] tail])
+ (<tag> [[test (recur then)]
+ (list@map (function (_ [test' then'])
+ [test' (recur then')])
+ tail)])])
([#/.I64-Fork]
[#/.F64-Fork]
[#/.Text-Fork])
@@ -265,16 +265,16 @@
(wrap [redundancy (#/.Bit-Fork when then else)]))
(^template [<tag> <type>]
- (<tag> [[test then] elses])
- (do {! try.monad}
- [[redundancy then] (recur [redundancy then])
- [redundancy elses] (..list-optimization (: (Optimization [<type> Path])
- (function (_ [redundancy [else-test else-then]])
- (do !
- [[redundancy else-then] (recur [redundancy else-then])]
- (wrap [redundancy [else-test else-then]]))))
- [redundancy elses])]
- (wrap [redundancy (<tag> [[test then] elses])])))
+ [(<tag> [[test then] elses])
+ (do {! try.monad}
+ [[redundancy then] (recur [redundancy then])
+ [redundancy elses] (..list-optimization (: (Optimization [<type> Path])
+ (function (_ [redundancy [else-test else-then]])
+ (do !
+ [[redundancy else-then] (recur [redundancy else-then])]
+ (wrap [redundancy [else-test else-then]]))))
+ [redundancy elses])]
+ (wrap [redundancy (<tag> [[test then] elses])]))])
([#/.I64-Fork (I64 Any)]
[#/.F64-Fork Frac]
[#/.Text-Fork Text])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
index 2c6b8ab6f..cc1bf4500 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
@@ -273,12 +273,12 @@
")")
(^template [<tag> <format>]
- (<tag> cons)
- (|> (#.Cons cons)
- (list@map (function (_ [test then])
- (format (<format> test) " " (%path' %then then))))
- (text.join-with " ")
- (text.enclose ["(? " ")"])))
+ [(<tag> cons)
+ (|> (#.Cons cons)
+ (list@map (function (_ [test then])
+ (format (<format> test) " " (%path' %then then))))
+ (text.join-with " ")
+ (text.enclose ["(? " ")"]))])
([#I64-Fork (|>> .int %.int)]
[#F64-Fork %.frac]
[#Text-Fork %.text])
@@ -320,8 +320,8 @@
(#Primitive primitive)
(case primitive
(^template [<pattern> <format>]
- (<pattern> value)
- (<format> value))
+ [(<pattern> value)
+ (<format> value)])
([#Bit %.bit]
[#F64 %.frac]
[#Text %.text])
@@ -417,8 +417,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <eq> <format>]
- [(<tag> reference') (<tag> sample')]
- (<eq> reference' sample'))
+ [[(<tag> reference') (<tag> sample')]
+ (<eq> reference' sample')])
([#Bit bit@= %.bit]
[#F64 f.= %.frac]
[#Text text@= %.text])
@@ -436,8 +436,8 @@
(def: hash
(|>> (case> (^template [<tag> <hash>]
- (<tag> value')
- (:: <hash> hash value'))
+ [(<tag> value')
+ (:: <hash> hash value')])
([#Bit bit.hash]
[#F64 f.hash]
[#Text text.hash]
@@ -461,8 +461,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <equivalence>]
- [(<tag> reference) (<tag> sample)]
- (:: <equivalence> = reference sample))
+ [[(<tag> reference) (<tag> sample)]
+ (:: <equivalence> = reference sample)])
([#Side ..side-equivalence]
[#Member ..member-equivalence])
@@ -478,8 +478,8 @@
(let [sub-hash (sum.hash n.hash n.hash)]
(case value
(^template [<tag>]
- (<tag> value)
- (:: sub-hash hash value))
+ [(<tag> value)
+ (:: sub-hash hash value)])
([#Side]
[#Member])))))
@@ -498,18 +498,18 @@
(:: (maybe.equivalence =) = reference-else sample-else))
(^template [<tag> <equivalence>]
- [(<tag> reference-cons)
- (<tag> sample-cons)]
- (:: (list.equivalence (equivalence.product <equivalence> =)) =
- (#.Cons reference-cons)
- (#.Cons sample-cons)))
+ [[(<tag> reference-cons)
+ (<tag> sample-cons)]
+ (:: (list.equivalence (equivalence.product <equivalence> =)) =
+ (#.Cons reference-cons)
+ (#.Cons sample-cons))])
([#I64-Fork i64.equivalence]
[#F64-Fork f.equivalence]
[#Text-Fork text.equivalence])
(^template [<tag> <equivalence>]
- [(<tag> reference') (<tag> sample')]
- (:: <equivalence> = reference' sample'))
+ [[(<tag> reference') (<tag> sample')]
+ (:: <equivalence> = reference' sample')])
([#Access ..access-equivalence]
[#Then equivalence])
@@ -517,9 +517,9 @@
(n.= reference' sample')
(^template [<tag>]
- [(<tag> leftR rightR) (<tag> leftS rightS)]
- (and (= leftR leftS)
- (= rightR rightS)))
+ [[(<tag> leftR rightR) (<tag> leftS rightS)]
+ (and (= leftR leftS)
+ (= rightR rightS))])
([#Alt]
[#Seq])
@@ -550,20 +550,20 @@
(:: (maybe.hash (path'-hash super)) hash else))
(^template [<factor> <tag> <hash>]
- (<tag> cons)
- (let [case-hash (product.hash <hash>
- (path'-hash super))
- cons-hash (product.hash case-hash (list.hash case-hash))]
- (n.* <factor> (:: cons-hash hash cons))))
+ [(<tag> cons)
+ (let [case-hash (product.hash <hash>
+ (path'-hash super))
+ cons-hash (product.hash case-hash (list.hash case-hash))]
+ (n.* <factor> (:: cons-hash hash cons)))])
([11 #I64-Fork i64.hash]
[13 #F64-Fork f.hash]
[17 #Text-Fork text.hash])
(^template [<factor> <tag>]
- (<tag> fork)
- (let [recur-hash (path'-hash super)
- fork-hash (product.hash recur-hash recur-hash)]
- (n.* <factor> (:: fork-hash hash fork))))
+ [(<tag> fork)
+ (let [recur-hash (path'-hash super)
+ fork-hash (product.hash recur-hash recur-hash)]
+ (n.* <factor> (:: fork-hash hash fork)))])
([19 #Alt]
[23 #Seq])
@@ -713,8 +713,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <equivalence>]
- [(<tag> reference) (<tag> sample)]
- (:: (<equivalence> /@=) = reference sample))
+ [[(<tag> reference) (<tag> sample)]
+ (:: (<equivalence> /@=) = reference sample)])
([#Branch ..branch-equivalence]
[#Loop ..loop-equivalence]
[#Function ..function-equivalence])
@@ -731,8 +731,8 @@
(def: (hash value)
(case value
(^template [<factor> <tag> <hash>]
- (<tag> value)
- (n.* <factor> (:: (<hash> super) hash value)))
+ [(<tag> value)
+ (n.* <factor> (:: (<hash> super) hash value))])
([2 #Branch ..branch-hash]
[3 #Loop ..loop-hash]
[5 #Function ..function-hash])
@@ -744,8 +744,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <equivalence>]
- [(<tag> reference') (<tag> sample')]
- (:: <equivalence> = reference' sample'))
+ [[(<tag> reference') (<tag> sample')]
+ (:: <equivalence> = reference' sample')])
([#Primitive ..primitive-equivalence]
[#Structure (analysis.composite-equivalence =)]
[#Reference reference.equivalence]
@@ -768,8 +768,8 @@
(let [recur-hash [..equivalence hash]]
(case value
(^template [<tag> <hash>]
- (<tag> value)
- (:: <hash> hash value))
+ [(<tag> value)
+ (:: <hash> hash value)])
([#Primitive ..primitive-hash]
[#Structure (analysis.composite-hash recur-hash)]
[#Reference reference.hash]
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
index f34f72acd..1af87d6fc 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
@@ -103,7 +103,7 @@
(function (_ value)
(case value
(^template [<nat> <tag> <writer>]
- (<tag> value) ((binary.and binary.nat <writer>) [<nat> value]))
+ [(<tag> value) ((binary.and binary.nat <writer>) [<nat> value])])
([0 #Anonymous binary.any]
[1 #Definition binary.text]
[2 #Analyser binary.text]
@@ -142,8 +142,8 @@
(..resource registry)
(^template [<tag> <create>]
- (<tag> name)
- (<create> name registry))
+ [(<tag> name)
+ (<create> name registry)])
([#Definition ..definition]
[#Analyser ..analyser]
[#Synthesizer ..synthesizer]
diff --git a/stdlib/source/lux/tool/compiler/reference.lux b/stdlib/source/lux/tool/compiler/reference.lux
index e67b946b8..5ade63e39 100644
--- a/stdlib/source/lux/tool/compiler/reference.lux
+++ b/stdlib/source/lux/tool/compiler/reference.lux
@@ -27,8 +27,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag> <equivalence>]
- [(<tag> reference) (<tag> sample)]
- (:: <equivalence> = reference sample))
+ [[(<tag> reference) (<tag> sample)]
+ (:: <equivalence> = reference sample)])
([#Variable /variable.equivalence]
[#Constant name.equivalence])
@@ -44,9 +44,9 @@
(def: (hash value)
(case value
(^template [<factor> <tag> <hash>]
- (<tag> value)
- ($_ n.* <factor>
- (:: <hash> hash value)))
+ [(<tag> value)
+ ($_ n.* <factor>
+ (:: <hash> hash value))])
([2 #Variable /variable.hash]
[3 #Constant name.hash])
)))
diff --git a/stdlib/source/lux/tool/compiler/reference/variable.lux b/stdlib/source/lux/tool/compiler/reference/variable.lux
index 0350463bd..e97974596 100644
--- a/stdlib/source/lux/tool/compiler/reference/variable.lux
+++ b/stdlib/source/lux/tool/compiler/reference/variable.lux
@@ -25,8 +25,8 @@
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
- [(<tag> reference') (<tag> sample')]
- (n.= reference' sample'))
+ [[(<tag> reference') (<tag> sample')]
+ (n.= reference' sample')])
([#Local] [#Foreign])
_
@@ -40,9 +40,9 @@
(def: hash
(|>> (case> (^template [<factor> <tag>]
- (<tag> register)
- ($_ n.* <factor>
- (:: n.hash hash register)))
+ [(<tag> register)
+ ($_ n.* <factor>
+ (:: n.hash hash register))])
([2 #Local]
[3 #Foreign])))))
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index ac92dbc80..01b4bf05a 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -86,14 +86,14 @@
")")
(^template [<tag> <open> <close> <flatten>]
- (<tag> _)
- ($_ text@compose <open>
- (|> (<flatten> type)
- (list@map format)
- list.reverse
- (list.interpose " ")
- (list@fold text@compose ""))
- <close>))
+ [(<tag> _)
+ ($_ text@compose <open>
+ (|> (<flatten> type)
+ (list@map format)
+ list.reverse
+ (list.interpose " ")
+ (list@fold text@compose ""))
+ <close>)])
([#.Sum "(| " ")" flatten-variant]
[#.Product "[" "]" flatten-tuple])
@@ -121,8 +121,8 @@
($_ text@compose "(" (format type-func) " " (|> type-args (list@map format) list.reverse (list.interpose " ") (list@fold text@compose "")) ")"))
(^template [<tag> <desc>]
- (<tag> env body)
- ($_ text@compose "(" <desc> " {" (|> env (list@map format) (text.join-with " ")) "} " (format body) ")"))
+ [(<tag> env body)
+ ($_ text@compose "(" <desc> " {" (|> env (list@map format) (text.join-with " ")) "} " (format body) ")")])
([#.UnivQ "All"]
[#.ExQ "Ex"])
@@ -137,19 +137,19 @@
(#.Primitive name (list@map (beta-reduce env) params))
(^template [<tag>]
- (<tag> left right)
- (<tag> (beta-reduce env left) (beta-reduce env right)))
+ [(<tag> left right)
+ (<tag> (beta-reduce env left) (beta-reduce env right))])
([#.Sum] [#.Product]
[#.Function] [#.Apply])
(^template [<tag>]
- (<tag> old-env def)
- (case old-env
- #.Nil
- (<tag> env def)
+ [(<tag> old-env def)
+ (case old-env
+ #.Nil
+ (<tag> env def)
- _
- (<tag> (list@map (beta-reduce env) old-env) def)))
+ _
+ (<tag> (list@map (beta-reduce env) old-env) def))])
([#.UnivQ]
[#.ExQ])
@@ -184,8 +184,8 @@
(list.zip/2 xparams yparams)))
(^template [<tag>]
- [(<tag> xid) (<tag> yid)]
- (n.= yid xid))
+ [[(<tag> xid) (<tag> yid)]
+ (n.= yid xid)])
([#.Var] [#.Ex] [#.Parameter])
(^or [(#.Function xleft xright) (#.Function yleft yright)]
@@ -198,8 +198,8 @@
(= xtype ytype))
(^template [<tag>]
- [(<tag> xL xR) (<tag> yL yR)]
- (and (= xL yL) (= xR yR)))
+ [[(<tag> xL xR) (<tag> yL yR)]
+ (and (= xL yL) (= xR yR))])
([#.Sum] [#.Product])
(^or [(#.UnivQ xenv xbody) (#.UnivQ yenv ybody)]
@@ -223,10 +223,10 @@
(#.Cons param params')
(case func
(^template [<tag>]
- (<tag> env body)
- (|> body
- (beta-reduce (list& func param env))
- (apply params')))
+ [(<tag> env body)
+ (|> body
+ (beta-reduce (list& func param env))
+ (apply params'))])
([#.UnivQ] [#.ExQ])
(#.Apply A F)
@@ -246,23 +246,23 @@
(.list (~+ (list@map to-code params)))))
(^template [<tag>]
- (<tag> idx)
- (` (<tag> (~ (code.nat idx)))))
+ [(<tag> idx)
+ (` (<tag> (~ (code.nat idx))))])
([#.Var] [#.Ex] [#.Parameter])
(^template [<tag>]
- (<tag> left right)
- (` (<tag> (~ (to-code left))
- (~ (to-code right)))))
+ [(<tag> left right)
+ (` (<tag> (~ (to-code left))
+ (~ (to-code right))))])
([#.Sum] [#.Product] [#.Function] [#.Apply])
(#.Named name sub-type)
(code.identifier name)
(^template [<tag>]
- (<tag> env body)
- (` (<tag> (.list (~+ (list@map to-code env)))
- (~ (to-code body)))))
+ [(<tag> env body)
+ (` (<tag> (.list (~+ (list@map to-code env)))
+ (~ (to-code body))))])
([#.UnivQ] [#.ExQ])
))
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 4918a0b87..2d4ea30c9 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -433,11 +433,11 @@
(wrap assumptions))))
(^template [<pattern> <id> <type>]
- <pattern>
- (do !
- [ring (..ring <id>)
- _ (monad.map ! (update <type>) (set.to-list ring))]
- (wrap assumptions)))
+ [<pattern>
+ (do !
+ [ring (..ring <id>)
+ _ (monad.map ! (update <type>) (set.to-list ring))]
+ (wrap assumptions))])
([[(#.Var _) _] idE atype]
[[_ (#.Var _)] idA etype])
@@ -559,8 +559,8 @@
(check' assumptions expected bound)))
(^template [<fE> <fA>]
- [(#.Apply aE <fE>) (#.Apply aA <fA>)]
- (check-apply check' assumptions [aE <fE>] [aA <fA>]))
+ [[(#.Apply aE <fE>) (#.Apply aA <fA>)]
+ (check-apply check' assumptions [aE <fE>] [aA <fA>])])
([F1 (#.Ex ex)]
[(#.Ex exE) fA]
[fE (#.Var idA)]
@@ -581,21 +581,21 @@
## TODO: Refactor-away as cold-code
(^template [<tag> <instancer>]
- [(<tag> _) _]
- (do ..monad
- [[_ paramT] <instancer>
- expected' (apply-type! expected paramT)]
- (check' assumptions expected' actual)))
+ [[(<tag> _) _]
+ (do ..monad
+ [[_ paramT] <instancer>
+ expected' (apply-type! expected paramT)]
+ (check' assumptions expected' actual))])
([#.UnivQ ..existential]
[#.ExQ ..var])
## TODO: Refactor-away as cold-code
(^template [<tag> <instancer>]
- [_ (<tag> _)]
- (do ..monad
- [[_ paramT] <instancer>
- actual' (apply-type! actual paramT)]
- (check' assumptions expected actual')))
+ [[_ (<tag> _)]
+ (do ..monad
+ [[_ paramT] <instancer>
+ actual' (apply-type! actual paramT)]
+ (check' assumptions expected actual'))])
([#.UnivQ ..var]
[#.ExQ ..existential])
@@ -618,10 +618,10 @@
(fail ""))
(^template [<compose>]
- [(<compose> eL eR) (<compose> aL aR)]
- (do ..monad
- [assumptions (check' assumptions eL aL)]
- (check' assumptions eR aR)))
+ [[(<compose> eL eR) (<compose> aL aR)]
+ (do ..monad
+ [assumptions (check' assumptions eL aL)]
+ (check' assumptions eR aR))])
([#.Sum]
[#.Product])
@@ -676,11 +676,11 @@
(check@wrap inputT)
(^template [<tag>]
- (<tag> leftT rightT)
- (do ..monad
- [leftT' (clean leftT)]
- (|> (clean rightT)
- (check@map (|>> (<tag> leftT'))))))
+ [(<tag> leftT rightT)
+ (do ..monad
+ [leftT' (clean leftT)]
+ (|> (clean rightT)
+ (check@map (|>> (<tag> leftT')))))])
([#.Sum] [#.Product] [#.Function] [#.Apply])
(#.Var id)
@@ -694,9 +694,9 @@
(wrap inputT)))
(^template [<tag>]
- (<tag> envT+ unquantifiedT)
- (do {! ..monad}
- [envT+' (monad.map ! clean envT+)]
- (wrap (<tag> envT+' unquantifiedT))))
+ [(<tag> envT+ unquantifiedT)
+ (do {! ..monad}
+ [envT+' (monad.map ! clean envT+)]
+ (wrap (<tag> envT+' unquantifiedT)))])
([#.UnivQ] [#.ExQ])
))
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux
index a4d139aa4..0f5db0309 100644
--- a/stdlib/source/poly/lux/abstract/equivalence.lux
+++ b/stdlib/source/poly/lux/abstract/equivalence.lux
@@ -11,14 +11,14 @@
["." bit]
["." maybe]
[number
- ["." nat ("#//." decimal)]
+ ["." nat ("#\." decimal)]
["." int]
["." rev]
["." frac]]
- ["." text ("#//." monoid)
+ ["." text ("#\." monoid)
["%" format (#+ format)]]
[collection
- ["." list ("#//." monad)]
+ ["." list ("#\." monad)]
["." row]
["." array]
["." queue]
@@ -115,15 +115,15 @@
(wrap (` (: (~ (@Equivalence inputT))
(function ((~ g!_) (~ g!left) (~ g!right))
(case [(~ g!left) (~ g!right)]
- (~+ (list//join (list//map (function (_ [tag g!eq])
- (if (nat.= last tag)
- (list (` [((~ (code.nat (dec tag))) #1 (~ g!left))
- ((~ (code.nat (dec tag))) #1 (~ g!right))])
- (` ((~ g!eq) (~ g!left) (~ g!right))))
- (list (` [((~ (code.nat tag)) #0 (~ g!left))
- ((~ (code.nat tag)) #0 (~ g!right))])
- (` ((~ g!eq) (~ g!left) (~ g!right))))))
- (list.enumeration members))))
+ (~+ (list\join (list\map (function (_ [tag g!eq])
+ (if (nat.= last tag)
+ (list (` [((~ (code.nat (dec tag))) #1 (~ g!left))
+ ((~ (code.nat (dec tag))) #1 (~ g!right))])
+ (` ((~ g!eq) (~ g!left) (~ g!right))))
+ (list (` [((~ (code.nat tag)) #0 (~ g!left))
+ ((~ (code.nat tag)) #0 (~ g!right))])
+ (` ((~ g!eq) (~ g!left) (~ g!right))))))
+ (list.enumeration members))))
(~ g!_)
#0))))))
## Tuples
@@ -131,13 +131,13 @@
[g!eqs (<type>.tuple (p.many equivalence))
#let [g!_ (code.local-identifier "_____________")
indices (list.indices (list.size g!eqs))
- g!lefts (list//map (|>> nat//encode (text//compose "left") code.local-identifier) indices)
- g!rights (list//map (|>> nat//encode (text//compose "right") code.local-identifier) indices)]]
+ g!lefts (list\map (|>> nat\encode (text\compose "left") code.local-identifier) indices)
+ g!rights (list\map (|>> nat\encode (text\compose "right") code.local-identifier) indices)]]
(wrap (` (: (~ (@Equivalence inputT))
(function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)])
(and (~+ (|> (list.zip/3 g!eqs g!lefts g!rights)
- (list//map (function (_ [g!eq g!left g!right])
- (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
+ (list\map (function (_ [g!eq g!left g!right])
+ (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
## Type recursion
(do !
[[g!self bodyC] (<type>.recursive equivalence)
@@ -156,7 +156,7 @@
(do !
[[funcC varsC bodyC] (<type>.polymorphic equivalence)]
(wrap (` (: (All [(~+ varsC)]
- (-> (~+ (list//map (|>> (~) ((~! /.Equivalence)) (`)) varsC))
+ (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC))
((~! /.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC)))))
(function ((~ funcC) (~+ varsC))
(~ bodyC))))))
diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux
index afe34c404..15c8c5906 100644
--- a/stdlib/source/poly/lux/data/format/json.lux
+++ b/stdlib/source/poly/lux/data/format/json.lux
@@ -18,14 +18,14 @@
["." product]
[number
["." i64]
- ["n" nat ("#//." decimal)]
+ ["n" nat ("#\." decimal)]
["." int]
- ["." frac ("#//." decimal)]]
- ["." text ("#//." equivalence)
+ ["." frac ("#\." decimal)]]
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
- ["." list ("#//." fold monad)]
- ["." row (#+ Row row) ("#//." monad)]
+ ["." list ("#\." fold monad)]
+ ["." row (#+ Row row) ("#\." monad)]
["d" dictionary]]]
[time
## ["." instant]
@@ -96,13 +96,13 @@
(def: decode
(|>> (:: ..int-codec decode) (:: e.functor map unit.in))))
-(poly: #export codec//encode
+(poly: #export codec\encode
(with-expansions
[<basic> (template [<matcher> <encoder>]
[(do !
[#let [g!_ (code.local-identifier "_______")]
_ <matcher>]
- (wrap (` (: (~ (@JSON//encode inputT))
+ (wrap (` (: (~ (@JSON\encode inputT))
<encoder>))))]
[(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)]
@@ -114,7 +114,7 @@
<time> (template [<type> <codec>]
[(do !
[_ (<type>.exactly <type>)]
- (wrap (` (: (~ (@JSON//encode inputT))
+ (wrap (` (: (~ (@JSON\encode inputT))
(|>> (:: (~! <codec>) (~' encode)) #/.String)))))]
## [duration.Duration duration.codec]
@@ -124,9 +124,9 @@
[month.Month month.codec])]
(do {! p.monad}
[*env* <type>.env
- #let [@JSON//encode (: (-> Type Code)
- (function (_ type)
- (` (-> (~ (poly.to-code *env* type)) /.JSON))))]
+ #let [@JSON\encode (: (-> Type Code)
+ (function (_ type)
+ (` (-> (~ (poly.to-code *env* type)) /.JSON))))]
inputT <type>.peek]
($_ p.either
<basic>
@@ -134,7 +134,7 @@
(do !
[unitT (<type>.apply (p.after (<type>.exactly unit.Qty)
<type>.any))]
- (wrap (` (: (~ (@JSON//encode inputT))
+ (wrap (` (: (~ (@JSON\encode inputT))
(:: (~! qty-codec) (~' encode))))))
(do !
[#let [g!_ (code.local-identifier "_______")
@@ -143,73 +143,73 @@
[_ _ =val=] (<type>.apply ($_ p.and
(<type>.exactly d.Dictionary)
(<type>.exactly .Text)
- codec//encode))]
- (wrap (` (: (~ (@JSON//encode inputT))
+ codec\encode))]
+ (wrap (` (: (~ (@JSON\encode inputT))
(|>> ((~! d.entries))
- ((~! list//map) (function ((~ g!_) [(~ g!key) (~ g!val)])
- [(~ g!key) ((~ =val=) (~ g!val))]))
+ ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)])
+ [(~ g!key) ((~ =val=) (~ g!val))]))
((~! d.from-list) (~! text.hash))
#/.Object)))))
(do !
[[_ =sub=] (<type>.apply ($_ p.and
(<type>.exactly .Maybe)
- codec//encode))]
- (wrap (` (: (~ (@JSON//encode inputT))
+ codec\encode))]
+ (wrap (` (: (~ (@JSON\encode inputT))
((~! ..nullable) (~ =sub=))))))
(do !
[[_ =sub=] (<type>.apply ($_ p.and
(<type>.exactly .List)
- codec//encode))]
- (wrap (` (: (~ (@JSON//encode inputT))
- (|>> ((~! list//map) (~ =sub=)) ((~! row.from-list)) #/.Array)))))
+ 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 (<type>.variant (p.many codec//encode))
+ members (<type>.variant (p.many codec\encode))
#let [last (dec (list.size members))]]
- (wrap (` (: (~ (@JSON//encode inputT))
+ (wrap (` (: (~ (@JSON\encode inputT))
(function ((~ g!_) (~ g!input))
(case (~ g!input)
- (~+ (list//join (list//map (function (_ [tag g!encode])
- (if (n.= last tag)
- (list (` ((~ (code.nat (dec tag))) #1 (~ g!input)))
- (` ((~! /.json) [(~ (code.frac (..tag (dec tag))))
- #1
- ((~ g!encode) (~ g!input))])))
- (list (` ((~ (code.nat tag)) #0 (~ g!input)))
- (` ((~! /.json) [(~ (code.frac (..tag tag)))
- #0
- ((~ g!encode) (~ g!input))])))))
- (list.enumeration members))))))))))
+ (~+ (list\join (list\map (function (_ [tag g!encode])
+ (if (n.= last tag)
+ (list (` ((~ (code.nat (dec tag))) #1 (~ g!input)))
+ (` ((~! /.json) [(~ (code.frac (..tag (dec tag))))
+ #1
+ ((~ g!encode) (~ g!input))])))
+ (list (` ((~ (code.nat tag)) #0 (~ g!input)))
+ (` ((~! /.json) [(~ (code.frac (..tag tag)))
+ #0
+ ((~ g!encode) (~ g!input))])))))
+ (list.enumeration members))))))))))
(do !
- [g!encoders (<type>.tuple (p.many codec//encode))
+ [g!encoders (<type>.tuple (p.many codec\encode))
#let [g!_ (code.local-identifier "_______")
g!members (|> (list.size g!encoders)
list.indices
- (list//map (|>> n//encode code.local-identifier)))]]
- (wrap (` (: (~ (@JSON//encode inputT))
+ (list\map (|>> n\encode code.local-identifier)))]]
+ (wrap (` (: (~ (@JSON\encode inputT))
(function ((~ g!_) [(~+ g!members)])
- ((~! /.json) [(~+ (list//map (function (_ [g!member g!encode])
- (` ((~ g!encode) (~ g!member))))
- (list.zip/2 g!members g!encoders)))]))))))
+ ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode])
+ (` ((~ g!encode) (~ g!member))))
+ (list.zip/2 g!members g!encoders)))]))))))
## Type recursion
(do !
- [[selfC non-recC] (<type>.recursive codec//encode)
+ [[selfC non-recC] (<type>.recursive codec\encode)
#let [g! (code.local-identifier "____________")]]
- (wrap (` (: (~ (@JSON//encode inputT))
+ (wrap (` (: (~ (@JSON\encode inputT))
((~! ..rec-encode) (.function ((~ g!) (~ selfC))
(~ non-recC)))))))
<type>.recursive-self
## Type applications
(do !
- [partsC (<type>.apply (p.many codec//encode))]
+ [partsC (<type>.apply (p.many codec\encode))]
(wrap (` ((~+ partsC)))))
## Polymorphism
(do !
- [[funcC varsC bodyC] (<type>.polymorphic codec//encode)]
+ [[funcC varsC bodyC] (<type>.polymorphic codec\encode)]
(wrap (` (: (All [(~+ varsC)]
- (-> (~+ (list//map (function (_ varC) (` (-> (~ varC) /.JSON)))
- varsC))
+ (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON)))
+ varsC))
(-> ((~ (poly.to-code *env* inputT)) (~+ varsC))
/.JSON)))
(function ((~ funcC) (~+ varsC))
@@ -220,12 +220,12 @@
(p.fail (format "Cannot create JSON encoder for: " (type.format inputT)))
))))
-(poly: #export codec//decode
+(poly: #export codec\decode
(with-expansions
[<basic> (template [<matcher> <decoder>]
[(do !
[_ <matcher>]
- (wrap (` (: (~ (@JSON//decode inputT))
+ (wrap (` (: (~ (@JSON\decode inputT))
(~! <decoder>)))))]
[(<type>.exactly Any) </>.null]
@@ -237,7 +237,7 @@
<time> (template [<type> <codec>]
[(do !
[_ (<type>.exactly <type>)]
- (wrap (` (: (~ (@JSON//decode inputT))
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! p.codec) (~! <codec>) (~! </>.string))))))]
## [duration.Duration duration.codec]
@@ -247,9 +247,9 @@
[month.Month month.codec])]
(do {! p.monad}
[*env* <type>.env
- #let [@JSON//decode (: (-> Type Code)
- (function (_ type)
- (` (</>.Parser (~ (poly.to-code *env* type))))))]
+ #let [@JSON\decode (: (-> Type Code)
+ (function (_ type)
+ (` (</>.Parser (~ (poly.to-code *env* type))))))]
inputT <type>.peek]
($_ p.either
<basic>
@@ -257,62 +257,62 @@
(do !
[unitT (<type>.apply (p.after (<type>.exactly unit.Qty)
<type>.any))]
- (wrap (` (: (~ (@JSON//decode inputT))
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! p.codec) (~! qty-codec) (~! </>.any))))))
(do !
[[_ _ valC] (<type>.apply ($_ p.and
(<type>.exactly d.Dictionary)
(<type>.exactly .Text)
- codec//decode))]
- (wrap (` (: (~ (@JSON//decode inputT))
+ codec\decode))]
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! </>.dictionary) (~ valC))))))
(do !
[[_ subC] (<type>.apply (p.and (<type>.exactly .Maybe)
- codec//decode))]
- (wrap (` (: (~ (@JSON//decode inputT))
+ codec\decode))]
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! </>.nullable) (~ subC))))))
(do !
[[_ subC] (<type>.apply (p.and (<type>.exactly .List)
- codec//decode))]
- (wrap (` (: (~ (@JSON//decode inputT))
+ codec\decode))]
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! </>.array) ((~! p.some) (~ subC)))))))
(do !
- [members (<type>.variant (p.many codec//decode))
+ [members (<type>.variant (p.many codec\decode))
#let [last (dec (list.size members))]]
- (wrap (` (: (~ (@JSON//decode inputT))
+ (wrap (` (: (~ (@JSON\decode inputT))
($_ ((~! p.or))
- (~+ (list//map (function (_ [tag memberC])
- (if (n.= last tag)
- (` (|> (~ memberC)
- ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1))))
- ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag))))))
- ((~! </>.array))))
- (` (|> (~ memberC)
- ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0))))
- ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
- ((~! </>.array))))))
- (list.enumeration members))))))))
+ (~+ (list\map (function (_ [tag memberC])
+ (if (n.= last tag)
+ (` (|> (~ memberC)
+ ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1))))
+ ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag))))))
+ ((~! </>.array))))
+ (` (|> (~ memberC)
+ ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0))))
+ ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
+ ((~! </>.array))))))
+ (list.enumeration members))))))))
(do !
- [g!decoders (<type>.tuple (p.many codec//decode))]
- (wrap (` (: (~ (@JSON//decode inputT))
+ [g!decoders (<type>.tuple (p.many codec\decode))]
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! </>.array) ($_ ((~! p.and)) (~+ g!decoders)))))))
## Type recursion
(do !
- [[selfC bodyC] (<type>.recursive codec//decode)
+ [[selfC bodyC] (<type>.recursive codec\decode)
#let [g! (code.local-identifier "____________")]]
- (wrap (` (: (~ (@JSON//decode inputT))
+ (wrap (` (: (~ (@JSON\decode inputT))
((~! p.rec) (.function ((~ g!) (~ selfC))
(~ bodyC)))))))
<type>.recursive-self
## Type applications
(do !
- [[funcC argsC] (<type>.apply (p.and codec//decode (p.many codec//decode)))]
+ [[funcC argsC] (<type>.apply (p.and codec\decode (p.many codec\decode)))]
(wrap (` ((~ funcC) (~+ argsC)))))
## Polymorphism
(do !
- [[funcC varsC bodyC] (<type>.polymorphic codec//decode)]
+ [[funcC varsC bodyC] (<type>.polymorphic codec\decode)]
(wrap (` (: (All [(~+ varsC)]
- (-> (~+ (list//map (|>> (~) </>.Parser (`)) varsC))
+ (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC))
(</>.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC)))))
(function ((~ funcC) (~+ varsC))
(~ bodyC))))))
@@ -342,7 +342,7 @@
(derived: (..codec Record)))}
(wrap (list (` (: (codec.Codec /.JSON (~ inputT))
(structure (def: (~' encode)
- (..codec//encode (~ inputT)))
+ (..codec\encode (~ inputT)))
(def: (~' decode)
- ((~! </>.run) (..codec//decode (~ inputT))))
+ ((~! </>.run) (..codec\decode (~ inputT))))
))))))
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index a9b4c9514..a05dee430 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -32,8 +32,8 @@
[world
["." file (#+ Path)]]]
["." / #_
- [action (#+ Action)]
["#" profile]
+ ["#." action (#+ Action)]
["#." project (#+ Project)]
["#." input]
["#." parser]
@@ -43,35 +43,21 @@
["#." repository (#+ Address)]
["#." dependency #_
["#" resolution]]
- ["#." command
+ ["#." command (#+ Command)
["#/." clean]
["#/." pom]
["#/." install]
+ ["#/." deps]
["#/." build]
["#/." test]
["#/." auto]
["#/." deploy]]])
-(def: (fetch-dependencies! profile)
- (-> /.Profile (Promise Any))
- (do promise.monad
- [outcome (do (try.with promise.monad)
- [cache (/cache.read-all (file.async file.default)
- (set.to-list (get@ #/.dependencies profile))
- /dependency.empty)
- resolution (promise.future
- (/dependency.resolve-all (set.to-list (get@ #/.repositories profile))
- (set.to-list (get@ #/.dependencies profile))
- cache))]
- (/cache.write-all (file.async file.default)
- resolution))]
- (wrap (case outcome
- (#try.Success _)
- (log! "Successfully resolved dependencies!")
-
- (#try.Failure error)
- (log! (format "Could not resolve dependencies:" text.new-line
- error))))))
+(def: (with-dependencies command profile)
+ (All [a] (-> (Command a) (Command a)))
+ (do /action.monad
+ [_ (/command/deps.do! profile)]
+ (command profile)))
(exception: (cannot-find-repository {repository Text}
{options (Dictionary Text Address)})
@@ -95,10 +81,6 @@
(exec (/command/pom.do! (file.async file.default) profile)
(wrap []))
- #/cli.Dependencies
- (exec (..fetch-dependencies! profile)
- (wrap []))
-
#/cli.Install
(exec (/command/install.do! (file.async file.default) profile)
(wrap []))
@@ -107,7 +89,7 @@
(exec (case [(get@ #/.identity profile)
(dictionary.get repository (get@ #/.deploy-repositories profile))]
[(#.Some artifact) (#.Some repository)]
- (/command/deploy.do! (/repository.async (/repository.default repository))
+ (/command/deploy.do! (/repository.async (/repository.remote repository))
(file.async file.default)
identity
artifact
@@ -120,17 +102,21 @@
(promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))
(wrap []))
+ #/cli.Dependencies
+ (exec (/command/deps.do! profile)
+ (wrap []))
+
(#/cli.Compilation compilation)
(case compilation
- #/cli.Build (exec (/command/build.do! profile)
+ #/cli.Build (exec (..with-dependencies /command/build.do! profile)
(wrap []))
- #/cli.Test (exec (/command/test.do! profile)
+ #/cli.Test (exec (..with-dependencies /command/test.do! profile)
(wrap [])))
(#/cli.Auto auto)
(exec (case auto
- #/cli.Build (/command/auto.do! /command/build.do! profile)
- #/cli.Test (/command/auto.do! /command/test.do! profile))
+ #/cli.Build (..with-dependencies (/command/auto.do! /command/build.do!) profile)
+ #/cli.Test (..with-dependencies (/command/auto.do! /command/test.do!) profile))
(wrap [])))
(#try.Failure error)
diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux
index 2a81b2869..ef72dc988 100644
--- a/stdlib/source/program/aedifex/cache.lux
+++ b/stdlib/source/program/aedifex/cache.lux
@@ -11,12 +11,14 @@
["!" capability]]]
[data
[binary (#+ Binary)]
+ ["." product]
[text
["%" format (#+ format)]
["." encoding]]
[collection
["." dictionary]
- ["." set]]
+ ["." set (#+ Set)]
+ ["." list]]
[format
["." xml]]]
[world
@@ -25,7 +27,7 @@
["#" local]
["#." hash]
["#." package (#+ Package)]
- ["#." artifact
+ ["#." artifact (#+ Artifact)
["#/." extension]]
[dependency (#+ Dependency)
[resolution (#+ Resolution)]]])
@@ -38,7 +40,7 @@
(!.use (:: file over-write) [content])))
(def: #export (write-one system [artifact type] package)
- (-> (file.System Promise) Dependency Package (Promise (Try Any)))
+ (-> (file.System Promise) Dependency Package (Promise (Try Artifact)))
(do (try.with promise.monad)
[directory (: (Promise (Try Path))
(file.make-directories promise.monad system (//.path system artifact)))
@@ -63,15 +65,17 @@
_ (..write! system
(|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8)
(format prefix //artifact/extension.pom))]
- (wrap [])))
+ (wrap artifact)))
(def: #export (write-all system resolution)
- (-> (file.System Promise) Resolution (Promise (Try Any)))
+ (-> (file.System Promise) Resolution (Promise (Try (Set Artifact))))
(do {! (try.with promise.monad)}
- [_ (monad.map ! (function (_ [dependency package])
- (..write-one system dependency package))
- (dictionary.entries resolution))]
- (wrap [])))
+ []
+ (|> (dictionary.entries resolution)
+ (list.filter (|>> product.right //package.local?))
+ (monad.map ! (function (_ [dependency package])
+ (..write-one system dependency package)))
+ (:: ! map (set.from-list //artifact.hash)))))
(def: (read! system path)
(-> (file.System Promise) Path (Promise (Try Binary)))
@@ -103,7 +107,8 @@
[pom (..decode xml.codec pom)
sha-1 (..decode //hash.sha-1-codec sha-1)
md5 (..decode //hash.md5-codec md5)]
- (wrap {#//package.library library
+ (wrap {#//package.origin #//package.Local
+ #//package.library library
#//package.pom pom
#//package.sha-1 sha-1
#//package.md5 md5}))))))
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 2e3e464a2..623a20841 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -26,6 +26,7 @@
["#." command (#+ Command)]
["#." local]
["#." cache]
+ ["#." repository]
["#." dependency (#+ Dependency)
["#/." resolution (#+ Resolution)]]
["#." shell]
@@ -128,10 +129,10 @@
[cache (///cache.read-all (file.async file.default)
(set.to-list (get@ #///.dependencies profile))
///dependency/resolution.empty)
- resolution (promise.future
- (///dependency/resolution.resolve-all (set.to-list (get@ #///.repositories profile))
- (set.to-list (get@ #///.dependencies profile))
- cache))
+ resolution (///dependency/resolution.all (list@map (|>> ///repository.remote ///repository.async)
+ (set.to-list (get@ #///.repositories profile)))
+ (set.to-list (get@ #///.dependencies profile))
+ cache)
_ (///cache.write-all (file.async file.default)
resolution)
[resolution compiler] (promise@wrap (..compiler resolution))
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index a083d8f53..37a5a0f40 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -44,5 +44,6 @@
_ (deploy! ///artifact/extension.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
_ (deploy! ///artifact/extension.lux-library library)
_ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library)))
- _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))]
+ _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))
+ #let [_ (log! "Successfully deployed!")]]
(wrap []))))
diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux
new file mode 100644
index 000000000..91bbf0ec1
--- /dev/null
+++ b/stdlib/source/program/aedifex/command/deps.lux
@@ -0,0 +1,37 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [concurrency
+ ["." promise]]]
+ [data
+ [collection
+ ["." set (#+ Set)]
+ ["." list ("#\." functor)]]]
+ [world
+ ["." file]]]
+ ["." /// #_
+ [command (#+ Command)]
+ [artifact (#+ Artifact)]
+ ["#" profile]
+ ["#." action (#+ Action)]
+ ["#." cache]
+ ["#." repository]
+ ["#." dependency #_
+ ["#" resolution]]])
+
+(def: #export (do! profile)
+ (Command (Set Artifact))
+ (do ///action.monad
+ [cache (///cache.read-all (file.async file.default)
+ (set.to-list (get@ #///.dependencies profile))
+ ///dependency.empty)
+ resolution (///dependency.all (list\map (|>> ///repository.remote ///repository.async)
+ (set.to-list (get@ #///.repositories profile)))
+ (set.to-list (get@ #///.dependencies profile))
+ cache)
+ cached (///cache.write-all (file.async file.default)
+ resolution)
+ #let [_ (log! "Successfully resolved dependencies!")]]
+ (wrap cached)))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 2c6a9b5e6..8becf87dd 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -4,13 +4,14 @@
[abstract
[codec (#+ Codec)]
[equivalence (#+ Equivalence)]
- [monad (#+ do)]]
+ [monad (#+ Monad do)]]
[control
- ["." io (#+ IO)]
["." try (#+ Try)]
["." exception (#+ Exception exception:)]
["<>" parser
- ["<.>" xml (#+ Parser)]]]
+ ["<.>" xml (#+ Parser)]]
+ [concurrency
+ ["." promise (#+ Promise)]]]
[data
["." binary (#+ Binary)]
["." name]
@@ -32,98 +33,60 @@
["." // (#+ Dependency)
["/#" // #_
["/" profile]
- ["#." repository (#+ Address)]
+ ["#." repository (#+ Address Repository)]
["#." hash]
["#." pom]
["#." package (#+ Package)]
- ["#." artifact
- ["#/." extension]]]])
-
-(import: java/lang/String)
-
-(import: java/lang/AutoCloseable
- (close [] #io #try void))
-
-(import: java/io/InputStream)
-
-(import: java/net/URL
- (new [java/lang/String])
- (openStream [] #io #try java/io/InputStream))
-
-(import: java/io/BufferedInputStream
- (new [java/io/InputStream])
- (read [[byte] int int] #io #try int))
-
-(def: buffer-size
- (n.* 512 1,024))
-
-(def: (download url)
- (-> URL (IO (Try Binary)))
- (do {! (try.with io.monad)}
- [input (|> (java/net/URL::new url)
- java/net/URL::openStream
- (:: ! map (|>> java/io/BufferedInputStream::new)))
- #let [buffer (binary.create ..buffer-size)]]
- (loop [output (:: binary.monoid identity)]
- (do !
- [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
- (case bytes-read
- -1 (do !
- [_ (java/lang/AutoCloseable::close input)]
- (wrap output))
- _ (if (n.= ..buffer-size bytes-read)
- (recur (:: binary.monoid compose output buffer))
- (do !
- [chunk (:: io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
- (recur (:: binary.monoid compose output chunk)))))))))
+ ["#." artifact (#+ Artifact)
+ ["#/." extension (#+ Extension)]]]])
(template [<name>]
[(exception: #export (<name> {dependency Dependency} {hash Text})
- (let [artifact (get@ #//.artifact dependency)
- type (get@ #//.type dependency)]
- (exception.report
- ["Artifact" (format (get@ #///artifact.group artifact)
- " " (get@ #///artifact.name artifact)
- " " (get@ #///artifact.version artifact))]
- ["Type" (%.text type)]
- ["Hash" (%.text hash)])))]
+ (exception.report
+ ["Artifact" (///artifact.format (get@ #//.artifact dependency))]
+ ["Type" (%.text (get@ #//.type dependency))]
+ ["Hash" (%.text hash)]))]
[sha-1-does-not-match]
[md5-does-not-match]
)
-(def: (verified-hash dependency library url hash codec exception)
+(def: (verified-hash dependency library repository artifact extension hash codec exception)
(All [h]
- (-> Dependency Binary URL
+ (-> Dependency Binary (Repository Promise) Artifact Extension
(-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h))
(Exception [Dependency Text])
- (IO (Try (///hash.Hash h)))))
- (do (try.with io.monad)
- [#let [expected (hash library)]
- actual (..download url)]
- (:: io.monad wrap
+ (Promise (Try (///hash.Hash h)))))
+ (do (try.with promise.monad)
+ [actual (:: repository download artifact extension)]
+ (:: promise.monad wrap
(do try.monad
[output (encoding.from-utf8 actual)
actual (:: codec decode output)
_ (exception.assert exception [dependency output]
- (:: ///hash.equivalence = expected actual))]
+ (:: ///hash.equivalence = (hash library) actual))]
(wrap actual)))))
-(def: #export (resolve repository dependency)
- (-> Address Dependency (IO (Try Package)))
+(def: #export (one repository dependency)
+ (-> (Repository Promise) Dependency (Promise (Try Package)))
(let [[artifact type] dependency
- prefix (format repository uri.separator (///artifact.uri artifact))]
- (do (try.with io.monad)
- [library (..download (format prefix (///artifact/extension.extension type)))
- sha-1 (..verified-hash dependency library (format prefix ///artifact/extension.sha-1) ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
- md5 (..verified-hash dependency library (format prefix ///artifact/extension.md5) ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
- pom (..download (format prefix ///artifact/extension.pom))]
- (:: io.monad wrap
+ extension (///artifact/extension.extension type)]
+ (do (try.with promise.monad)
+ [library (:: repository download artifact extension)
+ sha-1 (..verified-hash dependency library
+ repository artifact ///artifact/extension.sha-1
+ ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
+ md5 (..verified-hash dependency library
+ repository artifact ///artifact/extension.md5
+ ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
+ pom (:: repository download artifact ///artifact/extension.pom)]
+ (:: promise.monad wrap
(do try.monad
[pom (encoding.from-utf8 pom)
pom (:: xml.codec decode pom)
profile (<xml>.run ///pom.parser pom)]
- (wrap {#///package.library library
+ (wrap {#///package.origin #///package.Remote
+ #///package.library library
#///package.pom pom
#///package.sha-1 sha-1
#///package.md5 md5}))))))
@@ -140,46 +103,44 @@
(dictionary.equivalence ///package.equivalence))
(exception: #export (cannot-resolve {dependency Dependency})
- (let [artifact (get@ #//.artifact dependency)
- type (get@ #//.type dependency)]
- (exception.report
- ["Artifact" (%.text (///artifact.format artifact))]
- ["Type" (%.text type)])))
+ (exception.report
+ ["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))]
+ ["Type" (%.text (get@ #//.type dependency))]))
-(def: (resolve-any repositories dependency)
- (-> (List Address) Dependency (IO (Try Package)))
+(def: (any repositories dependency)
+ (-> (List (Repository Promise)) Dependency (Promise (Try Package)))
(case repositories
#.Nil
(|> dependency
(exception.throw ..cannot-resolve)
- (:: io.monad wrap))
+ (:: promise.monad wrap))
(#.Cons repository alternatives)
- (do io.monad
- [outcome (..resolve repository dependency)]
+ (do promise.monad
+ [outcome (..one repository dependency)]
(case outcome
(#try.Success package)
(wrap outcome)
(#try.Failure error)
- (resolve-any alternatives dependency)))))
+ (any alternatives dependency)))))
-(def: #export (resolve-all repositories dependencies resolution)
- (-> (List Address) (List Dependency) Resolution (IO (Try Resolution)))
+(def: #export (all repositories dependencies resolution)
+ (-> (List (Repository Promise)) (List Dependency) Resolution (Promise (Try Resolution)))
(case dependencies
#.Nil
- (:: (try.with io.monad) wrap resolution)
+ (:: (try.with promise.monad) wrap resolution)
(#.Cons head tail)
- (do (try.with io.monad)
+ (do (try.with promise.monad)
[package (case (dictionary.get head resolution)
(#.Some package)
(wrap package)
#.None
- (..resolve-any repositories head))
- sub-dependencies (:: io.monad wrap (///package.dependencies package))
+ (..any repositories head))
+ sub-dependencies (:: promise.monad wrap (///package.dependencies package))
resolution (|> resolution
(dictionary.put head package)
- (resolve-all repositories (set.to-list sub-dependencies)))]
- (resolve-all repositories tail resolution))))
+ (all repositories (set.to-list sub-dependencies)))]
+ (all repositories tail resolution))))
diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux
index e5e4e020f..35e3f17a8 100644
--- a/stdlib/source/program/aedifex/hash.lux
+++ b/stdlib/source/program/aedifex/hash.lux
@@ -131,11 +131,11 @@
(case (..hash-size input)
0 (constructor output)
(^template [<size> <write>]
- <size>
- (do try.monad
- [head (:: n.hex decode input)
- output (<write> index head output)]
- (constructor output)))
+ [<size>
+ (do try.monad
+ [head (:: n.hex decode input)
+ output (<write> index head output)]
+ (constructor output))])
([1 binary.write/8]
[2 binary.write/16]
[4 binary.write/32])
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index 31376c6f5..11d073b51 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -18,15 +18,42 @@
["#." hash (#+ Hash SHA-1 MD5)]
["#." pom]])
+(type: #export Origin
+ #Local
+ #Remote)
+
+(structure: any-equivalence
+ (Equivalence Any)
+
+ (def: (= _ _)
+ true))
+
+(def: origin-equivalence
+ (Equivalence Origin)
+ ($_ equivalence.sum
+ ..any-equivalence
+ ..any-equivalence))
+
(type: #export Package
- {#library Binary
+ {#origin Origin
+ #library Binary
#pom XML
#sha-1 (Hash SHA-1)
#md5 (Hash MD5)})
+(template [<name> <tag>]
+ [(def: #export <name>
+ (-> Package Bit)
+ (|>> (get@ #origin) (:: ..origin-equivalence = <tag>)))]
+
+ [local? #Local]
+ [remote? #Remote]
+ )
+
(def: #export (local pom library)
(-> XML Binary Package)
- {#library library
+ {#origin #Local
+ #library library
#pom pom
#sha-1 (//hash.sha-1 library)
#md5 (//hash.md5 library)})
@@ -40,6 +67,7 @@
(def: #export equivalence
(Equivalence Package)
($_ equivalence.product
+ ..origin-equivalence
binary.equivalence
xml.equivalence
//hash.equivalence
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
index 8b5ea26b6..e165c9e3b 100644
--- a/stdlib/source/program/aedifex/profile.lux
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -35,8 +35,8 @@
(def: (= reference subject)
(case [reference subject]
(^template [<tag>]
- [<tag> <tag>]
- true)
+ [[<tag> <tag>]
+ true])
([#Repo]
[#Manual])
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index 0c8f92993..5c622d84b 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -11,10 +11,12 @@
["." promise (#+ Promise)]
["." stm]]]
[data
- [binary (#+ Binary)]
+ ["." binary (#+ Binary)]
["." text
["%" format (#+ format)]
- ["." encoding]]]
+ ["." encoding]]
+ [number
+ ["n" nat]]]
[world
[net (#+ URL)
["." uri]]]]
@@ -90,6 +92,8 @@
(wrap (#try.Failure error))))))
)))
+(import: java/lang/String)
+
(import: java/lang/AutoCloseable
(close [] #io #try void))
@@ -97,8 +101,6 @@
(flush [] #io #try void)
(write [[byte]] #io #try void))
-(import: java/lang/String)
-
(import: java/net/URLConnection
(setDoOutput [boolean] #io #try void)
(setRequestProperty [java/lang/String java/lang/String] #io #try void)
@@ -110,7 +112,8 @@
(import: java/net/URL
(new [java/lang/String])
- (openConnection [] #io #try java/net/URLConnection))
+ (openConnection [] #io #try java/net/URLConnection)
+ (openStream [] #io #try java/io/InputStream))
(import: java/util/Base64$Encoder
(encodeToString [[byte]] java/lang/String))
@@ -118,6 +121,12 @@
(import: java/util/Base64
(#static getEncoder [] java/util/Base64$Encoder))
+(import: java/io/InputStream)
+
+(import: java/io/BufferedInputStream
+ (new [java/io/InputStream])
+ (read [[byte] int int] #io #try int))
+
(exception: #export (failure {code Int})
(exception.report
["Code" (%.int code)]))
@@ -131,11 +140,31 @@
(-> Address Artifact Extension URL)
(format address uri.separator (//artifact.uri artifact) extension))
-(structure: #export (default address)
+(def: buffer-size
+ (n.* 512 1,024))
+
+(structure: #export (remote address)
(All [s] (-> Address (Repository IO)))
(def: (download artifact extension)
- (io.io (#try.Failure "YOLO")))
+ (let [url (..url address artifact extension)]
+ (do {! (try.with io.monad)}
+ [input (|> (java/net/URL::new url)
+ java/net/URL::openStream
+ (:: ! map (|>> java/io/BufferedInputStream::new)))
+ #let [buffer (binary.create ..buffer-size)]]
+ (loop [output (:: binary.monoid identity)]
+ (do !
+ [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
+ (case bytes-read
+ -1 (do !
+ [_ (java/lang/AutoCloseable::close input)]
+ (wrap output))
+ _ (if (n.= ..buffer-size bytes-read)
+ (recur (:: binary.monoid compose output buffer))
+ (do !
+ [chunk (:: io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
+ (recur (:: binary.monoid compose output chunk))))))))))
(def: (upload [user password] artifact extension content)
(do (try.with io.monad)
diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux
index 9ad2c59a4..8cc7e3afb 100644
--- a/stdlib/source/program/scriptum.lux
+++ b/stdlib/source/program/scriptum.lux
@@ -168,24 +168,24 @@
(parameter->name type-func-info level idx)
(^template [<tag> <pre> <post>]
- [_ (<tag> id)]
- (format <pre> (%.nat id) <post>))
+ [[_ (<tag> id)]
+ (format <pre> (%.nat id) <post>)])
([#.Var "⌈v:" "⌋"]
[#.Ex "⟨e:" "⟩"])
(^template [<tag> <name> <flatten>]
- [_ (<tag> _)]
- (let [[level' body] (<flatten> type)
- args (level->args level level')
- body-doc (pprint-type-definition (n.+ level level') type-func-info tags module signature? recursive-type? body)]
- (format "(" <name> " " "[" (text.join-with " " args) "]"
- (case tags
- #.Nil
- (format " " body-doc)
-
- _
- (format text.new-line (prefix-lines " " body-doc)))
- ")")))
+ [[_ (<tag> _)]
+ (let [[level' body] (<flatten> type)
+ args (level->args level level')
+ body-doc (pprint-type-definition (n.+ level level') type-func-info tags module signature? recursive-type? body)]
+ (format "(" <name> " " "[" (text.join-with " " args) "]"
+ (case tags
+ #.Nil
+ (format " " body-doc)
+
+ _
+ (format text.new-line (prefix-lines " " body-doc)))
+ ")"))])
([#.UnivQ "All" type.flatten-univ-q]
[#.ExQ "Ex" type.flatten-ex-q])
@@ -233,19 +233,19 @@
(parameter->name [type-func-name (list)] level idx)
(^template [<tag> <pre> <post>]
- (<tag> id)
- (format <pre> (%.nat id) <post>))
+ [(<tag> id)
+ (format <pre> (%.nat id) <post>)])
([#.Var "⌈" "⌋"]
[#.Ex "⟨" "⟩"])
(^template [<tag> <name> <flatten>]
- (<tag> _)
- (let [[level' body] (<flatten> type)
- args (level->args level level')
- body-doc (pprint-type (n.+ level level') type-func-name module body)]
- (format "(" <name> " " "[" (|> args (list.interpose " ") (text.join-with "")) "]"
- (format " " body-doc)
- ")")))
+ [(<tag> _)
+ (let [[level' body] (<flatten> type)
+ args (level->args level level')
+ body-doc (pprint-type (n.+ level level') type-func-name module body)]
+ (format "(" <name> " " "[" (|> args (list.interpose " ") (text.join-with "")) "]"
+ (format " " body-doc)
+ ")"))])
([#.UnivQ "All" type.flatten-univ-q]
[#.ExQ "Ex" type.flatten-ex-q])
diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux
index d0b62ddc6..69c1cc8ab 100644
--- a/stdlib/source/spec/lux/world/shell.lux
+++ b/stdlib/source/spec/lux/world/shell.lux
@@ -11,7 +11,7 @@
["." promise (#+ Promise)]]]
[data
["." product]
- ["." text ("#//." equivalence)
+ ["." text ("#\." equivalence)
["%" format (#+ format)]]
[number
["n" nat]
@@ -41,7 +41,7 @@
(_.claim [/.Can-Read]
(case ?read
(#try.Success actual)
- (text//= expected actual)
+ (text\= expected actual)
(#try.Failure error)
false))
diff --git a/stdlib/source/test/lux/control/parser/tree.lux b/stdlib/source/test/lux/control/parser/tree.lux
index efea74853..93fec1175 100644
--- a/stdlib/source/test/lux/control/parser/tree.lux
+++ b/stdlib/source/test/lux/control/parser/tree.lux
@@ -36,7 +36,7 @@
(!expect (^multi (#try.Success actual)
(n.= expected actual)))))))
-(template: (!cover2 <coverage> <parser> <sample0> <sample1>)
+(template: (!cover/2 <coverage> <parser> <sample0> <sample1>)
(do {! random.monad}
[dummy random.nat
expected (|> random.nat (random.filter (|>> (n.= dummy) not)))]
@@ -112,50 +112,50 @@
(list (tree.leaf expected)
(tree.leaf dummy)
(tree.leaf dummy))))
- (!cover2 [/.next]
- (do //.monad
- [_ /.next
- _ /.next]
- /.value)
- (tree.branch dummy
- (list (tree.branch dummy
- (list (tree.leaf expected)))))
- (tree.branch dummy
- (list (tree.leaf dummy)
- (tree.leaf expected))))
- (!cover2 [/.prev]
- (do //.monad
- [_ /.next
- _ /.next
- _ /.prev]
- /.value)
- (tree.branch dummy
- (list (tree.branch expected
- (list (tree.leaf dummy)))))
- (tree.branch dummy
- (list (tree.leaf expected)
- (tree.leaf dummy))))
- (!cover2 [/.end]
- (do //.monad
- [_ /.end]
- /.value)
- (tree.branch dummy
- (list (tree.branch dummy
- (list (tree.leaf expected)))))
- (tree.branch dummy
- (list (tree.leaf dummy)
- (tree.leaf expected))))
- (!cover2 [/.start]
- (do //.monad
- [_ /.end
- _ /.start]
- /.value)
- (tree.branch expected
- (list (tree.branch dummy
- (list (tree.leaf dummy)))))
- (tree.branch expected
- (list (tree.leaf dummy)
- (tree.leaf dummy))))
+ (!cover/2 [/.next]
+ (do //.monad
+ [_ /.next
+ _ /.next]
+ /.value)
+ (tree.branch dummy
+ (list (tree.branch dummy
+ (list (tree.leaf expected)))))
+ (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf expected))))
+ (!cover/2 [/.previous]
+ (do //.monad
+ [_ /.next
+ _ /.next
+ _ /.previous]
+ /.value)
+ (tree.branch dummy
+ (list (tree.branch expected
+ (list (tree.leaf dummy)))))
+ (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy))))
+ (!cover/2 [/.end]
+ (do //.monad
+ [_ /.end]
+ /.value)
+ (tree.branch dummy
+ (list (tree.branch dummy
+ (list (tree.leaf expected)))))
+ (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf expected))))
+ (!cover/2 [/.start]
+ (do //.monad
+ [_ /.end
+ _ /.start]
+ /.value)
+ (tree.branch expected
+ (list (tree.branch dummy
+ (list (tree.leaf dummy)))))
+ (tree.branch expected
+ (list (tree.leaf dummy)
+ (tree.leaf dummy))))
(do {! random.monad}
[dummy random.nat]
(_.cover [/.cannot-move-further]
@@ -167,6 +167,6 @@
[/.down] [/.up]
[/.right] [/.left]
- [/.next] [/.prev]
+ [/.next] [/.previous]
))))))
)))
diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux
index 6d0ab8a6c..f934879ee 100644
--- a/stdlib/source/test/lux/data/collection/tree/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux
@@ -1,114 +1,261 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
- [abstract/monad (#+ do Monad)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]
+ ["$." functor]
+ ["$." comonad]]}]
[control
pipe]
[data
- ["." maybe]
+ ["." product]
+ ["." maybe ("#\." functor)]
["." text]
[number
["n" nat]]
[collection
["." list]]]
[math
- ["r" random]]]
+ ["." random]]]
["." //]
{1
["." / (#+ Zipper)
- ["tree" //]]}
- )
+ ["tree" //]]})
+
+(def: move
+ Test
+ (do random.monad
+ [expected random.nat
+ dummy (random.filter (|>> (n.= expected) not) random.nat)]
+ ($_ _.and
+ (_.cover [/.down]
+ (|> (tree.branch dummy (list (tree.leaf expected)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.up]
+ (|> (tree.branch expected (list (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [/.up]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.right]
+ (|> (tree.branch dummy (list (tree.leaf dummy) (tree.leaf expected)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [/.right]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.rightmost]
+ (|> (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf expected)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [/.rightmost]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.left]
+ (|> (tree.branch dummy (list (tree.leaf expected) (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [/.right]
+ [/.left]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.leftmost]
+ (|> (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [/.rightmost]
+ [/.leftmost]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.next]
+ (and (|> (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.next]
+ [/.value (n.= expected) wrap])
+ (maybe.default false))
+ (|> (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf expected)))
+ /.zip
+ (do> maybe.monad
+ [/.next]
+ [/.next]
+ [/.value (n.= expected) wrap])
+ (maybe.default false))))
+ (_.cover [/.end]
+ (|> (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf expected)))
+ /.zip
+ (do> maybe.monad
+ [/.end]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.start]
+ (|> (tree.branch expected
+ (list (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.end]
+ [/.start]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.previous]
+ (and (|> (tree.branch expected
+ (list (tree.leaf dummy)
+ (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.next]
+ [/.previous]
+ [/.value (n.= expected) wrap])
+ (maybe.default false))
+ (|> (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.next]
+ [/.next]
+ [/.previous]
+ [/.value (n.= expected) wrap])
+ (maybe.default false))))
+ )))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.Zipper)))
- (do {! r.monad}
- [[size sample] (//.tree r.nat)
- mid-val r.nat
- new-val r.nat
- pre-val r.nat
- post-val r.nat
- #let [(^open "tree@.") (tree.equivalence n.equivalence)
- (^open "list@.") (list.equivalence n.equivalence)]]
+ (<| (_.covering /._)
+ (_.with-cover [/.Zipper])
+ (do {! random.monad}
+ [[size sample] (//.tree random.nat)
+ expected random.nat
+ dummy (random.filter (|>> (n.= expected) not) random.nat)
+ #let [(^open "tree\.") (tree.equivalence n.equivalence)
+ (^open "list\.") (list.equivalence n.equivalence)]]
($_ _.and
- (_.test "Trees can be converted to/from zippers."
- (|> sample
- /.zip /.unzip
- (tree@= sample)))
- (_.test "Creating a zipper gives you a start node."
- (|> sample /.zip /.start?))
- (_.test "Can move down inside branches. Can move up from lower nodes."
- (let [zipper (/.zip sample)]
- (if (/.branch? zipper)
- (let [child (|> zipper /.down)]
- (and (not (tree@= sample (/.unzip child)))
- (|> child /.up (is? zipper) not)
- (|> child /.start (is? zipper) not)))
- (and (/.leaf? zipper)
- (|> zipper (/.prepend-child new-val) /.branch?)))))
- (do !
- [branch-value r.nat
- #let [zipper (|> (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))
- (/.prepend-child pre-val)
- (/.append-child post-val))]]
- (_.test "Can prepend and append children."
- (and (and (|> zipper /.down /.value (is? pre-val))
- (|> zipper /.down /.right /.left /.value (is? pre-val))
- (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)))
- (|> zipper /.down /.right /.value (is? mid-val))
- (and (|> zipper /.down /.right /.right /.value (is? post-val))
- (|> zipper /.down /.rightmost /.value (is? post-val))))))
- (do !
- [branch-value r.nat
- #let [zipper (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))]]
- (_.test "Can insert children around a node (unless it's start)."
- (and (let [zipper (|> zipper
- /.down
- (/.insert-left pre-val)
- maybe.assume
- (/.insert-right post-val)
- maybe.assume
- /.up)]
- (and (|> zipper /.down /.value (is? pre-val))
- (|> zipper /.down /.right /.value (is? mid-val))
- (|> zipper /.down /.right /.right /.value (is? post-val))
- (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
- (|> zipper /.down /.right /.left /.value (is? pre-val))
- (|> zipper /.down /.rightmost /.value (is? post-val))))
- (and (|> zipper
- (/.insert-left pre-val)
- (case> (#.Some _) false
- #.None true))
- (|> zipper
- (/.insert-right post-val)
- (case> (#.Some _) false
- #.None true))))))
- (_.test "Can set and update the value of a node."
- (|> sample /.zip (/.set new-val) /.value (n.= new-val)))
- (_.test "Zipper traversal follows the outline of the tree depth-first."
- (let [root (/.zip sample)]
- (list@= (tree.flatten sample)
- (loop [zipper (/.start root)]
- (let [zipper' (/.next zipper)]
- (#.Cons (/.value zipper)
- (if (:: (/.equivalence n.equivalence) = root zipper')
- (list)
- (recur zipper'))))))))
- (_.test "Backwards zipper traversal yield reverse tree flatten."
- (let [root (/.zip sample)]
- (list@= (list.reverse (tree.flatten sample))
- (loop [zipper (/.end root)]
- (#.Cons (/.value zipper)
- (if (:: (/.equivalence n.equivalence) = root zipper)
- (list)
- (recur (/.prev zipper))))))))
- (_.test "Can remove nodes (except start nodes)."
- (let [zipper (/.zip sample)]
- (if (/.branch? zipper)
- (and (|> zipper /.down /.start? not)
- (|> zipper /.down /.remove (case> #.None false
- (#.Some node) (/.start? node))))
- (|> zipper /.remove (case> #.None true
- (#.Some _) false)))))
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec (/.equivalence n.equivalence) (:: ! map (|>> product.right /.zip) (//.tree random.nat))))
+ (_.with-cover [/.functor]
+ ($functor.spec (|>> tree.leaf /.zip) /.equivalence /.functor))
+ (_.with-cover [/.comonad]
+ ($comonad.spec (|>> tree.leaf /.zip) /.equivalence /.comonad))
+
+ (_.cover [/.zip /.unzip]
+ (|> sample /.zip /.unzip (tree\= sample)))
+ (_.cover [/.start?]
+ (|> sample /.zip /.start?))
+ (_.cover [/.leaf?]
+ (/.leaf? (/.zip (tree.leaf expected))))
+ (_.cover [/.branch?]
+ (and (/.branch? (/.zip (tree.branch expected (list (tree.leaf expected)))))
+ (not (/.branch? (/.zip (tree.branch expected (list)))))))
+ (_.cover [/.value]
+ (and (n.= expected (/.value (/.zip (tree.leaf expected))))
+ (n.= expected (/.value (/.zip (tree.branch expected (list (tree.leaf expected))))))))
+ (_.cover [/.set]
+ (|> (/.zip (tree.leaf dummy))
+ (/.set expected)
+ /.value
+ (n.= expected)))
+ (_.cover [/.update]
+ (|> (/.zip (tree.leaf expected))
+ (/.update inc)
+ /.value
+ (n.= (inc expected))))
+ ..move
+ (_.cover [/.end?]
+ (or (/.end? (/.zip sample))
+ (|> sample
+ /.zip
+ /.end
+ (maybe\map /.end?)
+ (maybe.default false))))
+ (_.cover [/.interpose]
+ (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy)))
+ /.zip
+ (/.interpose expected))]
+ (and (n.= dummy (/.value cursor))
+ (|> cursor
+ (do> maybe.monad
+ [/.down]
+ [/.value (n.= expected) wrap])
+ (maybe.default false))
+ (|> cursor
+ (do> maybe.monad
+ [/.down]
+ [/.down]
+ [/.value (n.= dummy) wrap])
+ (maybe.default false)))))
+ (_.cover [/.adopt]
+ (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy)))
+ /.zip
+ (/.adopt expected))]
+ (and (n.= dummy (/.value cursor))
+ (|> cursor
+ (do> maybe.monad
+ [/.down]
+ [/.value (n.= expected) wrap])
+ (maybe.default false))
+ (|> cursor
+ (do> maybe.monad
+ [/.down]
+ [/.right]
+ [/.value (n.= dummy) wrap])
+ (maybe.default false)))))
+ (_.cover [/.insert-left]
+ (|> (tree.branch dummy (list (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [(/.insert-left expected)]
+ [/.left]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.insert-right]
+ (|> (tree.branch dummy (list (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [(/.insert-right expected)]
+ [/.right]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
+ (_.cover [/.remove]
+ (|> (tree.branch dummy (list (tree.leaf dummy)))
+ /.zip
+ (do> maybe.monad
+ [/.down]
+ [(/.insert-left expected)]
+ [/.remove]
+ [/.value (n.= expected) wrap])
+ (maybe.default false)))
))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
index faa3fa85f..2f3e7e8ba 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -59,19 +59,19 @@
(r@wrap (list (' #0) (' #1)))
(^template [<tag> <gen> <wrapper>]
- [_ (<tag> _)]
- (if allow-literals?
- (do {! r.monad}
- [?sample (r.maybe <gen>)]
- (case ?sample
- (#.Some sample)
- (do !
- [else (exhaustive-branches allow-literals? variantTC inputC)]
- (wrap (list& (<wrapper> sample) else)))
+ [[_ (<tag> _)]
+ (if allow-literals?
+ (do {! r.monad}
+ [?sample (r.maybe <gen>)]
+ (case ?sample
+ (#.Some sample)
+ (do !
+ [else (exhaustive-branches allow-literals? variantTC inputC)]
+ (wrap (list& (<wrapper> sample) else)))
- #.None
- (wrap (list (' _)))))
- (r@wrap (list (' _)))))
+ #.None
+ (wrap (list (' _)))))
+ (r@wrap (list (' _))))])
([#.Nat r.nat code.nat]
[#.Int r.int code.int]
[#.Rev r.rev code.rev]
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index 3936c7a65..4846f5e7d 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -71,8 +71,8 @@
#1
(^template [<tag>]
- (<tag> left right)
- (and (valid-type? left) (valid-type? right)))
+ [(<tag> left right)
+ (and (valid-type? left) (valid-type? right))])
([#.Sum] [#.Product] [#.Function])
(#.Named name type')