diff options
Diffstat (limited to '')
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') |