diff options
74 files changed, 919 insertions, 839 deletions
diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index c8b60c5a2..16e262360 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -36,7 +36,6 @@ ["@" target (.only) ["_" python]] ["[0]" compiler - ["[0]" phase (.only Operation Phase) (.use "[1]#[0]" monad)] [reference [variable (.only Register)]] [language @@ -46,7 +45,7 @@ ["[0]" synthesis] [analysis [macro (.only Expander)]] - [phase + ["[0]" phase (.only Operation Phase) (.use "[1]#[0]" monad) ["[0]" extension (.only Extender Handler) ["[0]" analysis ["[1]" python]] diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index 2bfa5e5af..b65249c33 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -47,90 +47,19 @@ ... else it)) -(with_template [<op> <name>] - [(def .public (<name> ratio it) - (-> Frac Color Color) - (let [it (hsl.of_rgb (rgb it))] - (|> (hsl.hsl (hsl.hue it) - (|> it - hsl.saturation - (f.* (|> +1.0 (<op> (..ratio ratio)))) - (f.min +1.0)) - (hsl.luminance it)) - hsl.rgb - of_rgb)))] - - [f.+ saturated] - [f.- un_saturated] - ) - -(def .public (gray_scale color) - (-> Color Color) - (let [color (hsl.of_rgb (rgb color))] - (|> (hsl.hsl +0.0 - +0.0 - (hsl.luminance color)) - hsl.rgb - of_rgb))) - -(with_template [<name> <1> <2>] - [(`` (def .public (<name> color) - (-> Color [Color Color Color]) - (let [hsl (hsl.of_rgb (rgb color)) - hue (hsl.hue hsl) - saturation (hsl.saturation hsl) - luminance (hsl.luminance hsl)] - [color - (|> (hsl.hsl (|> hue (f.+ <1>) ..ratio) - saturation - luminance) - hsl.rgb - of_rgb) - (|> (hsl.hsl (|> hue (f.+ <2>) ..ratio) - saturation - luminance) - hsl.rgb - of_rgb)])))] - - [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] - [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] - [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] - ) - -(with_template [<name> <1> <2> <3>] - [(`` (def .public (<name> color) - (-> Color [Color Color Color Color]) - (let [it (hsl.of_rgb (..rgb color)) - hue (hsl.hue it) - saturation (hsl.saturation it) - luminance (hsl.luminance it) - of_hue (is (-> hsl.Value - Color) - (function (_ hue) - (|> (hsl.hsl hue saturation luminance) - hsl.rgb - ..of_rgb)))] - [color - (|> hue (f.+ <1>) ..ratio of_hue) - (|> hue (f.+ <2>) ..ratio of_hue) - (|> hue (f.+ <3>) ..ratio of_hue)])))] - - [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] - [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] - ) - (type .public Spread Frac) +... https://en.wikipedia.org/wiki/Color_scheme (type .public Palette (-> Spread Nat Color (List Color))) (def .public (analogous spread variations it) Palette (let [it (hsl.of_rgb (..rgb it)) - hue (hsl.hue it) - saturation (hsl.saturation it) - luminance (hsl.luminance it) + hue (the hsl.#hue it) + saturation (the hsl.#saturation it) + luminance (the hsl.#luminance it) spread (..ratio spread)] (list#each (function (_ idx) (|> (hsl.hsl (|> idx ++ .int int.frac (f.* spread) (f.+ hue) ..ratio) diff --git a/stdlib/source/library/lux/data/color/cmyk.lux b/stdlib/source/library/lux/data/color/cmyk.lux index ae47d9604..bd0a9d298 100644 --- a/stdlib/source/library/lux/data/color/cmyk.lux +++ b/stdlib/source/library/lux/data/color/cmyk.lux @@ -78,9 +78,9 @@ (def .public (cmyk it) (-> RGB CMYK) - (let [red (..down (rgb.red it)) - green (..down (rgb.green it)) - blue (..down (rgb.blue it)) + (let [red (..down (the rgb.#red it)) + green (..down (the rgb.#green it)) + blue (..down (the rgb.#blue it)) key (opposite (all f.max red green blue)) f (if (f.< ..most key) (f./ (opposite key) diff --git a/stdlib/source/library/lux/data/color/hsb.lux b/stdlib/source/library/lux/data/color/hsb.lux index 5421c2dc3..ede1ffd08 100644 --- a/stdlib/source/library/lux/data/color/hsb.lux +++ b/stdlib/source/library/lux/data/color/hsb.lux @@ -97,9 +97,9 @@ (def .public (of_rgb it) (-> RGB HSB) - (let [red (..down (rgb.red it)) - green (..down (rgb.green it)) - blue (..down (rgb.blue it)) + (let [red (..down (the rgb.#red it)) + green (..down (the rgb.#green it)) + blue (..down (the rgb.#blue it)) max (all f.max red green blue) min (all f.min red green blue) diff --git a/stdlib/source/library/lux/data/color/hsl.lux b/stdlib/source/library/lux/data/color/hsl.lux index ce57f5210..835864b26 100644 --- a/stdlib/source/library/lux/data/color/hsl.lux +++ b/stdlib/source/library/lux/data/color/hsl.lux @@ -10,10 +10,7 @@ [math [number ["i" int] - ["f" frac]]] - [meta - [type - ["[0]" nominal]]]]] + ["f" frac]]]]] [// ["[0]" rgb (.only RGB)]]) @@ -56,117 +53,170 @@ (|>> (f.max ..least) (f.min ..most))) -(nominal.def .public HSL +(type .public HSL (Record [#hue Value #saturation Value - #luminance Value]) - - (def .public equivalence - (Equivalence HSL) - (implementation - (def (= left right) - (`` (and (,, (with_template [<slot>] - [(f.= (the <slot> (nominal.representation left)) - (the <slot> (nominal.representation right)))] - - [#hue] - [#saturation] - [#luminance] - ))))))) - - (with_template [<name> <slot>] - [(def .public <name> - (-> HSL - Value) - (|>> nominal.representation - (the <slot>)))] - - [hue #hue] - [saturation #saturation] - [luminance #luminance] - ) - - (def .public (hsl hue saturation luminance) - (-> Frac Frac Frac - HSL) - (nominal.abstraction - [#hue (..value hue) - #saturation (..value saturation) - #luminance (..value luminance)])) - - (def .public (of_rgb it) - (-> RGB - HSL) - (let [red (..down (rgb.red it)) - green (..down (rgb.green it)) - blue (..down (rgb.blue it)) - - max (all f.max red green blue) - min (all f.min red green blue) - luminance (|> (f.+ max min) (f./ +2.0))] - (nominal.abstraction - (if (f.= max min) - ... Achromatic - [#hue ..least - #saturation ..least - #luminance luminance] - ... Chromatic - (let [diff (|> max (f.- min)) - saturation (|> diff - (f./ (if (f.> +0.5 luminance) - (|> +2.0 (f.- max) (f.- min)) - (|> max (f.+ min))))) - hue' (cond (f.= red max) - (|> green (f.- blue) (f./ diff) - (f.+ (if (f.< blue green) +6.0 +0.0))) - - (f.= green max) - (|> blue (f.- red) (f./ diff) - (f.+ +2.0)) - - ... (f.= blue max) - (|> red (f.- green) (f./ diff) - (f.+ +4.0)))] - [#hue (|> hue' (f./ +6.0)) - #saturation saturation - #luminance luminance]))))) - - (def (hue_rgb p q t) - (-> Frac Frac Frac - Nat) - (let [t (cond (f.< +0.0 t) (f.+ +1.0 t) - (f.> +1.0 t) (f.- +1.0 t) - ... else - t) - f2/3 (f./ +3.0 +2.0)] - (..up (cond (f.< (f./ +6.0 +1.0) t) - (|> q (f.- p) (f.* +6.0) (f.* t) (f.+ p)) - - (f.< (f./ +2.0 +1.0) t) - q - - (f.< f2/3 t) - (|> q (f.- p) (f.* (|> f2/3 (f.- t))) (f.* +6.0) (f.+ p)) - - ... else - p)))) - - (def .public (rgb it) - (-> HSL - RGB) - (let [[hue saturation luminance] (nominal.representation it)] - (if (f.= ..least saturation) - ... Achromatic - (let [intensity (..up luminance)] - (rgb.rgb intensity intensity intensity)) - ... Chromatic - (let [q (if (f.< +0.5 luminance) - (|> saturation (f.+ +1.0) (f.* luminance)) - (|> luminance (f.+ saturation) (f.- (f.* saturation luminance)))) - p (|> luminance (f.* +2.0) (f.- q)) - third (|> +1.0 (f./ +3.0))] - (rgb.rgb (|> hue (f.+ third) (hue_rgb p q)) - (|> hue (hue_rgb p q)) - (|> hue (f.- third) (hue_rgb p q))))))) + #luminance Value])) + +(def .public equivalence + (Equivalence HSL) + (implementation + (def (= left right) + (`` (and (,, (with_template [<slot>] + [(f.= (the <slot> left) + (the <slot> right))] + + [#hue] + [#saturation] + [#luminance] + ))))))) + +(def .public (hsl hue saturation luminance) + (-> Frac Frac Frac + HSL) + [#hue (..value hue) + #saturation (..value saturation) + #luminance (..value luminance)]) + +(def .public (of_rgb it) + (-> RGB + HSL) + (let [red (..down (the rgb.#red it)) + green (..down (the rgb.#green it)) + blue (..down (the rgb.#blue it)) + + max (all f.max red green blue) + min (all f.min red green blue) + luminance (|> (f.+ max min) (f./ +2.0))] + (if (f.= max min) + ... Achromatic + [#hue ..least + #saturation ..least + #luminance luminance] + ... Chromatic + (let [diff (|> max (f.- min)) + saturation (|> diff + (f./ (if (f.> +0.5 luminance) + (|> +2.0 (f.- max) (f.- min)) + (|> max (f.+ min))))) + hue' (cond (f.= red max) + (|> green (f.- blue) (f./ diff) + (f.+ (if (f.< blue green) +6.0 +0.0))) + + (f.= green max) + (|> blue (f.- red) (f./ diff) + (f.+ +2.0)) + + ... (f.= blue max) + (|> red (f.- green) (f./ diff) + (f.+ +4.0)))] + [#hue (|> hue' (f./ +6.0)) + #saturation saturation + #luminance luminance])))) + +(def (hue_rgb p q t) + (-> Frac Frac Frac + Nat) + (let [t (cond (f.< +0.0 t) (f.+ +1.0 t) + (f.> +1.0 t) (f.- +1.0 t) + ... else + t) + f2/3 (f./ +3.0 +2.0)] + (..up (cond (f.< (f./ +6.0 +1.0) t) + (|> q (f.- p) (f.* +6.0) (f.* t) (f.+ p)) + + (f.< (f./ +2.0 +1.0) t) + q + + (f.< f2/3 t) + (|> q (f.- p) (f.* (|> f2/3 (f.- t))) (f.* +6.0) (f.+ p)) + + ... else + p)))) + +(def .public (rgb (open "/[0]")) + (-> HSL + RGB) + (if (f.= ..least /#saturation) + ... Achromatic + (let [intensity (..up /#luminance)] + (rgb.rgb intensity intensity intensity)) + ... Chromatic + (let [q (if (f.< +0.5 /#luminance) + (|> /#saturation (f.+ +1.0) (f.* /#luminance)) + (|> /#luminance (f.+ /#saturation) (f.- (f.* /#saturation /#luminance)))) + p (|> /#luminance (f.* +2.0) (f.- q)) + third (|> +1.0 (f./ +3.0))] + (rgb.rgb (|> /#hue (f.+ third) (hue_rgb p q)) + (|> /#hue (hue_rgb p q)) + (|> /#hue (f.- third) (hue_rgb p q)))))) + +(def (ratio it) + (-> Frac + Frac) + (cond (f.> +1.0 it) + (f.% +1.0 it) + + (f.< +0.0 it) + (|> it (f.% +1.0) (f.+ +1.0)) + + ... else + it)) + +(with_template [<op> <name>] + [(def .public (<name> ratio (open "/[0]")) + (-> Frac HSL + HSL) + (..hsl /#hue + (|> /#saturation + (f.* (|> +1.0 (<op> (..ratio ratio)))) + (f.min +1.0)) + /#luminance))] + + [f.+ saturated] + [f.- un_saturated] + ) + +(def .public gray_scale + (-> HSL + HSL) + (|>> (the #luminance) + (..hsl +0.0 + +0.0))) + +(with_template [<name> <1> <2>] + [(`` (def .public (<name> it) + (-> HSL + [HSL HSL HSL]) + (let [(open "/[0]") it] + [it + (..hsl (|> /#hue (f.+ <1>) ..ratio) + /#saturation + /#luminance) + (..hsl (|> /#hue (f.+ <2>) ..ratio) + /#saturation + /#luminance)])))] + + [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] + [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] + [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] + ) + +(with_template [<name> <1> <2> <3>] + [(`` (def .public (<name> it) + (-> HSL + [HSL HSL HSL HSL]) + (let [(open "/[0]") it + of_hue (is (-> Value + HSL) + (function (_ hue) + (..hsl hue /#saturation /#luminance)))] + [it + (|> /#hue (f.+ <1>) ..ratio of_hue) + (|> /#hue (f.+ <2>) ..ratio of_hue) + (|> /#hue (f.+ <3>) ..ratio of_hue)])))] + + [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] + [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] ) diff --git a/stdlib/source/library/lux/data/color/rgb.lux b/stdlib/source/library/lux/data/color/rgb.lux index deb97365f..4dff2eb5d 100644 --- a/stdlib/source/library/lux/data/color/rgb.lux +++ b/stdlib/source/library/lux/data/color/rgb.lux @@ -5,7 +5,7 @@ [monad (.only do)] [monoid (.only Monoid)] [equivalence (.only Equivalence)] - ["[0]" hash (.only Hash)]] + [hash (.only Hash)]] [control [function [predicate (.only Predicate)]]] @@ -16,10 +16,7 @@ ["n" nat] ["i" int] ["f" frac] - ["[0]" i64]]] - [meta - [type - ["[0]" nominal]]]]]) + ["[0]" i64]]]]]) (def .public limit Nat @@ -48,104 +45,83 @@ (|>> (n.max ..least) (n.min ..most))) -(nominal.def .public RGB +(type .public RGB (Record [#red Value #green Value - #blue Value]) - - (def .public (rgb red green blue) - (-> Nat Nat Nat - RGB) - (nominal.abstraction - [#red (value red) - #green (value green) - #blue (value blue)])) - - (with_template [<name> <slot>] - [(def .public <name> - (-> RGB - Value) - (|>> nominal.representation - (the <slot>)))] - - [red #red] - [green #green] - [blue #blue] - ) - - (def .public hash - (Hash RGB) - (of hash.functor each - (|>> nominal.representation) - (all product.hash - n.hash - n.hash - n.hash - ))) - - (def .public equivalence - (Equivalence RGB) - (of ..hash equivalence)) - - (def (opposite_intensity value) - (-> Nat - Nat) - (|> ..most - (n.- value))) - - (def .public (complement it) - (-> RGB - RGB) - (nominal.abstraction - (`` [(,, (with_template [<slot>] - [<slot> (|> it - nominal.representation - (the <slot>) - opposite_intensity)] - - [#red] - [#green] - [#blue] - ))]))) - - (def .public black - RGB - (nominal.abstraction - [#red ..least - #green ..least - #blue ..least])) - - (def .public white - RGB - (nominal.abstraction - [#red ..most - #green ..most - #blue ..most])) - - (with_template [<monoid> <identity> <composite> <left> <right>] - [(def .public <monoid> - (Monoid RGB) - (implementation - (def identity - <identity>) - - (def (composite left right) - (let [left (<left> left) - right (<right> right)] - (nominal.abstraction - (`` [(,, (with_template [<slot>] - [<slot> (<composite> (the <slot> (nominal.representation left)) - (the <slot> (nominal.representation right)))] - - [#red] - [#green] - [#blue] - ))]))))))] - - [addition ..black n.max |> |>] - [subtraction ..white n.min ..complement |>] - ) + #blue Value])) + +(def .public (rgb red green blue) + (-> Nat Nat Nat + RGB) + [#red (value red) + #green (value green) + #blue (value blue)]) + +(def .public hash + (Hash RGB) + (all product.hash + n.hash + n.hash + n.hash + )) + +(def .public equivalence + (Equivalence RGB) + (of ..hash equivalence)) + +(def (opposite_intensity value) + (-> Nat + Nat) + (|> ..most + (n.- value))) + +(def .public (complement it) + (-> RGB + RGB) + (`` [(,, (with_template [<slot>] + [<slot> (|> it + (the <slot>) + opposite_intensity)] + + [#red] + [#green] + [#blue] + ))])) + +(def .public black + RGB + [#red ..least + #green ..least + #blue ..least]) + +(def .public white + RGB + [#red ..most + #green ..most + #blue ..most]) + +(with_template [<monoid> <identity> <composite> <left> <right>] + [(def .public <monoid> + (Monoid RGB) + (implementation + (def identity + <identity>) + + (def (composite left right) + (let [left (<left> left) + right (<right> right)] + (`` [(,, (with_template [<slot>] + [<slot> (<composite> (the <slot> left) + (the <slot> right))] + + [#red] + [#green] + [#blue] + ))])))))] + + [addition ..black n.max |> |>] + [subtraction ..white n.min ..complement |>] ) (def (ratio it) @@ -172,9 +148,9 @@ (f.+ (|> end .int i.frac (f.* dE))) f.int .nat)))] - (..rgb (interpolated' (..red end) (..red start)) - (interpolated' (..green end) (..green start)) - (interpolated' (..blue end) (..blue start))))) + (..rgb (interpolated' (the #red end) (the #red start)) + (interpolated' (the #green end) (the #green start)) + (interpolated' (the #blue end) (the #blue start))))) (with_template [<name> <target>] [(def .public <name> diff --git a/stdlib/source/library/lux/data/color/terminal.lux b/stdlib/source/library/lux/data/color/terminal.lux index 64cf6bb64..06c23c6b3 100644 --- a/stdlib/source/library/lux/data/color/terminal.lux +++ b/stdlib/source/library/lux/data/color/terminal.lux @@ -90,9 +90,9 @@ (let [it (//.rgb it)] (|> [(%.format ..command <command> - ";" (%.nat (rgb.red it)) - ";" (%.nat (rgb.green it)) - ";" (%.nat (rgb.blue it)) + ";" (%.nat (the rgb.#red it)) + ";" (%.nat (the rgb.#green it)) + ";" (%.nat (the rgb.#blue it)) "m") <reset>] (nominal.abstraction Command))))] diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index bcd8117d7..ce8d8b478 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -21,13 +21,13 @@ [target ["/" js]] [compiler - ["[0]" phase] [meta [cache ["[0]" dependency ["[1]" artifact]]]] [language [lux + ["[0]" phase] ["[0]" translation] ["[0]" declaration] [analysis diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index b88cc91e9..8c0aa7b00 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -21,13 +21,13 @@ [target ["/" lua]] [compiler - ["[0]" phase] [meta [cache ["[0]" dependency ["[1]" artifact]]]] [language [lux + ["[0]" phase] ["[0]" translation] ["[0]" declaration] [analysis diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 4f1b21b79..faf492f1e 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -21,13 +21,13 @@ [target ["/" python]] [compiler - ["[0]" phase] [meta [cache ["[0]" dependency ["[1]" artifact]]]] [language [lux + ["[0]" phase] ["[0]" translation] ["[0]" declaration] [analysis diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 8f85a5f00..bd76976e7 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -23,12 +23,12 @@ [target ["/" ruby]] [compiler - ["[0]" phase] [meta [cache ["[0]" dependency ["[1]" artifact]]]] [language + ["[0]" phase] [lux ["[0]" translation] ["[0]" declaration] diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index a952076c2..de44e4d21 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -22,9 +22,9 @@ [type ["[0]" check]] [compiler - ["[0]" phase (.use "[1]#[0]" monad)] [language [lux + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" analysis (.only Analysis Operation Phase) ["[0]" type]]]] [meta diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index d4c342829..8c12039a6 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -24,9 +24,9 @@ ["[0]" file]]]] ["[0]" // ["/[1]" // (.only Instancer) - ["[1][0]" phase] [language [lux + ["[0]" phase] ["[1][0]" program (.only Program)] ["[1][0]" syntax (.only Aliases)] ["[1][0]" synthesis] @@ -102,7 +102,7 @@ (def (with_analysis_defaults bundle) (-> ///analysis.Bundle (Operation Any)) - (do [! ///phase.monad] + (do [! phase.monad] [_ (|> bundle dictionary.entries (monad.each ! @@ -114,7 +114,7 @@ (def (with_synthesis_defaults bundle) (-> ///synthesis.Bundle (Operation Any)) - (do [! ///phase.monad] + (do [! phase.monad] [_ (|> bundle dictionary.entries (monad.each ! @@ -127,7 +127,7 @@ (All (_ anchor expression declaration) (-> (///translation.Bundle anchor expression declaration) (///declaration.Operation anchor expression declaration Any))) - (do [! ///phase.monad] + (do [! phase.monad] [_ (|> bundle dictionary.entries (monad.each ! @@ -140,7 +140,7 @@ (All (_ anchor expression declaration) (-> (///declaration.Bundle anchor expression declaration) (///declaration.Operation anchor expression declaration Any))) - (do [! ///phase.monad] + (do [! phase.monad] [_ (|> bundle dictionary.entries (monad.each ! @@ -163,7 +163,7 @@ (///declaration.Operation anchor expression declaration Any))) (when module .prelude - (do ///phase.monad + (do phase.monad [_ (with_analysis_defaults analysis_bundle) _ (with_synthesis_defaults synthesis_bundle) _ (with_translation_defaults translation_bundle)] @@ -171,7 +171,7 @@ luxD.bundle))) _ - (with ///phase.monad + (with phase.monad (in [])))) (def (begin dependencies hash input all_extensions) @@ -180,14 +180,14 @@ (Extensions anchor expression declaration) (///declaration.Operation anchor expression declaration [Source (Payload declaration)]))) - (do ///phase.monad + (do phase.monad [.let [module (the ///.#module input)] _ (///declaration.set_current_module module) _ (///declaration.of_analysis (moduleA.create hash module)) _ (with_defaults module all_extensions)] (///declaration.of_analysis - (do [! ///phase.monad] + (do [! phase.monad] [_ (monad.each ! moduleA.import dependencies) .let [source (///analysis.source (the ///.#module input) (the ///.#code input))] _ (///analysis.set_source_code source)] @@ -198,7 +198,7 @@ (-> descriptor.Module (All (_ anchor expression declaration) (///declaration.Operation anchor expression declaration [.Module (Payload declaration)]))) - (do ///phase.monad + (do phase.monad [_ (///declaration.of_analysis (moduleA.set_compiled module)) analysis_module (<| (is (Operation .Module)) @@ -217,7 +217,7 @@ (-> (Extender anchor expression declaration) (///declaration.Operation anchor expression declaration (Payload declaration)))) - (do ///phase.monad + (do phase.monad [buffer (///declaration.of_translation ///translation.buffer) registry (///declaration.of_translation @@ -227,10 +227,10 @@ ... TODO: Inline ASAP (def (process_declaration wrapper archive extender expander pre_payoad code) (All (_ anchor expression declaration) - (-> ///phase.Wrapper Archive (Extender anchor expression declaration) Expander (Payload declaration) Code + (-> phase.Wrapper Archive (Extender anchor expression declaration) Expander (Payload declaration) Code (///declaration.Operation anchor expression declaration [Requirements (Payload declaration)]))) - (do ///phase.monad + (do phase.monad [.let [[pre_buffer pre_registry] pre_payoad] _ (///declaration.of_translation (///translation.set_buffer pre_buffer)) @@ -243,10 +243,10 @@ (def (iteration' wrapper archive extender expander reader source pre_payload) (All (_ anchor expression declaration) - (-> ///phase.Wrapper Archive (Extender anchor expression declaration) Expander Reader Source (Payload declaration) + (-> phase.Wrapper Archive (Extender anchor expression declaration) Expander Reader Source (Payload declaration) (///declaration.Operation anchor expression declaration [Source Requirements (Payload declaration)]))) - (do ///phase.monad + (do phase.monad [[source code] (///declaration.of_analysis (..read source reader)) [requirements post_payload] (process_declaration wrapper archive extender expander pre_payload code)] @@ -254,14 +254,14 @@ (def (iteration wrapper archive extender expander module source pre_payload aliases) (All (_ anchor expression declaration) - (-> ///phase.Wrapper Archive (Extender anchor expression declaration) Expander descriptor.Module Source (Payload declaration) Aliases + (-> phase.Wrapper Archive (Extender anchor expression declaration) Expander descriptor.Module Source (Payload declaration) Aliases (///declaration.Operation anchor expression declaration (Maybe [Source Requirements (Payload declaration)])))) - (do ///phase.monad + (do phase.monad [reader (///declaration.of_analysis (..reader module aliases source))] (function (_ state) - (when (///phase.result' state (..iteration' wrapper archive extender expander reader source pre_payload)) + (when (phase.result' state (..iteration' wrapper archive extender expander reader source pre_payload)) {try.#Success [state source&requirements&buffer]} {try.#Success [state {.#Some source&requirements&buffer}]} @@ -288,19 +288,19 @@ (Program expression declaration) (-> Archive Symbol (///translation.Operation <parameters> expression)) descriptor.Module Text (///translation.Operation <parameters> Any))) - (do ///phase.monad + (do phase.monad [ [@program _] (///translation.definition archive [program_module program_definition]) @self (///translation.learn [///program.name {.#None}] true (set.has @program (set.empty unit.hash))) |program| (global archive [program_module program_definition]) - @module (///phase.of_try (archive.id program_module archive))] + @module (phase.of_try (archive.id program_module archive))] (///translation.save! @self {.#None} (program [@module @self] |program|)))) (def .public (compiler program global wrapper extender expander prelude write_declaration program_module program_definition extensions) (All (_ <parameters>) (-> (Program expression declaration) (-> Archive Symbol (///translation.Operation <parameters> expression)) - ///phase.Wrapper (Extender <parameters>) Expander descriptor.Module (-> declaration Binary) + phase.Wrapper (Extender <parameters>) Expander descriptor.Module (-> declaration Binary) descriptor.Module (Maybe Text) (Extensions <parameters>) (Instancer (///declaration.State <parameters>) .Module))) @@ -311,10 +311,10 @@ ///.#process (function (_ state archive) (do [! try.monad] [.let [hash (text#hash (the ///.#code input))] - [state [source buffer]] (<| (///phase.result' state) + [state [source buffer]] (<| (phase.result' state) (..begin dependencies hash input extensions)) .let [module (the ///.#module input)]] - (loop (again [iteration (<| (///phase.result' state) + (loop (again [iteration (<| (phase.result' state) (..iteration wrapper archive extender expander module source buffer ///syntax.no_aliases))]) (do ! [[state ?source&requirements&temporary_payload] iteration] @@ -322,8 +322,8 @@ {.#None} (do ! [[state [analysis_module [final_buffer final_registry]]] - (<| (///phase.result' state) - (do [! ///phase.monad] + (<| (phase.result' state) + (do [! phase.monad] [_ (if (text#= program_module module) (when program_definition {.#Some program_definition} @@ -355,8 +355,8 @@ (the ///declaration.#imports) (list#each product.left)) ///.#process (function (_ state archive) - (again (<| (///phase.result' state) - (do [! ///phase.monad] + (again (<| (phase.result' state) + (do [! phase.monad] [analysis_module (<| (is (Operation .Module)) ///declaration.of_analysis meta.current_module) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 14d737c9f..a17939fe9 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -37,7 +37,6 @@ ["[0]" // ["[1][0]" init] ["/[1]" // (.only) - ["[0]" phase (.only Phase) (.use "[1]#[0]" monad)] [language [lux [program (.only Program)] @@ -49,7 +48,7 @@ ["[1][0]" analysis (.only) [macro (.only Expander)] ["[0]A" module]] - [phase + ["[0]" phase (.only Phase) (.use "[1]#[0]" monad) ["[0]" extension]]]] [meta [import (.only Import)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux index 4adaf01c2..64e4418d0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -36,12 +36,11 @@ ["[1][0]" complex (.only Tuple Variant Complex)] ["[1][0]" pattern (.only Pattern)] [// - [phase + ["[0]" phase (.only) ["[0]" extension (.only Extension)]] [/// [arity (.only Arity)] ["[0]" version (.only Version)] - ["[0]" phase] ["[0]" reference (.only Reference) ["[0]" variable (.only Register Variable)]] [meta diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux index 8ef79556a..f9487e936 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux @@ -25,10 +25,10 @@ [phase ["[0]P" analysis] [// + ["[0]" phase] ["[0]" synthesis] ["[0]" translation] [/// - ["[0]" phase] [meta ["[0]" archive (.only Archive) ["[0]" module]]]]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux index c3f14a075..79de9721f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux @@ -25,10 +25,9 @@ ["/" // (.only Analysis Operation Phase) ["[1][0]" type] [// - [phase + ["[0]" phase (.use "[1]#[0]" monad) ["[0]" extension]] [/// - ["[0]" phase (.use "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux index 7abe0bc57..f9f715ca0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux @@ -10,7 +10,7 @@ [data ["[0]" text ["%" \\format (.only format)]]]]] - [///// + [/// ["[0]" phase]]) (exception.def .public (expansion_failed [macro inputs error]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux index 8a47ab3b6..29dad85d1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux @@ -15,9 +15,8 @@ ["[0]" list (.use "[1]#[0]" mix functor) ["[0]" property]]]]]] ["/" // (.only Operation) - ["//[1]" // - [/// - ["[1]" phase]]]]) + [// + ["[0]" phase]]]) (exception.def .public (unknown_module module) (Exception Text) @@ -57,7 +56,7 @@ (def .public (import module) (-> Text (Operation Any)) - (do ///.monad + (do phase.monad [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules @@ -71,7 +70,7 @@ (def .public (alias alias module) (-> Text Text (Operation Any)) - (do ///.monad + (do phase.monad [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules @@ -97,7 +96,7 @@ (def .public (define name exported?,definition) (-> Text [Bit Global] (Operation Any)) - (do ///.monad + (do phase.monad [self_name meta.current_module_name self meta.current_module] (function (_ state) @@ -137,7 +136,7 @@ (def .public (with hash name action) (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) - (do ///.monad + (do phase.monad [_ (..create hash name) output (/.with_current_module name action) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux index bdfa5b776..e909fd3d2 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux @@ -14,10 +14,11 @@ ["[0]" list (.use "[1]#[0]" functor mix monoid) ["[0]" property]]]]]] ["/" // (.only Environment Operation Phase) - [//// + [// ["[0]" phase] - [reference - ["[0]" variable (.only Register Variable)]]]]) + [/// + [reference + ["[0]" variable (.only Register Variable)]]]]]) (type Local (Bindings Text [Type Register])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux index f14a75e91..1ac2f8010 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux @@ -20,7 +20,7 @@ [type ["[0]" check (.only Check)]]]]] ["/" // (.only Operation) - [//// + [// ["[0]" phase]]]) (def .public (check action) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux index b0e7db3c2..6d33706fb 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux @@ -12,10 +12,9 @@ ["[0]" analysis] ["[0]" synthesis] ["[0]" translation] - [phase + ["[0]" phase (.only) ["[0]" extension]] [/// - ["[0]" phase] [meta [archive [module diff --git a/stdlib/source/library/lux/meta/compiler/phase.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase.lux index ddd18c7b6..7192d1aff 100644 --- a/stdlib/source/library/lux/meta/compiler/phase.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase.lux @@ -17,15 +17,16 @@ [time ["[0]" instant] ["[0]" duration]]]]] - [// + [//// [meta [archive (.only Archive)]]]) -(type .public (Operation s o) - (state.+State Try s o)) +(type .public (Operation state of) + (state.+State Try state of)) (def .public functor - (All (_ s) (Functor (Operation s))) + (All (_ state) + (Functor (Operation state))) (implementation (def (each f it) (function (_ state) @@ -37,7 +38,8 @@ {try.#Failure error}))))) (def .public monad - (All (_ s) (Monad (Operation s))) + (All (_ state) + (Monad (Operation state))) (implementation (def functor ..functor) @@ -54,52 +56,61 @@ {try.#Failure error} {try.#Failure error}))))) -(type .public (Phase s i o) - (-> Archive i (Operation s o))) +(type .public (Phase state input output) + (-> Archive input + (Operation state output))) (type .public Wrapper - (All (_ s i o) (-> (Phase s i o) Any))) + (All (_ state input output) + (-> (Phase state input output) + Any))) (def .public (result' state operation) - (All (_ s o) - (-> s (Operation s o) (Try [s o]))) + (All (_ state of) + (-> state (Operation state of) + (Try [state of]))) (operation state)) (def .public (result state operation) - (All (_ s o) - (-> s (Operation s o) (Try o))) + (All (_ state of) + (-> state (Operation state of) + (Try of))) (|> state operation (of try.monad each product.right))) (def .public state - (All (_ s o) - (Operation s s)) + (All (_ state) + (Operation state state)) (function (_ state) {try.#Success [state state]})) (def .public (with state) - (All (_ s o) - (-> s (Operation s Any))) + (All (_ state) + (-> state + (Operation state Any))) (function (_ _) {try.#Success [state []]})) (def .public (sub [get set] operation) - (All (_ s s' o) - (-> [(-> s s') (-> s' s s)] - (Operation s' o) - (Operation s o))) + (All (_ state state' of) + (-> [(-> state state') (-> state' state state)] + (Operation state' of) + (Operation state of))) (function (_ state) (do try.monad [[state' output] (operation (get state))] (in [(set state' state) output])))) (def .public failure - (-> Text Operation) + (-> Text + Operation) (|>> {try.#Failure} (state.lifted try.monad))) (def .public (except exception parameters) - (All (_ e) (-> (Exception e) e Operation)) + (All (_ of) + (-> (Exception of) of + Operation)) (..failure (exception.error exception parameters))) (def .public (of_try error) @@ -128,15 +139,16 @@ {try.#Success [state {try.#Failure error}]}))) (def .public identity - (All (_ s a) (Phase s a a)) + (All (_ state of) + (Phase state of of)) (function (_ archive input state) {try.#Success [state input]})) (def .public (composite pre post) - (All (_ s0 s1 i t o) - (-> (Phase s0 i t) - (Phase s1 t o) - (Phase [s0 s1] i o))) + (All (_ state/0 state/1 input middle output) + (-> (Phase state/0 input middle) + (Phase state/1 middle output) + (Phase [state/0 state/1] input output))) (function (_ archive input [pre/state post/state]) (do try.monad [[pre/state' temp] (pre archive input pre/state) @@ -144,21 +156,24 @@ (in [[pre/state' post/state'] output])))) (def .public (read get) - (All (_ s v) - (-> (-> s v) (Operation s v))) + (All (_ state of) + (-> (-> state of) + (Operation state of))) (function (_ state) {try.#Success [state (get state)]})) (def .public (update transform) - (All (_ s) - (-> (-> s s) (Operation s Any))) + (All (_ state) + (-> (-> state state) + (Operation state Any))) (function (_ state) {try.#Success [(transform state) []]})) (def .public (localized get set transform) - (All (_ s s' v) - (-> (-> s s') (-> s' s s) (-> s' s') - (-> (Operation s v) (Operation s v)))) + (All (_ state state' of) + (-> (-> state state') (-> state' state state) (-> state' state') + (-> (Operation state of) + (Operation state of)))) (function (_ operation) (function (_ state) (let [old (get state)] @@ -170,9 +185,10 @@ failure))))) (def .public (temporary transform) - (All (_ s v) - (-> (-> s s) - (-> (Operation s v) (Operation s v)))) + (All (_ state of) + (-> (-> state state) + (-> (Operation state of) + (Operation state of)))) (function (_ operation) (function (_ state) (when (operation (transform state)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux index 7448e0212..eeaeb40a7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux @@ -28,14 +28,14 @@ ["[1][0]" reference] ["[1][0]" when] ["[1][0]" function] - ["/[1]" // + [// ["[0]" extension] - ["/[1]" // + [// + ["//" phase] ["/" analysis (.only Analysis Operation Phase Handler Extender) ["[1][0]" macro (.only Expander)] ["[1][0]" type]] [/// - ["//" phase] ["[0]" reference] [meta [archive (.only Archive)]]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux index 10f276346..27cadb489 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -25,16 +25,15 @@ ["[0]" check]]]]] ["[0]" // ["[1][0]" simple] - ["/[1]" // - [// - ["/" analysis (.only Analysis Operation Phase) - ["[1][0]" complex (.only Tag)] - ["[1][0]" type] - ["[1][0]" inference]] - [/// - ["[1]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]) + [/// + ["[0]" phase (.use "[1]#[0]" monad)] + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" complex (.only Tag)] + ["[1][0]" type] + ["[1][0]" inference]] + [/// + [meta + [archive (.only Archive)]]]]]) (exception.def .public (not_a_quantified_type type) (Exception Type) @@ -115,7 +114,7 @@ (-> Phase Nat Bit Phase) (let [tag (/complex.tag right? lefts)] (function (again valueC) - (do [! ///.monad] + (do [! phase.monad] [expectedT meta.expected_type expectedT' (/type.check (check.clean (list) expectedT)) @ meta.location] @@ -185,7 +184,7 @@ (def .public (variant analyse tag archive valueC) (-> Phase Symbol Phase) - (do [! ///.monad] + (do [! phase.monad] [tag (meta.normal tag) [lefts,right? variantT] (meta.tag tag) [lefts right?] (when lefts,right? @@ -209,7 +208,7 @@ (def (typed_product analyse expectedT archive members) (-> Phase Type Archive (List Code) (Operation Analysis)) - (<| (do [! ///.monad] + (<| (do [! phase.monad] [@ meta.location]) (of ! each (|>> (/.tuple @))) (is (Operation (List Analysis))) @@ -241,7 +240,7 @@ (def .public (product analyse archive membersC) (-> Phase Archive (List Code) (Operation Analysis)) - (do [! ///.monad] + (do [! phase.monad] [expectedT meta.expected_type] (/.with_exception ..cannot_analyse_tuple [expectedT membersC] (when expectedT @@ -319,21 +318,21 @@ (when input (list.partial [_ {.#Symbol ["" slotH]}] valueH tail) (if pattern_matching? - (///#in {.#None}) - (do ///.monad + (phase#in {.#None}) + (do phase.monad [slotH (meta.normal ["" slotH])] (again tail {.#Item [slotH valueH] output}))) (list.partial [_ {.#Symbol slotH}] valueH tail) - (do ///.monad + (do phase.monad [slotH (meta.normal slotH)] (again tail {.#Item [slotH valueH] output})) {.#End} - (///#in {.#Some output}) + (phase#in {.#Some output}) _ - (///#in {.#None})))) + (phase#in {.#None})))) (def (local_binding? name) (-> Text (Meta Bit)) @@ -397,7 +396,7 @@ ... Records, thus, get transformed into tuples by ordering the elements. (def (order' head_k original_record) (-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) - (do [! ///.monad] + (do [! phase.monad] [record (<| meta.try (monad.each ! (function (_ [slot value]) (do ! @@ -408,10 +407,10 @@ {try.#Success record} (do ! [.let [record (sorted_record record)] - _ (///.assertion ..cannot_order_record [(` same_record?) original_record] - (same_record? record)) - _ (///.assertion ..cannot_order_record [(` complete_record?) original_record] - (complete_record? record))] + _ (phase.assertion ..cannot_order_record [(` same_record?) original_record] + (same_record? record)) + _ (phase.assertion ..cannot_order_record [(` complete_record?) original_record] + (complete_record? record))] (in (do maybe.monad [[[_ :record:] _] (list.head record)] (in [(list.size record) @@ -426,14 +425,14 @@ (when record ... empty_record = empty_tuple = unit/any = [] {.#End} - (///#in {.#Some [0 (list) .Any]}) + (phase#in {.#Some [0 (list) .Any]}) {.#Item [head_k head_v] _} (when head_k ["" head_k'] (if pattern_matching? - (///#in {.#None}) - (do ///.monad + (phase#in {.#None}) + (do phase.monad [local_binding? (..local_binding? head_k')] (if local_binding? (in {.#None}) @@ -452,7 +451,7 @@ (analyse archive singletonC) (list [_ {.#Symbol pseudo_slot}] singletonC) - (do [! ///.monad] + (do [! phase.monad] [head_k (meta.normal pseudo_slot) slot (meta.try (meta.slot head_k))] (when slot @@ -468,7 +467,7 @@ (..product analyse archive members))) _ - (do [! ///.monad] + (do [! phase.monad] [?members (..normal false members)] (when ?members {.#None} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux index 06aef00dd..e0a0958a6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -19,16 +19,15 @@ ["[0]" meta (.only) ["[0]" type (.only) ["[0]" check]]]]] - ["[0]" /// - [// - ["/" analysis (.only Analysis Operation Phase) - ["[1][0]" type] - ["[1][0]" inference] - ["[1][0]" scope]] - [/// - ["[1]" phase (.use "[1]#[0]" functor)] - [reference (.only) - [variable (.only)]]]]]) + [//// + ["[0]" phase (.use "[1]#[0]" functor)] + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" type] + ["[1][0]" inference] + ["[1][0]" scope]] + [/// + [reference (.only) + [variable (.only)]]]]) (exception.def .public (cannot_analyse [expected function argument body]) (Exception [Type Text Text Code]) @@ -51,7 +50,7 @@ (def .public (function analyse function_name arg_name archive body) (-> Phase Text Text Phase) - (do [! ///.monad] + (do [! phase.monad] [expectedT meta.expected_type] (loop (again [expectedT expectedT]) (/.with_exception ..cannot_analyse [expectedT function_name arg_name body] @@ -135,5 +134,5 @@ (def .public (apply analyse argsC+ :function: functionA archive functionC) (-> Phase (List Code) Type Analysis Phase) (|> (/inference.general archive analyse :function: argsC+) - (///#each (|>> product.right [functionA] /.reified)) + (phase#each (|>> product.right [functionA] /.reified)) (/.with_exception ..cannot_apply [:function: functionC argsC+]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux index 733295658..a1331052a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux @@ -5,14 +5,13 @@ [monad (.only do)]] ["[0]" meta (.only) ["[0]" code]]]] - ["[0]" /// - [// - ["/" analysis (.only Analysis Operation Phase Extender) - ["[0]" scope]] - [/// - ["[0]" phase] - [meta - [archive (.only Archive)]]]]]) + [//// + ["[0]" phase] + ["/" analysis (.only Analysis Operation Phase Extender) + ["[0]" scope]] + [/// + [meta + [archive (.only Archive)]]]]) (def .public (reference extender analysis archive quoted_module it) (-> Extender Phase Archive Text Symbol (Operation Analysis)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux index 914fe1fe7..ea315f7fc 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux @@ -4,19 +4,17 @@ ["[0]" meta] [abstract [monad (.only do)]]]] - ["[0]" /// - [// - ["/" analysis (.only Analysis Operation) - ["[1][0]" simple] - ["[1][0]" type]] - [/// - ["[1]" phase]]]]) + [//// + ["[0]" phase] + ["/" analysis (.only Analysis Operation) + ["[1][0]" simple] + ["[1][0]" type]]]) (with_template [<name> <type> <tag>] [(def .public (<name> value) (-> <type> (Operation Analysis)) - (do ///.monad + (do phase.monad [_ (/type.inference <type>) @ meta.location] (in [@ {/.#Simple {<tag> value}}])))] @@ -31,7 +29,7 @@ (def .public unit (Operation Analysis) - (do ///.monad + (do phase.monad [_ (/type.inference .Any) @ meta.location] (in [@ {/.#Simple {/simple.#Unit}}]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux index ef35059ba..101ff23c5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux @@ -22,20 +22,17 @@ ["^" pattern]] ["[0]" type (.only) ["[0]" check (.only Check)]]]]] - ["[0]" / - ["/[1]" // - ["[1][0]" complex] - ["/[1]" // - [// - ["/" analysis (.only Analysis Operation Phase) - ["[1][0]" simple] - ["[1][0]" complex] - ["[1][0]" pattern (.only Pattern)] - ["[1][0]" type] - ["[1][0]" scope] - ["[1][0]" coverage (.only Coverage)]] - [/// - ["[1]" phase]]]]]]) + ["[0]" // + ["[1][0]" complex] + [/// + ["[0]" phase] + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" simple] + ["[1][0]" complex] + ["[1][0]" pattern (.only Pattern)] + ["[1][0]" type] + ["[1][0]" scope] + ["[1][0]" coverage (.only Coverage)]]]]) (exception.def .public (mismatch [type pattern]) (Exception [Type Code]) @@ -152,7 +149,7 @@ (def (simple_pattern_analysis type :input: location output next) (All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) (/.with_location location - (do ///.monad + (do phase.monad [_ (/type.check (check.check :input: type)) outputA next] (in [output outputA])))) @@ -161,7 +158,7 @@ (All (_ a) (-> (-> Type Code (Operation a) (Operation [Pattern a])) Type (List Code) (Operation a) (Operation [Pattern a]))) - (do [! ///.monad] + (do [! phase.monad] [[@ex_var+ :input:'] (/type.check (..tuple :input:))] (.when :input:' {.#Product _} @@ -229,7 +226,7 @@ (.when pattern [location {.#Symbol ["" name]}] (/.with_location location - (do ///.monad + (do phase.monad [outputA (/scope.with_local [name :input:] next) idx /scope.next] @@ -251,7 +248,7 @@ [location {.#Tuple sub_patterns}] (/.with_location location - (do [! ///.monad] + (do [! phase.monad] [record (//complex.normal true sub_patterns) record_size,members,recordT (is (Operation (Maybe [Nat (List Code) Type])) (.when record @@ -285,7 +282,7 @@ [location {.#Variant (list.partial [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}] (/.with_location location - (do ///.monad + (do phase.monad [[@ex_var+ :input:'] (/type.check (..tuple :input:))] (.when :input:' {.#Sum _} @@ -295,7 +292,7 @@ (.when (list.item idx flat_sum) (^.multi {.#Some caseT} (n.< size_sum idx)) - (do ///.monad + (do phase.monad [[testP nextA] (if (and (n.> size_sum size_sum) (n.= (-- size_sum) idx)) (pattern_analysis (type.variant (list.after (-- size_sum) flat_sum)) @@ -310,7 +307,7 @@ (/.except ..sum_has_no_case [idx :input:]))) {.#UnivQ _} - (do ///.monad + (do phase.monad [[ex_id exT] (/type.check check.existential) it (pattern_analysis (maybe.trusted (type.applied (list exT) :input:')) pattern @@ -323,7 +320,7 @@ [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}] (/.with_location location - (do ///.monad + (do phase.monad [tag (meta.normal tag) [lefts,right? variantT] (meta.tag tag) [lefts right?] (in (.when lefts,right? @@ -343,7 +340,7 @@ (-> Phase (List [Code Code]) Phase) (.when branches {.#Item [patternH bodyH] branchesT} - (do [! ///.monad] + (do [! phase.monad] [[:input: inputA] (<| /type.inferring (analyse archive inputC)) outputH (pattern_analysis :input: patternH (analyse archive bodyH)) @@ -355,8 +352,8 @@ outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT) _ (.when (monad.mix try.monad /coverage.composite outputHC outputTC) {try.#Success coverage} - (///.assertion ..non_exhaustive [inputC branches coverage] - (/coverage.exhaustive? coverage)) + (phase.assertion ..non_exhaustive [inputC branches coverage] + (/coverage.exhaustive? coverage)) {try.#Failure error} (/.failure error)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux index a47dc0e1d..b0c1283c0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux @@ -18,12 +18,12 @@ ["[0]" extension] ["/[1]" // ["/" declaration (.only Operation Phase Handler Extender)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" analysis (.only) ["[0]" evaluation] ["[1]/[0]" macro (.only Expander)] ["[1]/[0]" type]] [/// - ["[0]" phase (.use "[1]#[0]" monad)] [reference (.only) [variable (.only)]] [meta diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux index 0424495e0..5a8b93134 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux @@ -21,10 +21,11 @@ ["[0]" symbol] [type (.only sharing) ["[0]" check]]]]] - [///// + [/// ["[0]" phase (.only Operation Phase) (.use "[1]#[0]" functor)] - [meta - [archive (.only Archive)]]]) + [/// + [meta + [archive (.only Archive)]]]]) (type .public (Extension of) (Record diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index 3014365da..9157d3e66 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -30,13 +30,13 @@ ["[1]" lux]] ["/[1]" // [// + ["[0]" phase] ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) [evaluation (.only Eval)] ["[0]A" type] ["[0]" scope]] [/// ["[0]" reference] - ["[0]" phase] [meta [archive (.only Archive)]]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux index eb457c03a..49721e9df 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux @@ -22,10 +22,9 @@ ["/" lux (.only custom)] ["/[1]" // (.only) [/// + ["[0]" phase] ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) - ["[1]/[0]" type]] - [/// - ["[0]" phase]]]]]) + ["[1]/[0]" type]]]]]) (def array::new (-> Text Handler) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 3bda50cd1..e4d405e2c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -43,13 +43,12 @@ ["[1][0]" synthesis (.only Synthesis)] ["[1][0]" translation] ["[1][0]" declaration (.only Import Requirements Phase Operation Handler Extender Bundle)] - [phase + ["[0]" phase (.only) [extension ["[0]E" analysis ["[1]" lux]]]] ["[1][0]" program (.only Program)] [/// - ["[0]" phase] [meta ["[0]" archive (.only Archive) ["[0]" artifact] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux index 5a57a54bd..8ab51ea4c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux @@ -10,11 +10,10 @@ ["[0]" dictionary]]] [meta ["[0]" location] - ["[0]" symbol (.use "[1]#[0]" equivalence)] - [compiler - ["[0]" phase]]]]] + ["[0]" symbol (.use "[1]#[0]" equivalence)]]]] ["[0]" /// (.only) [/// + ["[0]" phase] ["[0]" synthesis (.only Synthesis Handler Bundle)]]]) (def .public synthesis diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux index b82acba31..654f1b008 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/common.lux @@ -36,10 +36,10 @@ ["[1][0]" function ["[1]" abstract]]]] [// + ["[0]" phase] ["[0]" synthesis (.only Synthesis %synthesis) ["<[1]>" \\parser (.only Parser)]] [/// - ["[0]" phase] [meta [archive (.only Archive)]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux index ded9a8bb4..fb9ee9327 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux @@ -64,13 +64,13 @@ [analysis ["/" jvm]]] ["/[1]" // + ["[0]" phase] ["[1][0]" translation] ["[0]" synthesis (.only Synthesis Path %synthesis) ["<[1]>" \\parser (.only Parser)]] [analysis (.only Environment) ["[0]" complex]] [/// - ["[1]" phase] ["[1][0]" reference (.only) ["[2][0]" variable (.only Variable Register)]] [meta @@ -383,7 +383,7 @@ (..custom [<synthesis>.any (function (_ translate archive arrayS) - (do //////.monad + (do phase.monad [arrayG (translate archive arrayS)] (in (all _.composite arrayG @@ -395,7 +395,7 @@ (..custom [(all <>.and ..object_array <synthesis>.any) (function (_ translate archive [elementJT arrayS]) - (do //////.monad + (do phase.monad [arrayG (translate archive arrayS)] (in (all _.composite arrayG @@ -407,7 +407,7 @@ (..custom [<synthesis>.any (function (_ translate archive [lengthS]) - (do //////.monad + (do phase.monad [lengthG (translate archive lengthS)] (in (all _.composite lengthG @@ -418,7 +418,7 @@ (..custom [(all <>.and ..object <synthesis>.any) (function (_ translate archive [objectJT lengthS]) - (do //////.monad + (do phase.monad [lengthG (translate archive lengthS)] (in (all _.composite lengthG @@ -429,7 +429,7 @@ (..custom [(all <>.and <synthesis>.any <synthesis>.any) (function (_ translate archive [idxS arrayS]) - (do //////.monad + (do phase.monad [arrayG (translate archive arrayS) idxG (translate archive idxS)] (in (all _.composite @@ -443,7 +443,7 @@ (..custom [(all <>.and ..object_array <synthesis>.any <synthesis>.any) (function (_ translate archive [elementJT idxS arrayS]) - (do //////.monad + (do phase.monad [arrayG (translate archive arrayS) idxG (translate archive idxS)] (in (all _.composite @@ -457,7 +457,7 @@ (..custom [(all <>.and <synthesis>.any <synthesis>.any <synthesis>.any) (function (_ translate archive [idxS valueS arrayS]) - (do //////.monad + (do phase.monad [arrayG (translate archive arrayS) idxG (translate archive idxS) valueG (translate archive valueS)] @@ -474,7 +474,7 @@ (..custom [(all <>.and ..object_array <synthesis>.any <synthesis>.any <synthesis>.any) (function (_ translate archive [elementJT idxS valueS arrayS]) - (do //////.monad + (do phase.monad [arrayG (translate archive arrayS) idxG (translate archive idxS) valueG (translate archive valueS)] @@ -576,7 +576,7 @@ (..custom [<synthesis>.text (function (_ translate archive [class]) - (do //////.monad + (do phase.monad [] (in (all _.composite (_.string class) @@ -587,7 +587,7 @@ (..custom [(all <>.and <synthesis>.text <synthesis>.any) (function (_ translate archive [class objectS]) - (do //////.monad + (do phase.monad [objectG (translate archive objectS)] (in (all _.composite objectG @@ -599,7 +599,7 @@ (..custom [(all <>.and <synthesis>.text <synthesis>.text <synthesis>.any) (function (_ translate archive [from to valueS]) - (do //////.monad + (do phase.monad [valueG (translate archive valueS)] (in (`` (cond (,, (with_template [<object> <type>] [(and (text#= (..reflection <type>) from) @@ -641,14 +641,14 @@ (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value) (function (_ translate archive [class field :unboxed:]) - (of //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) + (of phase.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) (def put::static Handler (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) (function (_ translate archive [class field :unboxed: valueS]) - (do //////.monad + (do phase.monad [valueG (translate archive valueS)] (in (all _.composite valueG @@ -666,7 +666,7 @@ (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) (function (_ translate archive [class field :unboxed: objectS]) - (do //////.monad + (do phase.monad [objectG (translate archive objectS) .let [:class: (type.class class (list)) getG (_.getfield :class: field :unboxed:)]] @@ -680,7 +680,7 @@ (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.any) (function (_ translate archive [class field :unboxed: valueS objectS]) - (do //////.monad + (do phase.monad [valueG (translate archive valueS) objectG (translate archive objectS) .let [:class: (type.class class (list)) @@ -708,7 +708,7 @@ (def (translate_input translate archive [valueT valueS]) (-> Phase Archive Input (Operation (Typed (Bytecode Any)))) - (do //////.monad + (do phase.monad [valueG (translate archive valueS)] (when (type.primitive? valueT) {.#Right valueT} @@ -733,7 +733,7 @@ (..custom [(all <>.and ..class <synthesis>.text ..return (<>.some ..input)) (function (_ translate archive [class method outputT inputsTS]) - (do [! //////.monad] + (do [! phase.monad] [inputsTG (monad.each ! (translate_input translate archive) inputsTS)] (in (all _.composite (monad.each _.monad product.right inputsTG) @@ -746,7 +746,7 @@ (..custom [(all <>.and ..class <synthesis>.text ..return <synthesis>.any (<>.some ..input)) (function (_ translate archive [class method outputT objectS inputsTS]) - (do [! //////.monad] + (do [! phase.monad] [objectG (translate archive objectS) inputsTG (monad.each ! (translate_input translate archive) inputsTS)] (in (all _.composite @@ -768,7 +768,7 @@ (..custom [(all <>.and ..class (<>.some ..input)) (function (_ translate archive [class inputsTS]) - (do [! //////.monad] + (do [! phase.monad] [inputsTG (monad.each ! (translate_input translate archive) inputsTS)] (in (all _.composite (_.new class) @@ -1128,7 +1128,7 @@ (def (anonymous_instance translate archive class env inputsTI) (-> Phase Archive (Type category.Class) (Environment Synthesis) (List (Typed (Bytecode Any))) (Operation (Bytecode Any))) - (do [! //////.monad] + (do [! phase.monad] [captureG+ (monad.each ! (translate archive) env)] (in (all _.composite (_.new class) @@ -1188,7 +1188,7 @@ (def (anonymous_dependencies archive inputsTS overriden_methods) (-> Archive (List Input) (List [(Environment Synthesis) (/.Overriden_Method Synthesis)]) (Operation (Set unit.ID))) - (do [! //////.monad] + (do [! phase.monad] [all_input_dependencies (monad.each ! (|>> product.right (cache/artifact.dependencies archive)) inputsTS) all_closure_dependencies (|> overriden_methods (list#each product.left) @@ -1289,7 +1289,7 @@ (def (method_definition phase archive artifact_id method) (-> Phase Archive artifact.ID (/.Overriden_Method Synthesis) (Operation (Resource Method))) (let [[ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT bodyS] method] - (do //////.monad + (do phase.monad [bodyG (//////translation.with_context artifact_id (phase archive bodyS)) .let [argumentsT (list#each product.right arguments) @@ -1320,7 +1320,7 @@ super_interfaces inputsTS overriden_methods]) - (do [! //////.monad] + (do [! phase.monad] [all_dependencies (anonymous_dependencies archive inputsTS overriden_methods) [context _] (//////translation.with_new_context archive all_dependencies (in [])) .let [[module_id artifact_id] context @@ -1333,7 +1333,7 @@ (list#each (normalized_method global_mapping)) (monad.each ! (method_definition translate archive artifact_id))) bytecode (<| (of ! each (\\format.result class.format)) - //////.of_try + phase.of_try (class.class version.v6_0 (all modifier#composite class.public class.final) (name.internal anonymous_class_name) {.#None} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/common.lux index 7b4153a5c..ad59ba175 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/common.lux @@ -42,11 +42,10 @@ ["[1][0]" loop]]] [// [analysis (.only)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" translation] ["[0]" synthesis (.only %synthesis) - ["<[1]>" \\parser (.only Parser)]] - [/// - ["[0]" phase (.use "[1]#[0]" monad)]]]]) + ["<[1]>" \\parser (.only Parser)]]]]) (def .public (custom [parser handler]) (All (_ s) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/host.lux index 2c0eb4818..8257f1fb1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/python/host.lux @@ -26,11 +26,10 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle with_vars)]]] [// + ["[0]" phase] ["[0]" translation] [synthesis - ["<s>" \\parser (.only Parser)]] - [/// - ["[0]" phase]]]]]) + ["<s>" \\parser (.only Parser)]]]]]) (def (array::new size) (Unary (Expression Any)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux index 825a2e8d6..65f84629a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux @@ -23,13 +23,13 @@ ["/[1]" // ["[0]" extension] ["/[1]" // + ["[0]" phase (.use "[1]#[0]" monad)] ["/" synthesis (.only Synthesis Operation Phase Extender Handler) ["[1][0]" simple]] ["[1][0]" analysis (.only Analysis) ["[2][0]" simple] ["[2][0]" complex]] [/// - ["[0]" phase (.use "[1]#[0]" monad)] [reference (.only) [variable (.only)]] [meta diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux index 76cc4c74e..a448dc50a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux @@ -22,12 +22,12 @@ ["[0]" // ["[1][0]" loop (.only Transform)] ["//[1]" /// + ["[0]" phase (.use "[1]#[0]" monad)] + ["/" synthesis (.only Path Abstraction Synthesis Operation Phase)] ["[1][0]" analysis (.only Environment Analysis) ["[1]/[0]" complex]] - ["/" synthesis (.only Path Abstraction Synthesis Operation Phase)] [/// [arity (.only Arity)] - ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" reference (.only) ["[1]/[0]" variable (.only Register Variable)]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux index c9dd922ef..94e506f2d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux @@ -15,9 +15,9 @@ [macro ["^" pattern]]]]] [//// + ["/" synthesis (.only Path Abstraction Synthesis)] ["[0]" analysis (.only Environment) ["[1]/[0]" complex]] - ["/" synthesis (.only Path Abstraction Synthesis)] [/// [arity (.only Arity)] ["[0]" reference (.only) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux index cd7de82f5..0af44a404 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux @@ -23,6 +23,7 @@ ["^" pattern]]]]] ["[0]" /// [// + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" analysis (.only Match Analysis) ["[2][0]" simple] ["[2][0]" complex] @@ -32,7 +33,6 @@ ["[2][0]" side] ["[2][0]" member (.only Member)]]] [/// - ["[1]" phase (.use "[1]#[0]" monad)] ["[1][0]" reference (.only) ["[1]/[0]" variable (.only Register Variable)]] [meta @@ -51,15 +51,15 @@ thenC {///simple.#Bit when} - (///#each (function (_ then) - {/.#Bit_Fork when then {.#None}}) - thenC) + (phase#each (function (_ then) + {/.#Bit_Fork when then {.#None}}) + thenC) (^.with_template [<from> <to> <conversion>] [{<from> test} - (///#each (function (_ then) - {<to> [(<conversion> test) then] (list)}) - thenC)]) + (phase#each (function (_ then) + {<to> [(<conversion> test) then] (list)}) + thenC)]) ([///simple.#Nat /.#I64_Fork .i64] [///simple.#Int /.#I64_Fork .i64] [///simple.#Rev /.#I64_Fork .i64] @@ -67,16 +67,16 @@ [///simple.#Text /.#Text_Fork |>])) {///pattern.#Bind register} - (<| (of ///.monad each (|>> {/.#Seq {/.#Bind register}})) + (<| (of phase.monad each (|>> {/.#Seq {/.#Bind register}})) /.with_new_local thenC) {///pattern.#Complex {///complex.#Variant [lefts right? value_pattern]}} - (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Side [/side.#lefts lefts - /side.#right? right?]}}})) + (<| (phase#each (|>> {/.#Seq {/.#Access {/access.#Side [/side.#lefts lefts + /side.#right? right?]}}})) (path' value_pattern end?) (pipe.if [(pipe.new (not end?) [])] - [(///#each ..clean_up)] + [(phase#each ..clean_up)] []) thenC) @@ -90,13 +90,13 @@ _ (let [right? (n.= tuple::last tuple::lefts) end?' (and end? right?)] - (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Member [/member.#lefts (if right? - (-- tuple::lefts) - tuple::lefts) - /member.#right? right?]}}})) + (<| (phase#each (|>> {/.#Seq {/.#Access {/access.#Member [/member.#lefts (if right? + (-- tuple::lefts) + tuple::lefts) + /member.#right? right?]}}})) (path' tuple::member end?') (pipe.if [(pipe.new (not end?') [])] - [(///#each ..clean_up)] + [(phase#each ..clean_up)] []) nextC)))) thenC @@ -105,7 +105,7 @@ (def (path archive synthesize pattern bodyA) (-> Archive Phase Pattern Analysis (Operation Path)) - (path' pattern true (///#each (|>> {/.#Then}) (synthesize archive bodyA)))) + (path' pattern true (phase#each (|>> {/.#Then}) (synthesize archive bodyA)))) (def (weave_branch weave equivalence [new_test new_then] [[old_test old_then] old_tail]) (All (_ a) @@ -245,7 +245,7 @@ (def .public (synthesize_when synthesize @ archive input [[headP headA] tailPA+]) (-> Phase Location Archive Synthesis Match (Operation Synthesis)) - (do [! ///.monad] + (do [! phase.monad] [headSP (path archive synthesize headP headA) tailSP+ (monad.each ! (product.uncurried (path archive synthesize)) tailPA+)] (in (/.branch/when @ [input (list#mix weave headSP tailSP+)])))) @@ -258,13 +258,13 @@ (def .public (synthesize_exec synthesize @ archive before after) (-> Phase Location Archive Synthesis Analysis (Operation Synthesis)) - (do ///.monad + (do phase.monad [after (synthesize archive after)] (in (/.branch/exec @ [before after])))) (def .public (synthesize_let synthesize @ archive input @variable body) (-> Phase Location Archive Synthesis Register Analysis (Operation Synthesis)) - (do ///.monad + (do phase.monad [body (/.with_new_local (synthesize archive body))] (in (/.branch/let @ [input @variable body])))) @@ -272,12 +272,12 @@ (def .public (synthesize_masking synthesize @ archive input @variable @output) (-> Phase Location Archive Synthesis Register Register (Operation Synthesis)) (if (n.= @variable @output) - (///#in input) + (phase#in input) (..synthesize_let synthesize @ archive input @variable [@ {///analysis.#Reference (///reference.local @output)}]))) (def .public (synthesize_if synthesize @ archive test then else) (-> Phase Location Archive Synthesis Analysis Analysis (Operation Synthesis)) - (do ///.monad + (do phase.monad [then (synthesize archive then) else (synthesize archive else)] (in (/.branch/if @ [test then else])))) @@ -295,16 +295,16 @@ (..synthesize_when synthesize @ archive input (!get @ patterns @member)) path - (///#in (when input - (/.branch/get @ [sub_path sub_input]) - (/.branch/get @ [(list#composite sub_path path) sub_input]) + (phase#in (when input + (/.branch/get @ [sub_path sub_input]) + (/.branch/get @ [(list#composite sub_path path) sub_input]) - _ - (/.branch/get @ [path input]))))) + _ + (/.branch/get @ [path input]))))) (def .public (synthesize @ synthesize^ [headB tailB+] archive inputA) (-> Location Phase Match Phase) - (do [! ///.monad] + (do [! phase.monad] [inputS (synthesize^ archive inputA)] (when [headB tailB+] (!masking @ @variable @output) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux index 38a52d429..a1e19ae0a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/extension.lux @@ -19,9 +19,8 @@ ["[1][0]" extension] [// [synthesis (.only Synthesis)] - ["[0]" translation] - [/// - ["[1]" phase]]]]) + ["[0]" phase] + ["[0]" translation]]]) (def Vector (syntax (_ [size <code>.nat @@ -51,7 +50,7 @@ (function ((, g!_) (, g!phase) (, g!archive) (, g!inputs)) (when (, g!inputs) (list (,* g!input+)) - (do ///.monad + (do phase.monad [(,* (|> g!input+ (list#each (function (_ g!input) (list g!input (` ((, g!phase) (, g!archive) (, g!input)))))) @@ -59,7 +58,7 @@ ((,' in) ((, g!extension) [(,* g!input+)]))) (, g!_) - (///.except ..incorrect_arity [(, (code.nat arity)) (list.size (, g!inputs))])) + (phase.except ..incorrect_arity [(, (code.nat arity)) (list.size (, g!inputs))])) )))))))))) (with_template [<arity> <type> <term>] @@ -79,7 +78,7 @@ (All (_ anchor expression declaration) (-> (Variadic expression) (translation.Handler anchor expression declaration))) (function (_ phase archive inputsS) - (let [! ///.monad] + (let [! phase.monad] (|> inputsS (monad.each ! (phase archive)) (of ! each extension))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux index bc59b8d93..ac3cec698 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux @@ -27,9 +27,9 @@ ["[1]/[0]" common]]]] ["/[1]" // [analysis (.only)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase (.use "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) @@ -41,7 +41,7 @@ (when synthesis (^.with_template [<tag> <translator>] [(<tag> @ value) - (//////phase#in (<translator> value))]) + (phase#in (<translator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] @@ -68,7 +68,7 @@ [////synthesis.function/abstraction /function.function]) (////synthesis.loop/again @ updates) - (//////phase.except ..cannot_recur_as_an_expression []) + (phase.except ..cannot_recur_as_an_expression []) [@ {////synthesis.#Reference value}] (//reference.reference /reference.system archive value) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux index f176eb403..49a43f19c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux @@ -22,10 +22,10 @@ ["//[1]" /// [analysis (.only Environment Abstraction Reification Analysis)] [synthesis (.only Synthesis)] + ["[0]" phase] ["[1][0]" translation] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase] [reference [variable (.only Register Variable)]] [meta @@ -37,7 +37,7 @@ (def .public (apply expression archive [functionS argsS+]) (Translator (Reification Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] (in (_.apply argsO+ functionO)))) @@ -50,13 +50,13 @@ (-> artifact.ID SVar (List (Expression Any)) (Statement Any) (Operation (Expression Any))) (when inits {.#End} - (do ///////phase.monad + (do phase.monad [_ (/////translation.execute! function_definition) _ (/////translation.save! function_id {.#None} function_definition)] (in @function)) _ - (do [! ///////phase.monad] + (do [! phase.monad] [.let [declaration (_.def @function (|> (list.enumeration inits) (list#each (|>> product.left ..capture))) @@ -72,7 +72,7 @@ (def .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Translator (Abstraction Synthesis))) - (do [! ///////phase.monad] + (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [[function_module function_artifact] body!] (/////translation.with_new_context archive dependencies (/////translation.with_anchor 1 diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux index 1d4a4a01b..8fa93362b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux @@ -25,10 +25,10 @@ [synthesis ["[0]" when]] ["/[1]" // + ["[0]" phase] ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" translation] ["//[1]" /// - ["[1][0]" phase] [meta ["[0]" cache [dependency @@ -60,7 +60,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [initsO+ (monad.each ! (expression archive) initsS+) body! (/////translation.with_anchor start (statement expression archive bodyS))] @@ -77,7 +77,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) initsO+ (monad.each ! (expression archive) initsS+) [[loop_module loop_artifact] body!] (/////translation.with_new_context archive dependencies @@ -113,7 +113,7 @@ (def .public (again! statement expression archive argsS+) (Translator! (List Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [offset /////translation.anchor @temp (//when.symbol "lux_again_values") argsO+ (monad.each ! (expression archive) argsS+) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux index d6fd0eb18..be0a4dd59 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/runtime.lux @@ -30,10 +30,10 @@ ["[0]" /// ["[1][0]" reference] ["//[1]" /// + ["[0]" phase] ["[1][0]" synthesis (.only Synthesis)] ["[1][0]" translation] - ["//[1]" /// (.only) - ["[1][0]" phase] + [/// [reference [variable (.only Register)]] [meta @@ -482,7 +482,7 @@ (def .public translate (Operation [Registry Output]) - (do ///////phase.monad + (do phase.monad [_ (/////translation.execute! ..full_runtime) _ (/////translation.save! ..module_id {.#None} ..full_runtime)] (in [(|> registry.empty diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux index cdca9d0b1..747404963 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux @@ -10,27 +10,26 @@ ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" primitive] ["///[1]" //// - [analysis - [complex (.only Variant Tuple)]] + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" synthesis (.only Synthesis)] - ["//[1]" /// - ["[1][0]" phase (.use "[1]#[0]" monad)]]]]) + [analysis + [complex (.only Variant Tuple)]]]]) (def .public (tuple translate archive elemsS+) (Translator (Tuple Synthesis)) (when elemsS+ {.#End} - (///////phase#in (//primitive.text /////synthesis.unit)) + (phase#in (//primitive.text /////synthesis.unit)) {.#Item singletonS {.#End}} (translate archive singletonS) _ (|> elemsS+ - (monad.each ///////phase.monad (translate archive)) - (///////phase#each _.list)))) + (monad.each phase.monad (translate archive)) + (phase#each _.list)))) (def .public (variant translate archive [lefts right? valueS]) (Translator (Variant Synthesis)) - (///////phase#each (//runtime.variant lefts right?) - (translate archive valueS))) + (phase#each (//runtime.variant lefts right?) + (translate archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux index e70766b1c..a8555492d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux @@ -28,6 +28,7 @@ [synthesis ["[0]" when]] ["/[1]" // + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" translation] ["[1][0]" synthesis (.only Synthesis Path) [access @@ -35,7 +36,6 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] [meta [archive (.only Archive)] ["[0]" cache @@ -44,8 +44,8 @@ (def .public (symbol prefix) (-> Text (Operation SVar)) - (///////phase#each (|>> %.nat (format prefix) _.var) - /////translation.next)) + (phase#each (|>> %.nat (format prefix) _.var) + /////translation.next)) (def .public register (-> Register SVar) @@ -57,7 +57,7 @@ (def .public (let expression archive [valueS register bodyS]) (Translator [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. @@ -67,7 +67,7 @@ (def .public (let! statement expression archive [valueS register bodyS]) (Translator! [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] (in (all _.then @@ -76,14 +76,14 @@ (def .public (exec expression archive [pre post]) (Translator [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [pre (expression archive pre) post (expression archive post)] (in (_.item (_.int +1) (_.tuple (list pre post)))))) (def .public (exec! statement expression archive [pre post]) (Translator! [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [pre (expression archive pre) post (statement expression archive post)] (in (all _.then @@ -92,7 +92,7 @@ (def .public (if expression archive [testS thenS elseS]) (Translator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] @@ -100,7 +100,7 @@ (def .public (if! statement expression archive [testS thenS elseS]) (Translator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [test! (expression archive testS) then! (statement expression archive thenS) else! (statement expression archive elseS)] @@ -110,7 +110,7 @@ (def .public (get expression archive [pathP valueS]) (Translator [(List Member) Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) (.let [method (.if (the member.#right? side) @@ -203,7 +203,7 @@ (-> Path (Operation (Maybe (Statement Any))))) (.when pathP {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] + (do [! phase.monad] [then! (again thenP) else! (.when elseP {.#Some elseP} @@ -221,7 +221,7 @@ (^.with_template [<tag> <format>] [{<tag> item} - (do [! ///////phase.monad] + (do [! phase.monad] [clauses (monad.each ! (function (_ [match then]) (of ! each (|>> [(_.= (|> match <format>) @@ -237,12 +237,12 @@ [/////synthesis.#Text_Fork (<| //primitive.text)]) _ - (of ///////phase.monad in {.#None}))) + (of phase.monad in {.#None}))) (def (pattern_matching' in_closure? statement expression archive) (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) (function (again pathP) - (do [! ///////phase.monad] + (do [! phase.monad] [?output (primitive_pattern_matching again pathP)] (.when ?output {.#Some output} @@ -254,45 +254,45 @@ (statement expression archive bodyS) {/////synthesis.#Pop} - (///////phase#in ..pop!) + (phase#in ..pop!) {/////synthesis.#Bind register} - (///////phase#in (_.set (list (..register register)) ..peek)) + (phase#in (_.set (list (..register register)) ..peek)) (^.with_template [<complex> <simple> <choice>] [(<complex> idx) - (///////phase#in (<choice> false idx)) + (phase#in (<choice> false idx)) (<simple> idx nextP) (|> nextP again - (///////phase#each (_.then (<choice> true idx))))]) + (phase#each (_.then (<choice> true idx))))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) + (phase#in (|> ..peek (_.item (_.int +0)) ..push!)) (^.with_template [<pm> <getter>] [(<pm> lefts) - (///////phase#in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (phase#in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple::left] [/////synthesis.member/right //runtime.tuple::right]) (/////synthesis.!bind_top register thenP) (do ! [then! (again thenP)] - (///////phase#in (all _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) + (phase#in (all _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (when.count_pops nextP)] (do ! [next! (again nextP')] - (///////phase#in (all _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) + (phase#in (all _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) (/////synthesis.path/seq preP postP) (do ! @@ -312,7 +312,7 @@ (def (pattern_matching in_closure? statement expression archive pathP) (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) - (do ///////phase.monad + (do phase.monad [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) g!once (..symbol "once")] (in (all _.then @@ -335,7 +335,7 @@ (def .public (when! in_closure? statement expression archive [valueS pathP]) (-> Bit (Translator! [Synthesis Path])) - (do ///////phase.monad + (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] (in (all _.then @@ -346,7 +346,7 @@ (def .public (when statement expression archive [valueS pathP]) (-> Phase! (Translator [Synthesis Path])) - (do ///////phase.monad + (do phase.monad [dependencies (cache.path_dependencies archive pathP) [[when_module when_artifact] pattern_matching!] (/////translation.with_new_context archive diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux index e9669b5fe..4190683b5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux @@ -7,10 +7,10 @@ [meta ["@" target] ["[0]" version]]]] - ["[0]" //// - ["[1][0]" translation] - ["//[1]" /// - ["[0]" phase (.use "[1]#[0]" monad)] + [//// + ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" translation] + [/// ["[0]" reference (.only Reference) ["[0]" variable (.only Register Variable)]] [meta @@ -65,9 +65,9 @@ (def .public (constant system archive name) (All (_ anchor expression declaration) (-> (System expression) Archive Symbol - (////translation.Operation anchor expression declaration expression))) + (translation.Operation anchor expression declaration expression))) (phase#each (|>> ..artifact (of system constant')) - (////translation.remember archive name))) + (translation.remember archive name))) (with_template [<sigil> <name>] [(def .public (<name> system) @@ -92,7 +92,7 @@ (def .public (reference system archive reference) (All (_ anchor expression declaration) - (-> (System expression) Archive Reference (////translation.Operation anchor expression declaration expression))) + (-> (System expression) Archive Reference (translation.Operation anchor expression declaration expression))) (when reference {reference.#Constant value} (..constant system archive value) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux index 0d48bb642..ea8a104a3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux @@ -22,10 +22,10 @@ ["//[1]" /// [synthesis (.only Synthesis)] [analysis (.only Environment Abstraction Reification Analysis)] + ["[0]" phase] ["[1][0]" translation] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase] [reference [variable (.only Register Variable)]] [meta @@ -35,7 +35,7 @@ (def .public (apply expression archive [functionS argsS+]) (Translator (Reification Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] (in (_.apply_lambda argsO+ functionO)))) @@ -67,7 +67,7 @@ (def .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Translator (Abstraction Synthesis))) - (do [! ///////phase.monad] + (do [! phase.monad] [dependencies (cache/artifact.dependencies archive bodyS) [[function_module function_artifact] body!] (/////translation.with_new_context archive dependencies (/////translation.with_anchor 1 diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux index 49c76bdee..a670b4b4b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux @@ -25,10 +25,10 @@ [synthesis ["[0]" when]] ["/[1]" // + ["[0]" phase] ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" translation] ["//[1]" /// - ["[1][0]" phase] [reference ["[1][0]" variable (.only Register)]]]]]]]) @@ -57,7 +57,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [initsO+ (monad.each ! (expression archive) initsS+) body! (/////translation.with_anchor start (statement expression archive bodyS))] @@ -74,7 +74,7 @@ ... true loop _ - (do [! ///////phase.monad] + (do [! phase.monad] [body! (scope! statement expression archive [start initsS+ bodyS])] (in (|> body! [(list)] (_.lambda {.#None}) @@ -82,7 +82,7 @@ (def .public (again! statement expression archive argsS+) (Translator! (List Synthesis)) - (do [! ///////phase.monad] + (do [! phase.monad] [offset /////translation.anchor @temp (//when.symbol "lux_again_values") argsO+ (monad.each ! (expression archive) argsS+) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux index 3bf36726d..8be246d69 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/runtime.lux @@ -29,10 +29,10 @@ ["[0]" /// ["[1][0]" reference] ["//[1]" /// + ["[0]" phase] ["[1][0]" synthesis (.only Synthesis)] ["[1][0]" translation] - ["//[1]" /// (.only) - ["[1][0]" phase] + [/// [reference [variable (.only Register)]] [meta @@ -625,7 +625,7 @@ (def .public translate (Operation [Registry Output]) - (do ///////phase.monad + (do phase.monad [_ (/////translation.execute! ..full) _ (/////translation.save! ..module_id {.#None} ..full)] (in [(|> registry.empty diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux index 748d4be1d..100ebd54f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux @@ -10,27 +10,26 @@ ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" primitive] ["///[1]" //// - [analysis - [complex (.only Variant Tuple)]] + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" synthesis (.only Synthesis)] - ["//[1]" /// - ["[1][0]" phase (.use "[1]#[0]" monad)]]]]) + [analysis + [complex (.only Variant Tuple)]]]]) (def .public (tuple translate archive elemsS+) (Translator (Tuple Synthesis)) (when elemsS+ {.#End} - (///////phase#in (//primitive.text /////synthesis.unit)) + (phase#in (//primitive.text /////synthesis.unit)) {.#Item singletonS {.#End}} (translate archive singletonS) _ (|> elemsS+ - (monad.each ///////phase.monad (translate archive)) - (///////phase#each _.array)))) + (monad.each phase.monad (translate archive)) + (phase#each _.array)))) (def .public (variant translate archive [lefts right? valueS]) (Translator (Variant Synthesis)) - (///////phase#each (//runtime.variant lefts right?) - (translate archive valueS))) + (phase#each (//runtime.variant lefts right?) + (translate archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux index ea2520b18..f2f982e09 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux @@ -28,6 +28,7 @@ [synthesis ["[0]" when]] ["/[1]" // + ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" translation] ["[1][0]" synthesis (.only Synthesis Path) [access @@ -35,13 +36,12 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) (def .public (symbol prefix) (-> Text (Operation LVar)) - (///////phase#each (|>> %.nat (format prefix) _.local) /////translation.next)) + (phase#each (|>> %.nat (format prefix) _.local) /////translation.next)) (def .public register (-> Register LVar) @@ -53,7 +53,7 @@ (def .public (exec expression archive [this that]) (Translator [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [this (expression archive this) that (expression archive that)] (in (|> (_.array (list this that)) @@ -61,7 +61,7 @@ (def .public (exec! statement expression archive [this that]) (Translator! [Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [this (expression archive this) that (statement expression archive that)] (in (all _.then @@ -71,7 +71,7 @@ (def .public (let expression archive [valueS register bodyS]) (Translator [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. @@ -82,7 +82,7 @@ (def .public (let! statement expression archive [valueS register bodyS]) (Translator! [Synthesis Register Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] (in (all _.then @@ -91,7 +91,7 @@ (def .public (if expression archive [testS thenS elseS]) (Translator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] @@ -99,7 +99,7 @@ (def .public (if! statement expression archive [testS thenS elseS]) (Translator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad + (do phase.monad [test! (expression archive testS) then! (statement expression archive thenS) else! (statement expression archive elseS)] @@ -109,7 +109,7 @@ (def .public (get expression archive [pathP valueS]) (Translator [(List Member) Synthesis]) - (do ///////phase.monad + (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) (.let [method (.if (the member.#right? side) @@ -210,7 +210,7 @@ (-> Path (Operation (Maybe Statement)))) (.when pathP {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] + (do [! phase.monad] [then! (again thenP) else! (.when elseP {.#Some elseP} @@ -228,7 +228,7 @@ (^.with_template [<tag> <format>] [{<tag> item} - (do [! ///////phase.monad] + (do [! phase.monad] [clauses (monad.each ! (function (_ [match then]) (of ! each (|>> [(_.= (|> match <format>) @@ -244,12 +244,12 @@ [/////synthesis.#Text_Fork (<| //primitive.text)]) _ - (of ///////phase.monad in {.#None}))) + (of phase.monad in {.#None}))) (def (pattern_matching' in_closure? statement expression archive) (-> Bit (Translator! Path)) (function (again pathP) - (do ///////phase.monad + (do phase.monad [?output (primitive_pattern_matching again pathP)] (.when ?output {.#Some output} @@ -261,13 +261,13 @@ (statement expression archive bodyS) {/////synthesis.#Pop} - (///////phase#in ..pop!) + (phase#in ..pop!) {/////synthesis.#Bind register} - (///////phase#in (_.set (list (..register register)) ..peek)) + (phase#in (_.set (list (..register register)) ..peek)) {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] + (do [! phase.monad] [then! (again thenP) else! (.when elseP {.#Some elseP} @@ -285,7 +285,7 @@ (^.with_template [<tag> <format>] [{<tag> item} - (do [! ///////phase.monad] + (do [! phase.monad] [clauses (monad.each ! (function (_ [match then]) (of ! each (|>> [(_.= (|> match <format>) @@ -302,41 +302,41 @@ (^.with_template [<complex> <simple> <choice>] [(<complex> idx) - (///////phase#in (<choice> false idx)) + (phase#in (<choice> false idx)) (<simple> idx nextP) (|> nextP again - (///////phase#each (_.then (<choice> true idx))))]) + (phase#each (_.then (<choice> true idx))))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) + (phase#in (|> ..peek (_.item (_.int +0)) ..push!)) (^.with_template [<pm> <getter>] [(<pm> lefts) - (///////phase#in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (phase#in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (/////synthesis.!bind_top register thenP) - (do ///////phase.monad + (do phase.monad [then! (again thenP)] - (///////phase#in (all _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) + (phase#in (all _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (when.count_pops nextP)] - (do ///////phase.monad + (do phase.monad [next! (again nextP')] - (///////phase#in (all _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) + (phase#in (all _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) (/////synthesis.path/seq preP postP) - (do ///////phase.monad + (do phase.monad [pre! (again preP) post! (again postP)] (in (all _.then @@ -344,7 +344,7 @@ post!))) (/////synthesis.path/alt preP postP) - (do ///////phase.monad + (do phase.monad [pre! (again preP) post! (again postP) g!once (..symbol "once") @@ -353,7 +353,7 @@ (def (pattern_matching in_closure? statement expression archive pathP) (-> Bit (Translator! Path)) - (do ///////phase.monad + (do phase.monad [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) g!once (..symbol "once") g!continue? (..symbol "continue")] @@ -364,7 +364,7 @@ (def .public (when! in_closure? statement expression archive [valueS pathP]) (-> Bit (Translator! [Synthesis Path])) - (do ///////phase.monad + (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] (in (all _.then @@ -377,6 +377,6 @@ (-> Phase! (Translator [Synthesis Path])) (|> when (when! true statement expression archive) - (of ///////phase.monad each + (of phase.monad each (|>> [(list)] (_.lambda {.#None}) (_.apply_lambda (list)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index 2ceef9fd2..1c58de2b8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -18,10 +18,10 @@ ["[0]" dictionary (.only Dictionary)]]] [math [number - ["[0]" i64] ["n" nat] ["i" int] - ["f" frac]]] + ["f" frac] + ["[0]" i64]]] [meta [macro ["^" pattern]]]]] @@ -33,11 +33,10 @@ [// ["[0]" analysis (.only Environment Analysis) ["[1]/[0]" complex (.only Complex)]] - [phase + ["[0]" phase (.only) ["[0]" extension (.only Extension)]] [/// [arity (.only Arity)] - ["[0]" phase] ["[0]" reference (.only Reference) ["[0]" variable (.only Register Variable)]]]]]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux index 521cbf541..cb92a5e51 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux @@ -26,10 +26,9 @@ ["[0]" template]]]]] [// [synthesis (.only Synthesis)] - [phase + ["[0]" phase (.only) ["[0]" extension]] [/// - ["[0]" phase] [meta ["[0]" archive (.only Archive) ["[0]" registry (.only Registry)] diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux index 3b8021224..e9128d16b 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux @@ -20,10 +20,10 @@ [macro ["^" pattern]] [compiler - ["[0]" phase] ["[0]" reference (.only Constant)] [language [lux + ["[0]" phase] ["[0]" synthesis (.only Synthesis Path)] ["[0]" translation (.only Operation)] ["[0]" analysis diff --git a/stdlib/source/library/lux/meta/extension.lux b/stdlib/source/library/lux/meta/extension.lux index 7365e2442..e44345492 100644 --- a/stdlib/source/library/lux/meta/extension.lux +++ b/stdlib/source/library/lux/meta/extension.lux @@ -23,9 +23,9 @@ [syntax (.only syntax)] ["[0]" template]] [compiler - ["[0]" phase] [language [lux + ["[0]" phase] ["[0]" analysis (.only) ["<a>" \\parser]] ["[0]" synthesis (.only) diff --git a/stdlib/source/library/lux/web/css/value.lux b/stdlib/source/library/lux/web/css/value.lux index c23a1fda0..2ff369bc7 100644 --- a/stdlib/source/library/lux/web/css/value.lux +++ b/stdlib/source/library/lux/web/css/value.lux @@ -832,17 +832,17 @@ (def .public (rgb color) (-> RGB (Value Color)) - (..apply "rgb" (list (%.nat (rgb.red color)) - (%.nat (rgb.green color)) - (%.nat (rgb.blue color))))) + (..apply "rgb" (list (%.nat (the rgb.#red color)) + (%.nat (the rgb.#green color)) + (%.nat (the rgb.#blue color))))) (def .public (rgba pigment) (-> Pigment (Value Color)) (let [(open "/[0]") pigment] - (..apply "rgba" (list (%.nat (rgb.red /#color)) - (%.nat (rgb.green /#color)) - (%.nat (rgb.blue /#color)) + (..apply "rgba" (list (%.nat (the rgb.#red /#color)) + (%.nat (the rgb.#green /#color)) + (%.nat (the rgb.#blue /#color)) (if (r.= (of r.interval top) /#alpha) "1.0" (format "0" (%.rev /#alpha))))))) diff --git a/stdlib/source/library/lux/world/money.lux b/stdlib/source/library/lux/world/finance/money.lux index cd0724459..cd0724459 100644 --- a/stdlib/source/library/lux/world/money.lux +++ b/stdlib/source/library/lux/world/finance/money.lux diff --git a/stdlib/source/library/lux/world/money/currency.lux b/stdlib/source/library/lux/world/finance/money/currency.lux index 04292fa48..04292fa48 100644 --- a/stdlib/source/library/lux/world/money/currency.lux +++ b/stdlib/source/library/lux/world/finance/money/currency.lux diff --git a/stdlib/source/library/lux/world/finance/trade/session.lux b/stdlib/source/library/lux/world/finance/trade/session.lux new file mode 100644 index 000000000..821135300 --- /dev/null +++ b/stdlib/source/library/lux/world/finance/trade/session.lux @@ -0,0 +1,67 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)]] + [data + [text + ["%" \\format (.only Format)]]] + [math + [number + ["n" nat]]]]] + [/// + ["[0]" money (.only Money) + [currency (.only Currency)]]]) + +(type .public (Price $) + (Money $)) + +(type .public Volume + Nat) + +(type .public (Session $) + (Record + [#open (Price $) + #high (Price $) + #low (Price $) + #close (Price $) + #volume Volume])) + +(def .public equivalence + (All (_ $) + (Equivalence (Session $))) + (implementation + (def (= reference subject) + (`` (and (,, (with_template [<=> <slot>] + [(<=> (the <slot> reference) (the <slot> subject))] + + [money.= #open] + [money.= #high] + [money.= #low] + [money.= #close] + [n.= #volume] + ))))))) + +(def .public (composite before after) + (All (_ $) + (-> (Session $) (Session $) + (Session $))) + [#open (the #open before) + #high (money.max (the #high before) (the #high after)) + #low (money.min (the #low before) (the #low after)) + #close (the #close after) + #volume (n.+ (the #volume before) (the #volume after))]) + +... https://en.wikipedia.org/wiki/Open-high-low-close_chart +(def .public (format it) + (All (_ $) + (Format (Session $))) + (`` (%.format (,, (with_template [<header> <slot> <format>] + [<header> ": " (`` (<format> (the <slot> it)))] + + ["O" #open money.format] + [" | H" #high money.format] + [" | L" #low money.format] + [" | C" #close money.format] + [" | V" #volume %.nat] + ))))) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 93126b8d8..474a267a3 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -21,7 +21,6 @@ [type (.only sharing)] ["@" target] ["[0]" compiler - ["[0]" phase] [default ["[0]" platform (.only Platform)]] [language @@ -32,7 +31,7 @@ ["[0]" declaration] ["[0]" analysis (.only) [macro (.only Expander)]] - [phase + ["[0]" phase (.only) [extension (.only Extender) ["[0]E" analysis] ["[0]E" synthesis]]]]] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index d1c9ba933..410580860 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -42,7 +42,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Dictionary]) + (_.for [/.Dictionary + /.#order /.#root]) (do [! random.monad] [size (of ! each (n.% 100) random.nat) keys (random.set n.hash size random.nat) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index ee2eb70b2..25c041fd7 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -36,68 +36,6 @@ (Random /.Color) (random#each /.of_rgb /rgb.random)) -(def scale - (-> Nat Frac) - (|>> .int int.frac)) - -(def square - (-> Frac Frac) - (f.pow +2.0)) - -(def square_root - (-> Frac Frac) - (f.pow +0.5)) - -(def (distance/3 from to) - (-> /.Color /.Color Frac) - (let [from (/.rgb from) - to (/.rgb to)] - (square_root - (all f.+ - (|> (scale (rgb.red to)) (f.- (scale (rgb.red from))) square) - (|> (scale (rgb.green to)) (f.- (scale (rgb.green from))) square) - (|> (scale (rgb.blue to)) (f.- (scale (rgb.blue from))) square))))) - -(def rgb_error_margin - +1.8) - -(with_template [<name> <field>] - [(def <name> - (-> /.Color Frac) - (|>> /.rgb - hsl.of_rgb - <field>))] - - [saturation hsl.saturation] - [luminance hsl.luminance] - ) - -... (def transformation -... Test -... (do random.monad -... [mediocre (|> ..random -... (random.only (|>> saturation -... ((function (_ saturation) -... (and (f.>= +0.25 saturation) -... (f.<= +0.75 saturation))))))) -... ratio (|> random.safe_frac (random.only (f.>= +0.5)))] -... (all _.and -... (_.coverage [/.saturated] -... (f.> (saturation mediocre) -... (saturation (/.saturated ratio mediocre)))) -... (_.coverage [/.un_saturated] -... (f.< (saturation mediocre) -... (saturation (/.un_saturated ratio mediocre)))) -... (_.coverage [/.gray_scale] -... (let [gray'ed (/.gray_scale mediocre)] -... (and (f.= +0.0 -... (saturation gray'ed)) -... (|> (luminance gray'ed) -... (f.- (luminance mediocre)) -... f.abs -... (f.<= ..rgb_error_margin))))) -... ))) - ... (def palette ... Test ... (_.for [/.Spread /.Palette] @@ -123,28 +61,6 @@ ... [+1.0 /.analogous] ... [+0.5 /.monochromatic] ... )) -... (,, (with_template [<palette>] -... [(_.coverage [<palette>] -... (let [expected (/.of_hsb [eH eS +0.5]) -... [c0 c1 c2] (<palette> expected)] -... (and (of /.equivalence = expected c0) -... (not (of /.equivalence = expected c1)) -... (not (of /.equivalence = expected c2)))))] - -... [/.triad] -... [/.clash] -... [/.split_complement])) -... (,, (with_template [<palette>] -... [(_.coverage [<palette>] -... (let [expected (/.of_hsb [eH eS +0.5]) -... [c0 c1 c2 c3] (<palette> expected)] -... (and (of /.equivalence = expected c0) -... (not (of /.equivalence = expected c1)) -... (not (of /.equivalence = expected c2)) -... (not (of /.equivalence = expected c3)))))] - -... [/.square] -... [/.tetradic])) ... ))))) (def .public test @@ -154,7 +70,6 @@ (do [! random.monad] [expected ..random] (all _.and - ... ..transformation ... ..palette /rgb.test diff --git a/stdlib/source/test/lux/data/color/hsl.lux b/stdlib/source/test/lux/data/color/hsl.lux index 72782e0f2..de9c3ef8a 100644 --- a/stdlib/source/test/lux/data/color/hsl.lux +++ b/stdlib/source/test/lux/data/color/hsl.lux @@ -14,7 +14,8 @@ [\\library ["[0]" / (.only) [// - ["[0]" rgb]]]] + ["[0]" rgb] + ["[0]" hsb]]]] [// ["[0]T" rgb]]) @@ -30,6 +31,9 @@ luminance ..value] (in (/.hsl hue saturation luminance)))) +(def rgb_error_margin + +1.8) + (def .public test Test (<| (_.covering /._) @@ -38,7 +42,18 @@ expected_rgb rgbT.random expected_hsl ..random - possible_value random.frac]) + possible_value random.frac + + mediocre (|> ..random + (random.only (|>> (the /.#saturation) + ((function (_ it) + (and (f.>= +0.25 it) + (f.<= +0.75 it))))))) + ratio (|> random.safe_frac (random.only (f.>= +0.5))) + + eH (of ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) + random.safe_frac) + .let [eS +0.5]]) (all _.and (_.for [/.Value] (all _.and @@ -66,23 +81,63 @@ (/.value? (f.- f.smallest /.most)) (not (/.value? (f.+ f.smallest /.most))))) )) - (_.for [/.HSL] - (all _.and - (_.for [/.equivalence] - (equivalenceS.spec /.equivalence ..random)) + (_.for [/.HSL + /.#hue /.#saturation /.#luminance] + (`` (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /.equivalence ..random)) - (_.coverage [/.hsl - /.hue /.saturation /.luminance] - (|> (/.hsl (/.hue expected_hsl) (/.saturation expected_hsl) (/.luminance expected_hsl)) - (of /.equivalence = expected_hsl))) - (_.coverage [/.of_rgb /.rgb] - (and (|> expected_rgb - /.of_rgb - /.rgb - (of rgb.equivalence = expected_rgb)) - (|> expected_hsl - /.rgb - /.of_rgb - (of /.equivalence = expected_hsl)))) - )) + (_.coverage [/.hsl] + (|> (/.hsl (the /.#hue expected_hsl) + (the /.#saturation expected_hsl) + (the /.#luminance expected_hsl)) + (of /.equivalence = expected_hsl))) + (_.coverage [/.of_rgb /.rgb] + (and (|> expected_rgb + /.of_rgb + /.rgb + (of rgb.equivalence = expected_rgb)) + (|> expected_hsl + /.rgb + /.of_rgb + (of /.equivalence = expected_hsl)))) + + (_.coverage [/.saturated] + (f.> (the /.#saturation mediocre) + (the /.#saturation (/.saturated ratio mediocre)))) + (_.coverage [/.un_saturated] + (f.< (the /.#saturation mediocre) + (the /.#saturation (/.un_saturated ratio mediocre)))) + (_.coverage [/.gray_scale] + (let [gray'ed (/.gray_scale mediocre)] + (and (f.= +0.0 + (the /.#saturation gray'ed)) + (|> (the /.#luminance gray'ed) + (f.- (the /.#luminance mediocre)) + f.abs + (f.<= ..rgb_error_margin))))) + + (,, (with_template [<palette>] + [(_.coverage [<palette>] + (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5))) + [c0 c1 c2] (<palette> expected)] + (and (of /.equivalence = expected c0) + (not (of /.equivalence = expected c1)) + (not (of /.equivalence = expected c2)))))] + + [/.triad] + [/.clash] + [/.split_complement])) + (,, (with_template [<palette>] + [(_.coverage [<palette>] + (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5))) + [c0 c1 c2 c3] (<palette> expected)] + (and (of /.equivalence = expected c0) + (not (of /.equivalence = expected c1)) + (not (of /.equivalence = expected c2)) + (not (of /.equivalence = expected c3)))))] + + [/.square] + [/.tetradic])) + ))) ))) diff --git a/stdlib/source/test/lux/data/color/rgb.lux b/stdlib/source/test/lux/data/color/rgb.lux index 19094bfe2..4325eb72b 100644 --- a/stdlib/source/test/lux/data/color/rgb.lux +++ b/stdlib/source/test/lux/data/color/rgb.lux @@ -55,9 +55,9 @@ Frac) (square_root (all f.+ - (|> (scale (/.red to)) (f.- (scale (/.red from))) square) - (|> (scale (/.green to)) (f.- (scale (/.green from))) square) - (|> (scale (/.blue to)) (f.- (scale (/.blue from))) square)))) + (|> (scale (the /.#red to)) (f.- (scale (the /.#red from))) square) + (|> (scale (the /.#green to)) (f.- (scale (the /.#green from))) square) + (|> (scale (the /.#blue to)) (f.- (scale (the /.#blue from))) square)))) (def .public test Test @@ -99,7 +99,8 @@ (n.= /.limit) not)) )) - (_.for [/.RGB] + (_.for [/.RGB + /.#red /.#green /.#blue] (all _.and (_.for [/.equivalence] (equivalenceS.spec /.equivalence ..random)) @@ -110,15 +111,14 @@ (_.for [/.subtraction] (monoidS.spec /.equivalence /.subtraction ..random)) - (_.coverage [/.rgb - /.red /.green /.blue] + (_.coverage [/.rgb] (let [it (/.rgb expected_red expected_green expected_blue)] (and (same? expected_red - (/.red it)) + (the /.#red it)) (same? expected_green - (/.green it)) + (the /.#green it)) (same? expected_blue - (/.blue it))))) + (the /.#blue it))))) (_.coverage [/.complement] (let [~expected (/.complement expected) (open "/#[0]") /.equivalence] diff --git a/stdlib/source/test/lux/meta/extension.lux b/stdlib/source/test/lux/meta/extension.lux index 9d49aeb16..f98359d94 100644 --- a/stdlib/source/test/lux/meta/extension.lux +++ b/stdlib/source/test/lux/meta/extension.lux @@ -39,12 +39,12 @@ ["[0]" name]]])) (.,, (.these))))] [compiler - ["[0]" phase] [meta [archive ["[0]" unit]]] [language [lux + ["[0]" phase] ["[0]" translation] ["[0]" declaration] ["[0]" analysis (.only) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index e1309f5f5..bf9ff3c7f 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -13,7 +13,10 @@ ["[1][0]" output ["[1]/[0]" video ["[1]/[0]" resolution]]] - ["[1][0]" money] + ["[1][0]" finance + ["[1]/[0]" money] + ["[1]/[0]" trade + ["[1]/[0]" session]]] ["[1][0]" net] ["[1][0]" time] ["[1][0]" locale] @@ -26,9 +29,13 @@ /shell.test /console.test /environment.test + /input/keyboard.test /output/video/resolution.test - /money.test + + /finance/money.test + /finance/trade/session.test + /net.test /time.test /locale.test diff --git a/stdlib/source/test/lux/world/money.lux b/stdlib/source/test/lux/world/finance/money.lux index 4cddc38ee..773589a15 100644 --- a/stdlib/source/test/lux/world/money.lux +++ b/stdlib/source/test/lux/world/finance/money.lux @@ -13,48 +13,46 @@ ["[0]" text (.only) ["%" \\format]]] [math - ["[0]" random (.only Random)] + ["[0]" random (.only Random) (.use "[1]#[0]" functor)] [number ["n" nat]]] [test ["_" property (.only Test)]]]] [\\library ["[0]" / (.only) - ["[0]" currency]]] + ["[0]" currency (.only Currency)]]] ["[0]" / ["[1][0]" currency]]) -(def .public random - (Random (Ex (_ of) - (/.Money of))) - (do random.monad - [expected_currency /currency.random - expected_amount random.nat] - (in (/.money expected_currency expected_amount)))) +(def .public (random $) + (All (_ $) + (-> (Currency $) + (Random (/.Money $)))) + (random#each (/.money $) + random.nat)) (def .public test Test (<| (_.covering /._) (do [! random.monad] - [.let [expected_currency currency.usd] - expected_amount random.nat + [expected_amount random.nat expected_parameter (random.only (n.> 0) random.nat) expected_subject random.nat]) (_.for [/.Money]) (all _.and (_.for [/.equivalence /.=] - (equivalenceS.spec /.equivalence ..random)) + (equivalenceS.spec /.equivalence (..random currency.usd))) (_.for [/.order /.<] - (orderS.spec /.order ..random)) + (orderS.spec /.order (..random currency.usd))) (_.coverage [/.money /.currency /.amount] - (let [it (/.money expected_currency expected_amount)] - (and (same? expected_currency (/.currency it)) + (let [it (/.money currency.usd expected_amount)] + (and (same? currency.usd (/.currency it)) (same? expected_amount (/.amount it))))) (_.coverage [/.+ /.-] - (let [parameter (/.money expected_currency expected_parameter) - subject (/.money expected_currency expected_subject)] + (let [parameter (/.money currency.usd expected_parameter) + subject (/.money currency.usd expected_subject)] (and (|> subject (/.+ parameter) (of /.equivalence = subject) @@ -65,21 +63,21 @@ (maybe#each (of /.equivalence = subject)) (maybe.else false))))) (_.coverage [/.min] - (let [expected_parameter (/.money expected_currency expected_parameter) - expected_subject (/.money expected_currency expected_subject)] + (let [expected_parameter (/.money currency.usd expected_parameter) + expected_subject (/.money currency.usd expected_subject)] (and (/.<= expected_parameter (/.min expected_parameter expected_subject)) (/.<= expected_subject (/.min expected_parameter expected_subject))))) (_.coverage [/.max] - (let [expected_parameter (/.money expected_currency expected_parameter) - expected_subject (/.money expected_currency expected_subject)] + (let [expected_parameter (/.money currency.usd expected_parameter) + expected_subject (/.money currency.usd expected_subject)] (and (/.>= expected_parameter (/.max expected_parameter expected_subject)) (/.>= expected_subject (/.max expected_parameter expected_subject))))) - (let [expected_parameter (/.money expected_currency expected_parameter) - expected_subject (/.money expected_currency expected_subject)] + (let [expected_parameter (/.money currency.usd expected_parameter) + expected_subject (/.money currency.usd expected_subject)] (all _.and (_.coverage [/.>] (bit#= (/.> expected_parameter expected_subject) @@ -89,17 +87,17 @@ (/.>= expected_subject expected_parameter))) )) (_.coverage [/.units /.sub_units] - (let [expected (/.money expected_currency expected_amount) - actual (/.money expected_currency (n.+ (/.units expected) - (/.sub_units expected)))] + (let [expected (/.money currency.usd expected_amount) + actual (/.money currency.usd (n.+ (/.units expected) + (/.sub_units expected)))] (/.= expected actual))) (_.coverage [/.of_units /.of_sub_units] - (let [expected (/.money expected_currency expected_amount) - actual (/.+ (/.of_units expected_currency (/.units expected)) - (/.of_sub_units expected_currency (/.sub_units expected)))] + (let [expected (/.money currency.usd expected_amount) + actual (/.+ (/.of_units currency.usd (/.units expected)) + (/.of_sub_units currency.usd (/.sub_units expected)))] (/.= expected actual))) (do ! - [it ..random] + [it (..random currency.usd)] (_.coverage [/.format] (and (text.starts_with? (%.nat (/.amount it)) (text.replaced_once "." "" (/.format it))) diff --git a/stdlib/source/test/lux/world/money/currency.lux b/stdlib/source/test/lux/world/finance/money/currency.lux index eeb59e9fc..eeb59e9fc 100644 --- a/stdlib/source/test/lux/world/money/currency.lux +++ b/stdlib/source/test/lux/world/finance/money/currency.lux diff --git a/stdlib/source/test/lux/world/finance/trade/session.lux b/stdlib/source/test/lux/world/finance/trade/session.lux new file mode 100644 index 000000000..6ce1979d2 --- /dev/null +++ b/stdlib/source/test/lux/world/finance/trade/session.lux @@ -0,0 +1,89 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["[0]S" equivalence]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + ["[0]" money (.only) + ["[0]" currency (.only Currency)]]]]] + [/// + ["[0]T" money]]) + +(def .public (random $) + (All (_ $) + (-> (Currency $) + (Random (/.Session $)))) + (do random.monad + [p0 (moneyT.random $) + p1 (moneyT.random $) + p2 (moneyT.random $) + p3 (moneyT.random $) + bullish? random.bit + volume random.nat] + (when (list.sorted money.< (list p0 p1 p2 p3)) + (list low bottom top high) + (in [/.#open (if bullish? + bottom + top) + /.#high high + /.#low low + /.#close (if bullish? + top + bottom) + /.#volume volume]) + + _ + (undefined)))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [before (..random currency.usd) + after (..random currency.usd)]) + (_.for [/.Session /.Price /.Volume + /.#open /.#high /.#low /.#close /.#volume]) + (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /.equivalence (..random currency.usd))) + + (_.coverage [/.composite] + (let [both (/.composite before after)] + (and (money.= (the /.#open before) + (the /.#open both)) + (and (money.>= (the /.#high before) + (the /.#high both)) + (money.>= (the /.#high after) + (the /.#high both))) + (and (money.<= (the /.#low before) + (the /.#low both)) + (money.<= (the /.#low after) + (the /.#low both))) + (money.= (the /.#close after) + (the /.#close both)) + (and (n.>= (the /.#volume before) + (the /.#volume both)) + (n.>= (the /.#volume after) + (the /.#volume both)))))) + (_.coverage [/.format] + (bit#= (of /.equivalence = + before + after) + (text#= (/.format before) + (/.format after)))) + ))) |