diff options
Diffstat (limited to 'stdlib')
30 files changed, 858 insertions, 1539 deletions
diff --git a/stdlib/source/library/lux/data/color/cmyk.lux b/stdlib/source/library/lux/data/color/cmyk.lux index dc85a4a97..4f2b46238 100644 --- a/stdlib/source/library/lux/data/color/cmyk.lux +++ b/stdlib/source/library/lux/data/color/cmyk.lux @@ -68,7 +68,7 @@ (def up (-> Frac Nat) - (|>> (f.* rgb_factor) f.int .nat)) + (|>> (f.* rgb_factor) f.round f.int .nat)) (def (opposite it) (-> Frac diff --git a/stdlib/source/library/lux/data/color/hsb.lux b/stdlib/source/library/lux/data/color/hsb.lux index ede1ffd08..5e7216de0 100644 --- a/stdlib/source/library/lux/data/color/hsb.lux +++ b/stdlib/source/library/lux/data/color/hsb.lux @@ -92,7 +92,7 @@ (def up (-> Frac Nat) - (|>> (f.* rgb_factor) f.int .nat)) + (|>> (f.* rgb_factor) f.round f.int .nat)) (def .public (of_rgb it) (-> RGB @@ -101,30 +101,36 @@ 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) + brightness (all f.max red green blue) + range (all f.min red green blue) - brightness max - diff (|> max (f.- min)) - saturation (if (f.= +0.0 max) + chroma (|> brightness (f.- range)) + saturation (if (f.= +0.0 brightness) +0.0 - (|> diff (f./ max)))] + (|> chroma (f./ brightness)))] (nominal.abstraction - [#hue (if (f.= max min) - ... Achromatic - +0.0 - ... Chromatic - (cond (f.= max red) - (|> green (f.- blue) (f./ diff) - (f.+ (if (f.< blue green) +6.0 +0.0))) - - (f.= max green) - (|> blue (f.- red) (f./ diff) - (f.+ +2.0)) - - ... (f.= max blue) - (|> red (f.- green) (f./ diff) - (f.+ +4.0)))) + [#hue (cond (f.= +0.0 chroma) + ... Achromatic + +0.0 + ... Chromatic + (and (f.= brightness red) + (not (f.= red blue))) + (|> green (f.- blue) + (f./ chroma) + (f.+ +0.0) + (f./ +6.0)) + + (f.= brightness green) + (|> blue (f.- red) + (f./ chroma) + (f.+ +2.0) + (f./ +6.0)) + + ... (f.= brightness blue) + (|> red (f.- green) + (f./ chroma) + (f.+ +4.0) + (f./ +6.0))) #saturation saturation #brightness brightness]))) @@ -140,7 +146,7 @@ t (|> +1.0 (f.- (|> +1.0 (f.- f) (f.* saturation))) (f.* brightness)) v brightness mod (|> i (f.% +6.0) f.int .nat) - + red (when mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) green (when mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) blue (when mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] diff --git a/stdlib/source/library/lux/data/color/hsl.lux b/stdlib/source/library/lux/data/color/hsl.lux index df8fb8a82..ac0b637c8 100644 --- a/stdlib/source/library/lux/data/color/hsl.lux +++ b/stdlib/source/library/lux/data/color/hsl.lux @@ -28,7 +28,7 @@ (def up (-> Frac Nat) - (|>> (f.* rgb_factor) f.int .nat)) + (|>> (f.* rgb_factor) f.round f.int .nat)) (type .public Value Frac) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 6d0f9d390..8afc76f04 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -1,13 +1,13 @@ (.require [library - [lux (.except Symbol Alias Global Declaration global function type_of undefined alias) + [lux (.except Symbol Alias Global Declaration Pattern global function type_of undefined alias) [abstract ["[0]" monad (.only do)]] [control ["<>" parser (.use "[1]#[0]" monad)] ["[0]" io] ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" try]] + ["[0]" try (.only Try)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) @@ -15,174 +15,324 @@ [collection ["[0]" list (.use "[1]#[0]" monoid monad mix)]]] ["[0]" meta (.only) + ["[0]" location] ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only with_symbols) [syntax (.only syntax)] ["[0]" template]] - [type + [type (.only sharing) ["[0]" nominal (.except #name def)]] ["@" target (.only) - ["[0]" js]]]]]) - -... These extensions must be defined this way because importing any of the modules -... normally used when writing extensions would introduce a circular dependency -... because the Archive type depends on Binary, and that module depends on this ffi module. -(def extension_name - (syntax (_ []) - (do meta.monad - [module meta.current_module_name - unique_id meta.seed] - (in (list (code.text (%.format module " " (%.nat unique_id)))))))) - -(def extension_analysis - (template (_ <name> <parameter>) - [{5 #1 [<name> <parameter>]}])) - -(def text_analysis - (template (_ <it>) - [{0 #0 {5 #1 <it>}}])) - -(def analysis - (template (_ <name> <bindings> <parser> <inputs> <body>) - [("lux def analysis" <name> - (.function (_ name phase archive inputs) - (.function (_ state) - (let [<bindings> [name phase archive state]] - (when (<code>.result <parser> inputs) - {try.#Failure error} - {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) - text.\n error)} - - {try.#Success <inputs>} - <body>)))))])) - -(def translation - (template (_ <name> <bindings> <inputs> <body>) - [("lux def translation" <name> - (.function (_ name phase archive inputs) - (.function (_ state) - (let [<bindings> [name phase archive state]] - (when inputs - <inputs> - <body> - - _ - {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) - -(for @.js (with_expansions [<undefined> (..extension_name) - <undefined?> (..extension_name) - <object> (..extension_name) - <set> (..extension_name)] - (these (analysis <undefined> - [name phase archive state] - <code>.end - _ - {try.#Success [state (extension_analysis name (list))]}) - - (translation <undefined> - [name phase archive state] + ["[0]" js] + ["[0]" python]] + [compiler + [arity (.only Arity)] + [reference (.only Reference) + [variable (.only Register)]] + [language + [lux + ["[0]" analysis + ["[1]/[0]" simple] + [complex (.only Complex)] + [pattern (.only Pattern)]] + ["[0]" synthesis + ["[1]/[0]" simple] + [access (.only Access) + [side (.only Side)] + ["[1]/[0]" member]]]]]]]]]) + +(for @.js (these (type (Analysis_Branch of) + [Pattern of]) + + (type (Analysis_Match of) + [(Analysis_Branch of) (List (Analysis_Branch of))]) + + (type (Environment of) + (List of)) + + (type (Extension of) + [.Symbol (List of)]) + + (with_expansions [@ ($ (Analysis~' $))] + (type (Analysis~' $) + (Or analysis/simple.Simple + (Complex @) + Reference + [@ (Analysis_Match @)] + [(Environment @) @] + [@ @] + (Extension @)))) + + (type Analysis~ + (Ann Location + (Analysis~' (Ann Location)))) + + (def extension_analysis + (template (_ <name> <parameter>) + [(is Analysis~ + [location.dummy {5 #1 [<name> <parameter>]}])])) + + (def text_analysis + (template (_ <it>) + [(is Analysis~ + [location.dummy {0 #0 {5 #1 <it>}}])])) + + (def analysis + (template (_ <name> <bindings> <parser> <inputs> <body>) + [(def .public <name> + (<| (as .Analysis) + (.function (_ phase archive inputs)) + (.function (_ state)) + (let [<bindings> [phase archive state]] + (when (<code>.result <parser> inputs) + {try.#Success <inputs>} + <body> + + {try.#Failure error} + {try.#Failure (%.format "Invalid inputs for extension..." + text.\n error)}))))])) + + (type (Synthesis_Road value next) + [value next]) + + (type (Synthesis_Fork value next) + [(Synthesis_Road value next) + (List (Synthesis_Road value next))]) + + (type (Synthesis_Path s) + (Or Any + Register + Access + [Bit (Synthesis_Path s) (Maybe (Synthesis_Path s))] + (Synthesis_Fork I64 (Synthesis_Path s)) + (Synthesis_Fork Frac (Synthesis_Path s)) + (Synthesis_Fork Text (Synthesis_Path s)) + [(Synthesis_Path s) (Synthesis_Path s)] + [(Synthesis_Path s) (Synthesis_Path s)] + s)) + + (type (Synthesis_Abstraction s) + [(Environment s) Arity s]) + + (type (Synthesis_Apply s) + [s (List s)]) + + (type (Synthesis_Function s) + (Or (Synthesis_Abstraction s) + (Synthesis_Apply s))) + + (type (Synthesis_Branch s) + (Or [s s] + [s Register s] + [s s s] + [(List synthesis/member.Member) s] + [s (Synthesis_Path s)])) + + (type (Synthesis_Scope s) + [Register (List s) s]) + + (type (Synthesis_Loop s) + (Or (Synthesis_Scope s) + (List s))) + + (type (Synthesis_Control s) + (Or (Synthesis_Branch s) + (Synthesis_Loop s) + (Synthesis_Function s))) + + (with_expansions [@ ($ (Synthesis~' $))] + (type (Synthesis~' $) + (Or synthesis/simple.Simple + (Complex @) + Reference + (Synthesis_Control @) + (Extension @)))) + + (type Synthesis~ + (Ann Location + (Synthesis~' (Ann Location)))) + + (def text_synthesis + (template (_ <@> <it>) + [[<@> {0 #0 {2 #1 <it>}}]])) + + (def translation + (syntax (_ [<name> <code>.any + <bindings> <code>.any + <inputs> (<>.or <code>.local + <code>.any) + <body> <code>.any]) + (with_symbols ['_ 'phase 'archive 'inputs 'state] + (in (list (` (def .public (, <name>) + (<| (as .Translation) + (.function ((, '_) (, 'phase) (, 'archive) (, 'inputs))) + (.function ((, '_) (, 'state))) + (let [(, <bindings>) [(, 'phase) (, 'archive) (, 'state)]] + (, (when <inputs> + {.#Left <inputs>} + (` (when (is (List Synthesis~) (, 'inputs)) + (, (code.local <inputs>)) + (, <body>))) + + {.#Right <inputs>} + (` (when (is (List Synthesis~) (, 'inputs)) + (, <inputs>) + (, <body>) + + (, '_) + {try.#Failure "Invalid inputs for extension."}))))))))))))) + + (translation undefined?|translation + [phase archive state] + (list it) + (do try.monad + [.let [phase (sharing [archive it state] + (is [archive it state] + [archive it state]) + (is (-> archive it state + (Try [state js.Expression])) + (as_expected phase)))] + [state it] (phase archive it state)] + (in [state (js.= js.undefined it)]))) + + (analysis undefined?|analysis + [phase archive state] + <code>.any + it + (do try.monad + [.let [phase (sharing [archive state] + (is [archive state] + [archive state]) + (is (-> archive Code state + (Try [state Analysis~])) + (as_expected phase)))] + [state it] (phase archive (` (.is .Any (, it))) state)] + (in [state (extension_analysis (symbol ..undefined?|translation) + (list it))]))) + + (def .public undefined? + (template (undefined? <it>) + [(.as .Bit (.is .Any (undefined?|analysis <it>)))])) + + (translation undefined|translation + [phase archive state] + (list) + {try.#Success [state js.undefined]}) + + (analysis undefined|analysis + [phase archive state] + <code>.end + _ + {try.#Success [state (extension_analysis (symbol ..undefined|translation) + (list))]}) + + (def .public undefined + (template (_) + [(.is ..Undefined (undefined|analysis))])) + + (def (pairs it) + (All (_ a) (-> (List a) (List [a a]))) + (when it + (list.partial left right tail) + (list.partial [left right] (pairs tail)) + (list) - {try.#Success [state js.undefined]}) - - (def .public undefined - (template (undefined) - [(.is ..Undefined (<undefined>))])) - - (analysis <undefined?> - [name phase archive state] - <code>.any - it - (do try.monad - [[state it] (phase archive (` (.is .Any (, it))) state)] - (in [state (extension_analysis name (list it))]))) - - (translation <undefined?> - [name phase archive state] - (list it) - (do try.monad - [[state it] (phase archive it state)] - (in [state (js.= js.undefined it)]))) - - (def .public undefined? - (template (undefined? <it>) - [(.as .Bit (.is .Any (<undefined?> <it>)))])) - - (analysis <object> - [name phase archive state] - (<>.some (<>.and <code>.text <code>.any)) - it - (do [! try.monad] - [[state output] (monad.mix ! (.function (_ [key value] [state output]) - (do ! - [[state value] (phase archive (` (.is .Any (, value))) state)] - (in [state (list.partial value (text_analysis key) output)]))) - [state (list)] - it)] - (in [state (extension_analysis name (list.reversed output))]))) - - (def text_synthesis - (template (_ <it>) - [{0 #0 {2 #1 <it>}}])) - - (def (pairs it) - (All (_ a) (-> (List a) (List [a a]))) - (when it - (list.partial left right tail) - (list.partial [left right] (pairs tail)) - - (list) - (list) - - _ - (.undefined))) - - (translation <object> - [name phase archive state] - (list.partial head_key head_value tail) - (do [! try.monad] - [[state output] (monad.mix ! - (.function (_ [key value] [state output]) - (when key - (text_synthesis key) - (do try.monad - [[state value] (phase archive value state)] - (in [state (list.partial [key value] output)])) - - _ - (.undefined))) - [state (list)] - (pairs (list.partial head_key head_value tail)))] - (in [state (js.object (list.reversed output))]))) - - (def .public object - (syntax (_ [it (<>.some <code>.any)]) - (in (list (` (.as (..Object .Any) - (<object> (,* it)))))))) - - (analysis <set> - [name phase archive state] - (all <>.and <code>.text <code>.any <code>.any) - [field value object] - (do try.monad - [[state value] (phase archive (` (.is .Any (, value))) state) - [state object] (phase archive (` (.is (..Object .Any) (, object))) state)] - (in [state (extension_analysis name (list (text_analysis field) value object))]))) - - (translation <set> - [name phase archive state] - (list (text_synthesis field) value object) - (do try.monad - [[state value] (phase archive value state) - [state object] (phase archive object state)] - (in [state (js.set (js.the field object) value)]))) - - (def .public set - (syntax (_ [field <code>.any - value <code>.any - object <code>.any]) - (in (list (` (.as .Any (<set> (, field) (, value) (, object)))))))) - )) + (list) + + _ + (.undefined))) + + (translation object|translation + [phase archive state] + it + (do [! try.monad] + [.let [phase (sharing [archive state] + (is [archive state] + [archive state]) + (is (-> archive Synthesis~ state + (Try [state js.Expression])) + (as_expected phase)))] + [state output] (monad.mix ! + (sharing [state] + (is state + state) + (is (-> [Synthesis~ Synthesis~] [state (List [Text js.Expression])] + (Try [state (List [Text js.Expression])])) + (.function (_ [key value] [state output]) + (when key + (text_synthesis @ key) + (do try.monad + [[state value] (phase archive value state)] + (in [state (list.partial [key value] output)])) + + _ + (.undefined))))) + [state (list)] + (pairs it))] + (in [state (js.object (list.reversed output))]))) + + (analysis object|analysis + [phase archive state] + (<>.some (<>.and <code>.text <code>.any)) + it + (do [! try.monad] + [.let [phase (sharing [archive state] + (is [archive state] + [archive state]) + (is (-> archive Code state + (Try [state Analysis~])) + (as_expected phase)))] + [state output] (monad.mix ! (.function (_ [key value] [state output]) + (do ! + [[state value] (phase archive (` (.is .Any (, value))) state)] + (in [state (list.partial value (text_analysis key) output)]))) + [state (list)] + it)] + (in [state (extension_analysis (symbol ..object|translation) + (list.reversed output))]))) + + (def .public object + (syntax (_ [it (<>.some <code>.any)]) + (in (list (` (.as (..Object .Any) + (object|analysis (,* it)))))))) + + (translation set|translation + [phase archive state] + (list (text_synthesis @ field) value object) + (do try.monad + [.let [phase (sharing [archive state] + (is [archive state] + [archive state]) + (is (-> archive Synthesis~ state + (Try [state js.Expression])) + (as_expected phase)))] + [state value] (phase archive value state) + [state object] (phase archive object state)] + (in [state (js.set (js.the field object) value)]))) + + (analysis set|analysis + [phase archive state] + (all <>.and <code>.text <code>.any <code>.any) + [field value object] + (do try.monad + [.let [phase (sharing [archive state] + (is [archive state] + [archive state]) + (is (-> archive Code state + (Try [state Analysis~])) + (as_expected phase)))] + [state value] (phase archive (` (.is .Any (, value))) state) + [state object] (phase archive (` (.is (..Object .Any) (, object))) state)] + (in [state (extension_analysis (symbol ..set|translation) + (list (text_analysis field) value object))]))) + + (def .public set + (syntax (_ [field <code>.any + value <code>.any + object <code>.any]) + (in (list (` (.as .Any (set|analysis (, field) (, value) (, object)))))))) + ) ... else (these)) @@ -217,7 +367,7 @@ @.python .python_function# @.lua .lua_function# (these))] - (nominal.def .public (Object brand) Any) + (nominal.def .public (Object of) Any) (with_expansions [<un_common> (for @.js (these [Symbol] [Null] @@ -229,12 +379,12 @@ @.ruby (these [Nil])) <un_common> <un_common>] (with_template [<name>] - [(with_expansions [<brand> (template.symbol [<name> "'"])] - (nominal.def <brand> + [(with_expansions [<of> (template.symbol [<name> "'"])] + (nominal.def <of> Any (type .public <name> - (Object <brand>))))] + (Object <of>))))] [Function] <un_common> @@ -510,7 +660,7 @@ (def (input_type input :it:) (-> Input Code Code) (let [:it: (if (the #try? input) - (` (try.Try (, :it:))) + (` (Try (, :it:))) :it:)] (if (the #io? input) (` (io.IO (, :it:))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux new file mode 100644 index 000000000..7e29191ac --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux @@ -0,0 +1,63 @@ +(.require + [library + [lux (.except) + [data + [text + ["%" \\format]]] + ["[0]" meta (.use "[1]#[0]" functor) + ["[0]" code] + [macro + [syntax (.only syntax)]] + [target + ["_" c++]]]]]) + +(def .public (host_value of it) + (-> _.Type _.Expression + _.Expression) + (|> it + (_.do "get" (list) (list)) + (_.as (_.* of)))) + +(def .public namespace + _.Namespace + "lux") + +(def name + (syntax (_ []) + (|> meta.seed + (meta#each (|>> %.nat + (%.format ..namespace) + code.text + list))))) + +(with_expansions [<clean_up> (..name)] + (def .public declaration + _.Declaration + (let [clean_up (let [of (_.type_name "Of") + it (_.local "it")] + (_.function (_.local <clean_up>) + (list of) + (list [(_.* of) it]) + _.void + (_.delete it)))] + (all _.then + (_.include "memory") + + (<| (_.namespace ..namespace) + (all _.then + clean_up + ))))) + + (def .public clean_up + (-> _.Type + _.Expression) + (|>> (list) + (_.global [..namespace <clean_up>]))) + ) + +(def .public (lux_value of it) + (-> _.Type _.Expression + _.Expression) + (_.on (list (_.new of (list it)) + (clean_up of)) + (_.global [_.standard "shared_ptr"] (list _.void)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux new file mode 100644 index 000000000..f091e288f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux @@ -0,0 +1,26 @@ +(.require + [library + [lux (.except i64) + [meta + [target + ["_" c++]]]]]) + +(def .public bit + _.Type + (_.type ["" "bool"] (list))) + +(def .public i64 + _.Type + (_.type ["" "int64_t"] (list))) + +(def .public f64 + _.Type + (_.type ["" "double"] (list))) + +(def .public text + _.Type + (_.type [_.standard "u32string"] (list))) + +(def .public value + _.Type + (_.type [_.standard "shared_ptr"] (list (_.type ["" "void"] (list))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux index dbd9f5c45..13790c910 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux @@ -258,7 +258,7 @@ (lux//try op) (with_vars [ex] (_.try (_.return (..right (_.apply_1 op ..unit))) - [ex (_.return (..left (|> ex (_.do "toString" (list)))))]))) + [ex (_.return (..left (_.the "stack" ex)))]))) (runtime (lux//program_args inputs) @@ -751,7 +751,7 @@ (runtime (io//error message) - (_.throw message)) + (_.throw (_.new (_.var "Error") (list message)))) (def runtime//io Statement diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/debug.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/debug.lux deleted file mode 100644 index 1d6adf5f6..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/debug.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" io (.only IO)] - ["[0]" try (.only Try)]] - [data - [binary (.only Binary)] - [text - ["%" \\format (.only format)]]] - [world - ["[0]" file (.only File)]]]]) - -(def extension ".class") - -(def .public (write_class! name bytecode) - (-> Text Binary (IO Text)) - (let [file_path (format name ..extension)] - (do io.monad - [outcome (do (try.with @) - [file (is (IO (Try (File IO))) - (file.get_file io.monad file.default file_path))] - (of file over_write bytecode))] - (in (when outcome - {try.#Success definition} - file_path - - {try.#Failure error} - error))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux index 297504638..af848be72 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux @@ -375,7 +375,7 @@ _.areturn ))})) -(def projection_type (type.method [(list) (list //type.tuple //type.offset) //type.value (list)])) +(def projection_type (type.method [(list) (list //type.tuple //type.lefts) //type.value (list)])) (def left_projection::name "left") (def .public left_projection (..procedure ..left_projection::name ..projection_type)) @@ -452,7 +452,7 @@ $right $tuple::size (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" - (type.method [(list) (list //type.tuple //type.index //type.index) //type.tuple (list)])))]] + (type.method [(list) (list //type.tuple //type.lefts //type.lefts) //type.tuple (list)])))]] (all _.composite (_.set_label @loop) $last_right $right diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux index c178701b3..329c0a02f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux @@ -8,17 +8,12 @@ (def .public frac (type.class "java.lang.Double" (list))) (def .public text (type.class "java.lang.String" (list))) - (def .public value (type.class "java.lang.Object" (list))) (def .public lefts type.int) (def .public right? ..value) (def .public variant (type.array ..value)) - -(def .public offset type.int) -(def .public index ..offset) (def .public tuple (type.array ..value)) (def .public stack (type.array ..value)) - (def .public error (type.class "java.lang.Throwable" (list))) diff --git a/stdlib/source/library/lux/meta/target/c++.lux b/stdlib/source/library/lux/meta/target/c++.lux index b8c2414f4..952cc0c0b 100644 --- a/stdlib/source/library/lux/meta/target/c++.lux +++ b/stdlib/source/library/lux/meta/target/c++.lux @@ -1,10 +1,12 @@ (.require [library - [lux (.except Code Type int) + [lux (.except Code Type Global Declaration int as function template local global type) + [abstract + [equivalence (.only Equivalence)]] [control ["|" pipe]] [data - ["[0]" text (.only) + ["[0]" text (.only \n \t) (.use "[1]#[0]" equivalence) ["%" \\format]] [collection ["[0]" list (.use "[1]#[0]" functor)]]] @@ -17,32 +19,60 @@ [type ["[0]" nominal]]]]]) +(def parameter_separator ", ") +(def term_delimiters ["(" ")"]) +(def type_delimiters ["<" ">"]) + (nominal.def .public (Code of) Text + (def .public equivalence + (All (_ of) + (Equivalence (Code of))) + (implementation + (def (= refererence it) + (text#= (nominal.representation refererence) + (nominal.representation it))))) + (def .public code (-> (Code Any) Text) (|>> nominal.representation)) - (with_template [<type> <super>+] - [(with_expansions [<of> (template.symbol [<type> "'"])] - (nominal.def (<of> of) - Any) - (`` (type .public <type> - (|> Any <of> (,, (template.spliced <super>+))))))] + (with_template [<super> <type>+] + [(`` (with_template [<type> <parameter>*'] + [(with_expansions [<parameter>* (template.spliced <parameter>*') + <brand> (template.symbol [<type> "'"])] + (nominal.def (<brand> <parameter>*) + Any) + + (.type .public <type> + (Ex (_ <parameter>*) + (<super> (<brand> <parameter>*)))))] - [Type [Code]] - [Expression [Code]] - [Computation [Expression' Code]] - ) + (,, (template.spliced <type>+))))] + + [Code + [[Type [of]] + [Expression [of]] + [Statement [of]]]] + + [Expression + [[Computation [of]] + [Reference [of]]]] + + [Type + [[Type_Name []]]] - (with_template [<type> <super>+] - [(with_expansions [<brand> (template.symbol [<type> "'"])] - (nominal.def <brand> Any) - (`` (type .public <type> (|> <brand> (,, (template.spliced <super>+))))))] + [Computation + [[Literal []]]] - [Literal [Computation' Expression' Code]] + [Reference + [[Local []] + [Global []]]] + + [Statement + [[Declaration []]]] ) (def .public bool @@ -69,7 +99,74 @@ [%.frac]) nominal.abstraction)) - (def .public (cast type term) + (.type .public Namespace + Text) + + (def .public standard + Namespace + "std") + + (def .public local + (-> Text + Local) + (|>> nominal.abstraction)) + + (def instantiation + (-> (List Type) + Text) + (|>> (|.when + (list) + "" + + it + (|> it + (list#each ..code) + (text.interposed ..parameter_separator) + (text.enclosed ..type_delimiters))))) + + (def .public (global [ns name] parameters) + (-> [Namespace Text] (List Type) + Global) + (nominal.abstraction + (let [instance (%.format name (instantiation parameters))] + (when ns + "" instance + _ (%.format ns "::" instance))))) + + (def .public (type name parameters) + (-> [Namespace Text] (List Type) + Type) + (|> (..global name parameters) + nominal.transmutation)) + + (def .public type_name + (-> Text + Type_Name) + (|>> nominal.abstraction)) + + (with_template [<ns> <name>] + [(def .public <name> + Type + (..type [<ns> (template.text [<name>])] (list)))] + + ["" void] + ) + + (def .public * + (-> Type + Type) + (|>> nominal.representation + (text.suffix "*") + nominal.abstraction)) + + (def .public deref + (-> Expression + Expression) + (|>> nominal.representation + (text.prefix "*") + nominal.abstraction)) + + (def .public (as type term) (-> Type Expression Computation) (nominal.abstraction @@ -82,16 +179,135 @@ (|>> %.int nominal.abstraction)) + (def application + (-> (List Expression) + Text) + (|>> (list#each ..code) + (text.interposed ..parameter_separator) + (text.enclosed ..term_delimiters))) + (def .public (on parameters function) (-> (List Expression) Expression Expression) (nominal.abstraction (%.format (nominal.representation function) - "(" - (|> parameters - (list#each (|>> nominal.representation)) - (text.interposed ", ")) - ")"))) + (application parameters)))) + + (def .public (new of parameters) + (-> Type (List Expression) + Expression) + (nominal.abstraction + (%.format "new " + (nominal.representation of) + (application parameters)))) + + (def .public (do method types parameters object) + (-> Text (List Type) (List Expression) Expression + Expression) + (nominal.abstraction + (%.format (nominal.representation object) + "." method + (instantiation types) + (application parameters)))) + + (def .public (<< it to) + (-> Expression Expression + Expression) + (nominal.abstraction + (%.format (nominal.representation to) + " << " + (nominal.representation it)))) + + (def .public (include it) + (-> Text + Declaration) + (nominal.abstraction + (%.format "#include <" it ">"))) + + (def .public (then before after) + (All (_ of) + (-> (Statement of) (Statement of) + (Statement of))) + (nominal.abstraction + (%.format (nominal.representation before) + \n (nominal.representation after)))) + + (def statement + (-> Text + Statement) + (|>> (text.suffix ";") + nominal.abstraction)) + + (def .public ; + (-> Expression + Statement) + (|>> nominal.representation + ..statement)) + + (def .public delete + (-> Expression + Statement) + (|>> nominal.representation + (%.format "delete ") + ..statement)) + + (def template + (-> (List Type_Name) + Text) + (|>> (|.when + (list) + "" + + it + (%.format "template" + " " (|> it + (list#each (|>> nominal.representation (%.format "typename "))) + (text.interposed ..parameter_separator) + (text.enclosed ..type_delimiters)) + " ")))) + + (.type Argument + [Type Local]) + + (def (argument [type it]) + (-> Argument + Text) + (%.format (nominal.representation type) + " " (nominal.representation it))) + + (def arguments + (-> (List Argument) + Text) + (|>> (list#each ..argument) + (text.interposed ..parameter_separator) + (text.enclosed ..term_delimiters))) + + (def block + (-> Statement + Text) + (let [\n\t (%.format \n \t) + <| (%.format "{" \n) + |> (%.format \n "}")] + (|>> nominal.representation + (text.replaced \n \n\t) + (text.enclosed [<| |>])))) + + (def .public (function name types inputs output body) + (-> Local (List Type_Name) (List Argument) Type Statement + Declaration) + (nominal.abstraction + (%.format (..template types) (nominal.representation output) + " " (nominal.representation name) + (..arguments inputs) + " " (..block body)))) + + (def .public (namespace it body) + (-> Namespace Declaration + Declaration) + (nominal.abstraction + (%.format "namespace" + " " it + " " (..block body)))) ... https://en.cppreference.com/w/cpp/types/integer (with_template [<name>] @@ -104,11 +320,31 @@ [int64_t] ) + (def safe + (-> Text + Text) + (let [\\'' (%.format "\" text.\'')] + (`` (|>> (,, (with_template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.\t "\t"] + [text.\v "\v"] + [text.\0 "\0"] + [text.\b "\b"] + [text.\f "\f"] + [text.\n "\n"] + [text.\r "\r"] + [text.\'' \\''] + )) + )))) + ... https://en.cppreference.com/w/cpp/string/basic_string (def .public u32string (-> Text Literal) - (|>> %.text + (|>> ..safe + %.text (%.format "U") nominal.abstraction)) ) diff --git a/stdlib/source/library/lux/meta/target/jvm/type.lux b/stdlib/source/library/lux/meta/target/jvm/type.lux index 0eff5b048..e1cbb4374 100644 --- a/stdlib/source/library/lux/meta/target/jvm/type.lux +++ b/stdlib/source/library/lux/meta/target/jvm/type.lux @@ -45,7 +45,9 @@ (with_template [<name> <style>] [(def .public (<name> type) - (All (_ category) (-> (Type category) (<style> category))) + (All (_ category) + (-> (Type category) + (<style> category))) (let [[signature descriptor reflection] (representation type)] <name>))] @@ -77,28 +79,32 @@ ) (def .public (array type) - (-> (Type Value) (Type Array)) + (-> (Type Value) + (Type Array)) (abstraction [(/signature.array (..signature type)) (/descriptor.array (..descriptor type)) (/reflection.array (..reflection type))])) (def .public (class name parameters) - (-> External (List (Type Parameter)) (Type Class)) + (-> External (List (Type Parameter)) + (Type Class)) (abstraction [(/signature.class name (list#each ..signature parameters)) (/descriptor.class name) (/reflection.class name)])) (def .public (declaration name variables) - (-> External (List (Type Var)) (Type Declaration)) + (-> External (List (Type Var)) + (Type Declaration)) (abstraction [(/signature.declaration name (list#each ..signature variables)) (/descriptor.declaration name) (/reflection.declaration name)])) (def .public (as_class type) - (-> (Type Declaration) (Type Class)) + (-> (Type Declaration) + (Type Class)) (abstraction (let [[signature descriptor reflection] (representation type)] [(/signature.as_class signature) @@ -113,14 +119,16 @@ /reflection.wildcard])) (def .public (var name) - (-> Text (Type Var)) + (-> Text + (Type Var)) (abstraction [(/signature.var name) /descriptor.var /reflection.var])) (def .public (lower bound) - (-> (Type Parameter) (Type Parameter)) + (-> (Type Parameter) + (Type Parameter)) (abstraction (let [[signature descriptor reflection] (representation bound)] [(/signature.lower signature) @@ -128,7 +136,8 @@ (/reflection.lower reflection)]))) (def .public (upper bound) - (-> (Type Parameter) (Type Parameter)) + (-> (Type Parameter) + (Type Parameter)) (abstraction (let [[signature descriptor reflection] (representation bound)] [(/signature.upper signature) @@ -151,7 +160,8 @@ (as_expected ..void)])) (def .public equivalence - (All (_ category) (Equivalence (Type category))) + (All (_ category) + (Equivalence (Type category))) (implementation (def (= parameter subject) (of /signature.equivalence = @@ -159,14 +169,16 @@ (..signature subject))))) (def .public hash - (All (_ category) (Hash (Type category))) + (All (_ category) + (Hash (Type category))) (implementation (def equivalence ..equivalence) (def hash (|>> ..signature (of /signature.hash hash))))) (def .public (primitive? type) - (-> (Type Value) (Either (Type Object) - (Type Primitive))) + (-> (Type Value) + (Either (Type Object) + (Type Primitive))) (if (`` (or (,, (with_template [<type>] [(of ..equivalence = (is (Type Value) <type>) type)] @@ -182,8 +194,9 @@ (|> type (as (Type Object)) {.#Left}))) (def .public (void? type) - (-> (Type Return) (Either (Type Value) - (Type Void))) + (-> (Type Return) + (Either (Type Value) + (Type Void))) (if (`` (or (,, (with_template [<type>] [(of ..equivalence = (is (Type Return) <type>) type)] @@ -193,7 +206,8 @@ ) (def .public (class? type) - (-> (Type Value) (Maybe External)) + (-> (Type Value) + (Maybe External)) (let [repr (|> type ..descriptor /descriptor.descriptor)] (if (and (text.starts_with? /descriptor.class_prefix repr) (text.ends_with? /descriptor.class_suffix repr)) @@ -208,5 +222,6 @@ {.#None}))) (def .public format - (All (_ a) (Format (Type a))) + (All (_ of) + (Format (Type of))) (|>> ..signature /signature.signature)) diff --git a/stdlib/source/library/lux/meta/target/python.lux b/stdlib/source/library/lux/meta/target/python.lux index a6d0968c5..c1c8fe105 100644 --- a/stdlib/source/library/lux/meta/target/python.lux +++ b/stdlib/source/library/lux/meta/target/python.lux @@ -1,7 +1,6 @@ (.require [library [lux (.except Location Code not or and list if int comment exec try the is def when) - ["[0]" ffi] [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] @@ -18,7 +17,6 @@ ["n" nat] ["f" frac]]] [meta - ["@" target] ["[0]" code (.only) ["<[1]>" \\parser]] [macro @@ -34,14 +32,6 @@ (-> Text Text) (text.enclosed ["(" ")"])) -(for @.old (these (ffi.import java/lang/CharSequence - "[1]::[0]") - - (ffi.import java/lang/String - "[1]::[0]" - (replace [java/lang/CharSequence java/lang/CharSequence] java/lang/String))) - (these)) - ... Added the carriage return for better Windows compatibility. (.def \n+ Text @@ -50,12 +40,8 @@ (.def nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] - (for @.old (|>> (format \n+) - (as java/lang/String) - (java/lang/String::replace (as java/lang/CharSequence text.new_line) - (as java/lang/CharSequence nested_new_line))) - (|>> (format \n+) - (text.replaced text.new_line nested_new_line))))) + (|>> (format \n+) + (text.replaced text.new_line nested_new_line)))) (nominal.def .public (Code brand) Text diff --git a/stdlib/source/specification/aedifex/repository.lux b/stdlib/source/specification/aedifex/repository.lux deleted file mode 100644 index 52a7e1bfe..000000000 --- a/stdlib/source/specification/aedifex/repository.lux +++ /dev/null @@ -1,59 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" try (.only Try)] - [concurrency - ["[0]" async (.only Async)]]] - [data - ["[0]" binary (.only) - ["_[1]" \\test]]] - [math - ["[0]" random]] - [test - ["[0]" unit] - ["_" property (.only Test)]]]] - [\\program - ["[0]" / (.only) - ["[1][0]" remote] - ["/[1]" // - ["[1][0]" artifact (.only Artifact) - ["[1]/[0]" extension]]]]] - [\\test - ["_[0]" // - ["[1][0]" artifact]]]) - -(def .public (spec valid_artifact invalid_artifact subject) - (-> Artifact Artifact (/.Repository Async) Test) - (do random.monad - [expected (_binary.random 100)] - (in (all unit.and - (do async.monad - [.let [good_uri (/remote.uri (the //artifact.#version valid_artifact) valid_artifact //artifact/extension.lux_library)] - good_upload! (of subject upload good_uri expected) - good_download! (of subject download good_uri) - - .let [bad_uri (/remote.uri (the //artifact.#version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] - bad_upload! (of subject upload bad_uri expected) - bad_download! (of subject download bad_uri)] - (unit.coverage [/.Repository] - (let [successfull_flow! - (when [good_upload! good_download!] - [{try.#Success _} {try.#Success actual}] - (of binary.equivalence = expected actual) - - _ - false) - - failed_flow! - (when [bad_upload! bad_download!] - [{try.#Failure _} {try.#Failure _}] - true - - _ - false)] - (and successfull_flow! - failed_flow!)))) - )))) diff --git a/stdlib/source/specification/compositor.lux b/stdlib/source/specification/compositor.lux deleted file mode 100644 index f6fb3f280..000000000 --- a/stdlib/source/specification/compositor.lux +++ /dev/null @@ -1,69 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" io (.only IO)] - ["[0]" try]] - [math - ["r" random]] - [meta - [compiler - ["[0]" analysis] - ["[0]" declaration] - [phase - [macro (.only Expander)] - [translation (.only Bundle)]] - [default - [platform (.only Platform)]]]] - [test - ["_" property (.only Test)]]]] - ["[0]" / - ["[1][0]" common (.only Runner Definer)] - ["[1]./" analysis - ["[1][0]" type]] - ["[1]./" translation - ["[1][0]" primitive] - ["[1][0]" structure] - ["[1][0]" reference] - ["[1][0]" when] - ["[1][0]" function] - ["[1][0]" common]]]) - -(def (test runner definer state expander) - (-> Runner Definer analysis.State Expander Test) - (all _.and - (/analysis/type.spec expander state) - (/translation/primitive.spec runner) - (/translation/structure.spec runner) - (/translation/reference.spec runner definer) - (/translation/when.spec runner) - (/translation/function.spec runner) - (/translation/common.spec runner) - )) - -(def .public (spec platform bundle expander program) - (All (_ anchor expression declaration) - (-> (IO (Platform IO anchor expression declaration)) - (Bundle anchor expression declaration) - Expander - (-> expression declaration) - Test)) - (do r.monad - [_ (in []) - .let [?state,runner,definer (<| io.run! - (do io.monad - [platform platform]) - (/common.executors platform - bundle - expander - program))]] - (when ?state,runner,definer - {try.#Success [[declaration_bundle declaration_state] runner definer]} - (..test runner definer - (the [declaration.#analysis declaration.#state] declaration_state) - expander) - - {try.#Failure error} - (_.failure error)))) diff --git a/stdlib/source/specification/compositor/analysis/type.lux b/stdlib/source/specification/compositor/analysis/type.lux deleted file mode 100644 index 726e438c9..000000000 --- a/stdlib/source/specification/compositor/analysis/type.lux +++ /dev/null @@ -1,65 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" io] - ["[0]" try]] - [math - ["r" random (.only Random)]] - [meta - ["[0]" code] - [compiler - [analysis (.only State)] - ["[0]" phase - [macro (.only Expander)] - ["[0]" analysis - ["[1]/[0]" scope] - ["[1]/[0]" type]]]]] - [test - ["_" property (.only Test)]]]]) - -(def (check_success+ expander state extension params output_type) - (-> Expander State Text (List Code) Type Bit) - (|> (analysis/scope.with_scope "" - (analysis/type.with_type output_type - (analysis.phase expander (` ((, (code.text extension)) (,* params)))))) - (phase.result state) - (pipe.when - {try.#Success _} - true - - {try.#Failure _} - false))) - -(def check - (Random [Code Type Code]) - (`` (all r.either - (,, (with_template [<random> <type> <code>] - [(do r.monad - [value <random>] - (in [(` <type>) - <type> - (<code> value)]))] - - [r.bit {0 #0 "#Bit" {0 #0}} code.bit] - [r.nat {0 #0 "#I64" {0 #1 {0 #0 "#Nat" {0 #0}} {0 #0}}} code.nat] - [r.int {0 #0 "#I64" {0 #1 {0 #0 "#Int" {0 #0}} {0 #0}}} code.int] - [r.rev {0 #0 "#I64" {0 #1 {0 #0 "#Rev" {0 #0}} {0 #0}}} code.rev] - [r.safe_frac {0 #0 "#Frac" {0 #0}} code.frac] - [(r.upper_case_alpha 5) {0 #0 "#Text" {0 #0}} code.text] - ))))) - -(def .public (spec expander state) - (-> Expander State Test) - (do r.monad - [[typeC exprT exprC] ..check - [other_typeC other_exprT other_exprC] ..check] - (all _.and - (_.test "lux check" - (check_success+ expander state "lux check" (list typeC exprC) exprT)) - (_.test "lux coerce" - (check_success+ expander state "lux coerce" (list typeC other_exprC) exprT)) - ))) diff --git a/stdlib/source/specification/compositor/common.lux b/stdlib/source/specification/compositor/common.lux deleted file mode 100644 index 6045d8db1..000000000 --- a/stdlib/source/specification/compositor/common.lux +++ /dev/null @@ -1,80 +0,0 @@ -(.require - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" io (.only IO)] - ["[0]" try (.only Try)]] - [meta - [compiler - ["[0]" reference] - ["[0]" analysis] - ["[0]" synthesis (.only Synthesis)] - ["[0]" declaration] - ["[0]" phase - ["[0]" macro (.only Expander)] - ["[0]" translation (.only Operation)] - [extension (.only Extender) - ["[0]" bundle]]] - [default - ["[0]" platform (.only Platform)]]]]]) - -(type .public Runner - (-> Text Synthesis (Try Any))) - -(type .public Definer - (-> Symbol Synthesis (Try Any))) - -(type .public (Instancer what) - (All (_ anchor expression declaration) - (-> (Platform IO anchor expression declaration) - (translation.State anchor expression declaration) - what))) - -(def (runner (open "[0]") state) - (Instancer Runner) - (function (_ evaluation_name expressionS) - (do try.monad - [expressionG (<| (phase.result state) - translation.with_buffer - (do phase.monad - [_ runtime] - (phase expressionS)))] - (of host evaluate! evaluation_name expressionG)))) - -(def (definer (open "[0]") state) - (Instancer Definer) - (function (_ lux_name expressionS) - (do try.monad - [definitionG (<| (phase.result state) - translation.with_buffer - (do phase.monad - [_ runtime - expressionG (phase expressionS) - [host_name host_value host_declaration] (translation.define! lux_name expressionG) - _ (translation.learn lux_name host_name)] - (phase (synthesis.constant lux_name))))] - (of host evaluate! "definer" definitionG)))) - -(def .public (executors target expander platform - analysis_bundle translation_bundle declaration_bundle - program extender) - (All (_ anchor expression declaration) - (-> Text Expander (Platform IO anchor expression declaration) - analysis.Bundle - (translation.Bundle anchor expression declaration) - (declaration.Bundle anchor expression declaration) - (-> expression declaration) Extender - (IO (Try [(declaration.State anchor expression declaration) - Runner - Definer])))) - (do io.monad - [?state (platform.initialize target expander analysis_bundle platform translation_bundle declaration_bundle program extender)] - (in (do try.monad - [[declaration_bundle declaration_state] ?state - .let [translation_state (the [declaration.#translation - declaration.#state] - declaration_state)]] - (in [[declaration_bundle declaration_state] - (..runner platform translation_state) - (..definer platform translation_state)]))))) diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux deleted file mode 100644 index 5b36db339..000000000 --- a/stdlib/source/specification/compositor/generation/case.lux +++ /dev/null @@ -1,290 +0,0 @@ -(.require - [library - [lux (.except when) - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" try (.only Try)]] - [data - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]] - [number - ["n" nat] - ["f" frac]] - [collection - ["[0]" list (.use "[1]#[0]" mix)]]] - [math - ["r" random (.only Random)]] - [meta - [compiler - ["[0]" reference] - ["[0]" analysis] - ["[0]" synthesis (.only Path Synthesis)] - ["[0]" phase - ["[1]/[0]" synthesis - ["[0]" when]] - ["[0]" extension/synthesis]]]] - [test - ["_" property (.only Test)]]]] - [/// - [common (.only Runner)]]) - -(def limit Nat 10) - -(def size - (Random Nat) - (|> r.nat (of r.monad each (|>> (n.% ..limit) (n.max 2))))) - -(def (tail? size idx) - (-> Nat Nat Bit) - (n.= (-- size) idx)) - -(def .public (verify expected) - (-> Frac (Try Any) Bit) - (|>> (pipe.when - {try.#Success actual} - (f.= expected (as Frac actual)) - - {try.#Failure _} - false))) - -(def when - (Random [Synthesis Path]) - (<| r.rec (function (_ when)) - (`` (all r.either - (do r.monad - [value r.i64] - (in [(synthesis.i64 value) - synthesis.path/pop])) - (,, (with_template [<gen> <synth> <path>] - [(do r.monad - [value <gen>] - (in [(<synth> value) - (<path> value)]))] - - [r.bit synthesis.bit synthesis.path/bit] - [r.i64 synthesis.i64 synthesis.path/i64] - [r.frac synthesis.f64 synthesis.path/f64] - [(r.unicode 5) synthesis.text synthesis.path/text])) - (do [! r.monad] - [size ..size - idx (|> r.nat (of ! each (n.% size))) - [subS subP] when - .let [unitS (synthesis.text synthesis.unit) - whenS (synthesis.tuple - (list.together (list (list.repeated idx unitS) - (list subS) - (list.repeated (|> size -- (n.- idx)) unitS)))) - whenP (all synthesis.path/seq - (if (tail? size idx) - (synthesis.member/right idx) - (synthesis.member/left idx)) - subP)]] - (in [whenS whenP])) - (do [! r.monad] - [size ..size - idx (|> r.nat (of ! each (n.% size))) - [subS subP] when - .let [right? (tail? size idx) - whenS (synthesis.variant - [analysis.#lefts idx - analysis.#right? right? - analysis.#value subS]) - whenP (all synthesis.path/seq - (if right? - (synthesis.side/right idx) - (synthesis.side/left idx)) - subP)]] - (in [whenS whenP])) - )))) - -(def (let_spec run) - (-> Runner Test) - (do r.monad - [value r.safe_frac] - (_.test (%.symbol (symbol synthesis.branch/let)) - (|> (synthesis.branch/let [(synthesis.f64 value) - 0 - (synthesis.variable/local 0)]) - (run "let_spec") - (verify value))))) - -(def (if_spec run) - (-> Runner Test) - (do r.monad - [on_true r.safe_frac - on_false (|> r.safe_frac (r.only (|>> (f.= on_true) not))) - verdict r.bit] - (_.test (%.symbol (symbol synthesis.branch/if)) - (|> (synthesis.branch/if [(synthesis.bit verdict) - (synthesis.f64 on_true) - (synthesis.f64 on_false)]) - (run "if_spec") - (verify (if verdict on_true on_false)))))) - -(def (when_spec run) - (-> Runner Test) - (do r.monad - [[inputS pathS] ..when - on_success r.safe_frac - on_failure (|> r.safe_frac (r.only (|>> (f.= on_success) not)))] - (_.test (%.symbol (symbol synthesis.branch/when)) - (|> (synthesis.branch/when - [inputS - (all synthesis.path/alt - (all synthesis.path/seq - pathS - (synthesis.path/then (synthesis.f64 on_success))) - (synthesis.path/then (synthesis.f64 on_failure)))]) - (run "when_spec") - (verify on_success))))) - -(def special_input - Synthesis - (let [_cursor_ (is Synthesis - (synthesis.tuple (list (synthesis.text .prelude) - (synthesis.i64 +901) - (synthesis.i64 +13)))) - _code_ (is (-> Synthesis Synthesis) - (function (_ content) - (synthesis.tuple (list _cursor_ content)))) - _end_ (is Synthesis - (synthesis.variant [0 #0 (synthesis.text "")])) - _item_ (is (-> Synthesis Synthesis Synthesis) - (function (_ head tail) - (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) - _list_ (is (-> (List Synthesis) Synthesis) - (list#mix _item_ _end_))] - (let [__tuple__ (is (-> (List Synthesis) Synthesis) - (|>> list.reversed _list_ [9 #0] synthesis.variant _code_)) - __form__ (is (-> (List Synthesis) Synthesis) - (|>> list.reversed _list_ [7 #0] synthesis.variant _code_)) - __text__ (is (-> Text Synthesis) - (function (_ value) - (_code_ (synthesis.variant [5 #0 (synthesis.text value)])))) - __symbol__ (is (-> Symbol Synthesis) - (function (_ [module short]) - (_code_ (synthesis.variant [6 #0 (synthesis.tuple (list (synthesis.text module) - (synthesis.text short)))])))) - __list__ (is (-> (List Synthesis) Synthesis) - (list#mix (function (_ head tail) - (__form__ (list (__tag__ ["" "Item"]) head tail))) - (__tag__ ["" "End"]))) - __apply__ (is (-> Synthesis Synthesis Synthesis) - (function (_ func arg) - (__form__ (list func arg))))] - (|> _end_ - (_item_ (__apply__ (__symbol__ ["" "form$"]) - (__list__ (list (__apply__ (__symbol__ ["" "tag$"]) - (__tuple__ (list (__text__ .prelude) - (__text__ "Item")))) - (__symbol__ ["" "export?-meta"]) - (__symbol__ ["" "tail"]))))) - (_item_ (__tuple__ (list (__symbol__ ["" "tail"])))) - )))) - -(def special_path - Path - (let [_end_ (synthesis.path/side {.#Left 0}) - _item_ (synthesis.path/side {.#Right 0}) - _head_ (synthesis.path/member {.#Left 0}) - _tail_ (synthesis.path/member {.#Right 0}) - _tuple_ (synthesis.path/side {.#Left 9})] - (all synthesis.path/alt - (all synthesis.path/seq - _item_ - _head_ - _head_ (synthesis.path/bind 2) synthesis.path/pop - _tail_ _tuple_ _item_ - _head_ (synthesis.path/bind 3) synthesis.path/pop - _tail_ (synthesis.path/bind 4) synthesis.path/pop - synthesis.path/pop synthesis.path/pop synthesis.path/pop synthesis.path/pop - _tail_ _item_ - _head_ (synthesis.path/bind 5) synthesis.path/pop - _tail_ _end_ - ... THEN - (synthesis.path/then (synthesis.bit #1))) - (all synthesis.path/seq - (synthesis.path/bind 2) - ... THEN - (synthesis.path/then (synthesis.bit #0)))))) - -(def special_pattern - analysis.Pattern - (let [... [_ {#Tuple {#Item arg args'}}] - head (<| analysis.pattern/tuple (list (analysis.pattern/bind 2)) - analysis.pattern/variant [9 #0] - analysis.pattern/variant [0 #1] - analysis.pattern/tuple (list (analysis.pattern/bind 3) - (analysis.pattern/bind 4))) - ... {#Item body {#End}} - tail (<| analysis.pattern/variant [0 #1] - analysis.pattern/tuple (list (analysis.pattern/bind 5)) - analysis.pattern/variant [0 #0] - (analysis.pattern/unit))] - ... {#Item <head> <tail>} - (<| analysis.pattern/variant [0 #1] - (analysis.pattern/tuple (list head tail))))) - -(def special_pattern_path - Path - (all synthesis.path/alt - (<| try.trusted - (phase.result [extension/synthesis.bundle - synthesis.init]) - (when.path phase/synthesis.phase - special_pattern) - (analysis.bit #1)) - (all synthesis.path/seq - (synthesis.path/bind 2) - ... THEN - (synthesis.path/then (synthesis.bit #0))))) - -... TODO: Get rid of this ASAP -(def (special_spec run) - (-> Runner Test) - (all _.and - (_.test "===" - (and (text#= (synthesis.%path special_path) - (synthesis.%path special_pattern_path)) - (of synthesis.path_equivalence = special_path special_pattern_path))) - (_.test "CODE" - (|> special_input - (run "special_input") - (pipe.when - {try.#Success output} - true - - {try.#Failure _} - false))) - (_.test "PATTERN_MATCHING 0" - (|> (synthesis.branch/when [special_input - special_path]) - (run "special_path") - (pipe.when - {try.#Success output} - true - - {try.#Failure _} - false))) - (_.test "PATTERN_MATCHING 1" - (|> (synthesis.branch/when [special_input - special_pattern_path]) - (run "special_pattern_path") - (pipe.when - {try.#Success output} - true - - {try.#Failure _} - false))) - )) - -(def .public (spec run) - (-> Runner Test) - (all _.and - (..special_spec run) - (..let_spec run) - (..if_spec run) - (..when_spec run) - )) diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux deleted file mode 100644 index acb782c1f..000000000 --- a/stdlib/source/specification/compositor/generation/common.lux +++ /dev/null @@ -1,350 +0,0 @@ -(.require - [library - [lux (.except i64) - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" try (.only Try)]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)] - [number - ["[0]" i64] - ["n" nat] - ["i" int] - ["f" frac]] - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]] - [collection - ["[0]" list]]] - [math - ["r" random (.only Random)]] - [meta - [macro - ["^" pattern]] - [compiler - ["[0]" reference] - ["[0]" synthesis]]] - [test - ["_" property (.only Test)]]]] - ["[0]" // - ["[1][0]" when] - [// - [common (.only Runner)]]]) - -(def safe - (-> Text Text) - (text.replaced " " "_")) - -(def (bit run) - (-> Runner Test) - (do r.monad - [param r.i64 - subject r.i64] - (with_expansions [<binary> (with_template [<extension> <reference> <param_expr>] - [(_.test <extension> - (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.i64 param) - (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.when - {try.#Success valueT} - (n.= (<reference> param subject) (as Nat valueT)) - - {try.#Failure _} - false) - (let [param <param_expr>])))] - - [.i64_and# i64.and param] - [.i64_or# i64.or param] - [.i64_xor# i64.xor param] - [.i64_left# i64.left_shifted (n.% 64 param)] - ["lux i64 logical-right-shift" i64.logic_right_shifted (n.% 64 param)] - )] - (all _.and - <binary> - (_.test "lux i64 arithmetic-right-shift" - (|> {synthesis.#Extension "lux i64 arithmetic-right-shift" - (list (synthesis.i64 subject) - (synthesis.i64 param))} - (run (..safe "lux i64 arithmetic-right-shift")) - (pipe.when - {try.#Success valueT} - (.i64_=# (i64.arithmetic_right_shifted param subject) - (as I64 valueT)) - - {try.#Failure _} - false) - (let [param (n.% 64 param)]))) - )))) - -(def (i64 run) - (-> Runner Test) - (do r.monad - [param (|> r.i64 (r.only (|>> (.i64_=# 0) not))) - subject r.i64] - (`` (all _.and - (,, (with_template [<extension> <type> <prepare> <comp> <subject_expr>] - [(_.test <extension> - (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.when - {try.#Success valueT} - (<comp> (<prepare> subject) (as <type> valueT)) - - {try.#Failure _} - false) - (let [subject <subject_expr>])))] - - [.int_f64# Frac i.frac f.= subject] - [.int_char# Text (|>> (as Nat) text.from_code) text#= (|> subject - (as Nat) - (n.% (i64.left_shifted 8 1)) - (as Int))] - )) - (,, (with_template [<extension> <reference> <outputT> <comp>] - [(_.test <extension> - (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.i64 param) - (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.when - {try.#Success valueT} - (<comp> (<reference> param subject) (as <outputT> valueT)) - - {try.#Failure _} - false)))] - - [.i64_+# i.+ Int i.=] - [.i64_-# i.- Int i.=] - [.i64_=# i.= Bit bit#=] - - [.int_<# i.< Bit bit#=] - [.int_*# i.* Int i.=] - [.int_/# i./ Int i.=] - [.int_%# i.% Int i.=] - )) - )))) - -(def simple_frac - (Random Frac) - (|> r.nat (of r.monad each (|>> (n.% 1000) .int i.frac)))) - -(def (f64 run) - (-> Runner Test) - (do r.monad - [param (|> ..simple_frac (r.only (|>> (f.= +0.0) not))) - subject ..simple_frac] - (`` (all _.and - (,, (with_template [<extension> <reference> <comp>] - [(_.test <extension> - (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.f64 param) - (synthesis.f64 subject))} - (run (..safe <extension>)) - (//when.verify (<reference> param subject))))] - - [.f64_+# f.+ f.=] - [.f64_-# f.- f.=] - [.f64_*# f.* f.=] - [.f64_/# f./ f.=] - [.f64_%# f.% f.=] - )) - (,, (with_template [<extension> <text>] - [(_.test <extension> - (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.f64 param) - (synthesis.f64 subject))} - (run (..safe <extension>)) - (pipe.when - {try.#Success valueV} - (bit#= (<text> param subject) - (as Bit valueV)) - - _ - false)))] - - [.f64_=# f.=] - [.f64_<# f.<] - )) - (_.test ".f64_int# && .int_f64#" - (|> (run (..safe .f64_int#) - (|> subject synthesis.f64 - (list) {synthesis.#Extension (symbol .f64_int#)} - (list) {synthesis.#Extension (symbol .int_f64#)})) - (//when.verify subject))) - )))) - -(def (text run) - (-> Runner Test) - (do [! r.monad] - [sample_size (|> r.nat (of ! each (|>> (n.% 10) (n.max 1)))) - sample_lower (r.lower_case_alpha sample_size) - sample_upper (r.upper_case_alpha sample_size) - sample_alpha (|> (r.alphabetic sample_size) - (r.only (|>> (text#= sample_upper) not))) - char_idx (|> r.nat (of ! each (n.% sample_size))) - .let [sample_lowerS (synthesis.text sample_lower) - sample_upperS (synthesis.text sample_upper) - sample_alphaS (synthesis.text sample_alpha) - concatenatedS {synthesis.#Extension (symbol .text_composite#) (list sample_lowerS sample_upperS)} - pre_rep_once (format sample_lower sample_upper) - post_rep_once (format sample_lower sample_alpha) - pre_rep_all (|> sample_lower (list.repeated sample_size) (text.interposed sample_upper)) - post_rep_all (|> sample_lower (list.repeated sample_size) (text.interposed sample_alpha))]] - (all _.and - (_.test "Can compare texts for equality." - (and (|> {synthesis.#Extension (symbol .text_=#) (list sample_lowerS sample_lowerS)} - (run (..safe .text_=#)) - (pipe.when - {try.#Success valueV} - (as Bit valueV) - - _ - false)) - (|> {synthesis.#Extension (symbol .text_=#) (list sample_upperS sample_lowerS)} - (run (..safe .text_=#)) - (pipe.when - {try.#Success valueV} - (not (as Bit valueV)) - - _ - false)))) - (_.test "Can compare texts for order." - (|> {synthesis.#Extension (symbol .text_<#) (list sample_lowerS sample_upperS)} - (run (..safe .text_<#)) - (pipe.when - {try.#Success valueV} - (as Bit valueV) - - {try.#Failure _} - false))) - (_.test "Can get length of text." - (|> {synthesis.#Extension (symbol .text_size#) (list sample_lowerS)} - (run (..safe .text_size#)) - (pipe.when - {try.#Success valueV} - (n.= sample_size (as Nat valueV)) - - _ - false))) - (_.test "Can concatenate text." - (|> {synthesis.#Extension (symbol .text_size#) (list concatenatedS)} - (run (..safe .text_size#)) - (pipe.when - {try.#Success valueV} - (n.= (n.* 2 sample_size) (as Nat valueV)) - - _ - false))) - (_.test "Can find index of sub-text." - (and (|> {synthesis.#Extension (symbol .text_index#) - (list concatenatedS sample_lowerS - (synthesis.i64 +0))} - (run (..safe .text_index#)) - (pipe.when - (^.multi {try.#Success valueV} - [(as (Maybe Nat) valueV) - {.#Some valueV}]) - (n.= 0 valueV) - - _ - false)) - (|> {synthesis.#Extension (symbol .text_index#) - (list concatenatedS sample_upperS - (synthesis.i64 +0))} - (run (..safe .text_index#)) - (pipe.when - (^.multi {try.#Success valueV} - [(as (Maybe Nat) valueV) - {.#Some valueV}]) - (n.= sample_size valueV) - - _ - false)))) - (let [test_clip (is (-> (I64 Any) (I64 Any) Text Bit) - (function (_ offset length expected) - (|> {synthesis.#Extension (symbol .text_clip#) - (list concatenatedS - (synthesis.i64 offset) - (synthesis.i64 length))} - (run (..safe .text_clip#)) - (pipe.when - (^.multi {try.#Success valueV} - [(as (Maybe Text) valueV) - {.#Some valueV}]) - (text#= expected valueV) - - _ - false))))] - (_.test "Can clip text to extract sub-text." - (and (test_clip 0 sample_size sample_lower) - (test_clip sample_size sample_size sample_upper)))) - (_.test "Can extract individual characters from text." - (|> {synthesis.#Extension (symbol .text_char#) - (list sample_lowerS - (synthesis.i64 char_idx))} - (run (..safe .text_char#)) - (pipe.when - (^.multi {try.#Success valueV} - [(as (Maybe Int) valueV) - {.#Some valueV}]) - (text.contains? (.int_char# valueV) - sample_lower) - - _ - false))) - ))) - -(def (io run) - (-> Runner Test) - (do r.monad - [message (r.alphabetic 5)] - (all _.and - (_.test "Can log messages." - (|> {synthesis.#Extension .log!# - (list (synthesis.text (format "LOG: " message)))} - (run (..safe .log!#)) - (pipe.when - {try.#Success valueV} - true - - {try.#Failure _} - false))) - (_.test "Can throw runtime errors." - (and (|> {synthesis.#Extension .try# - (list (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity 1 - synthesis.#body {synthesis.#Extension (symbol .error#) - (list (synthesis.text message))}]))} - (run (..safe .try#)) - (pipe.when - (^.multi {try.#Success valueV} - [(as (Try Text) valueV) - {try.#Failure error}]) - (text.contains? message error) - - _ - false)) - (|> {synthesis.#Extension .try# - (list (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity 1 - synthesis.#body (synthesis.text message)]))} - (run (..safe .try#)) - (pipe.when - (^.multi {try.#Success valueV} - [(as (Try Text) valueV) - {try.#Success valueV}]) - (text#= message valueV) - - _ - false)))) - ))) - -(def .public (spec runner) - (-> Runner Test) - (all _.and - (..bit runner) - (..i64 runner) - (..f64 runner) - (..text runner) - (..io runner) - )) diff --git a/stdlib/source/specification/compositor/generation/function.lux b/stdlib/source/specification/compositor/generation/function.lux deleted file mode 100644 index 63b025065..000000000 --- a/stdlib/source/specification/compositor/generation/function.lux +++ /dev/null @@ -1,96 +0,0 @@ -(.require - [library - [lux (.except function) - [abstract - [monad (.only do)] - ["[0]" enum]] - [control - ["[0]" maybe]] - [data - [number - ["n" nat]] - [collection - ["[0]" list (.use "[1]#[0]" functor)]]] - [math - ["r" random (.only Random) (.use "[1]#[0]" monad)]] - [meta - [compiler - [analysis (.only Arity)] - ["[0]" reference (.only Register)] - ["[0]" synthesis (.only Synthesis)]]]] - [test - ["_" property (.only Test)]]] - ["[0]" // - ["[1][0]" case] - [// - [common (.only Runner)]]]) - -(def max_arity - Arity - 10) - -(def arity - (Random Arity) - (|> r.nat (r#each (|>> (n.% max_arity) (n.max 1))))) - -(def (local arity) - (-> Arity (Random Register)) - (|> r.nat (r#each (|>> (n.% arity) ++)))) - -(def function - (Random [Arity Register Synthesis]) - (do r.monad - [arity ..arity - local (..local arity)] - (in [arity local - (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity arity - synthesis.#body (synthesis.variable/local local)])]))) - -(def .public (spec run) - (-> Runner Test) - (do [! r.monad] - [[arity local functionS] ..function - partial_arity (|> r.nat (of ! each (|>> (n.% arity) (n.max 1)))) - inputs (r.list arity r.safe_frac) - .let [expectation (maybe.trusted (list.item (-- local) inputs)) - inputsS (list#each (|>> synthesis.f64) inputs)]] - (all _.and - (_.test "Can read arguments." - (|> (synthesis.function/apply [synthesis.#function functionS - synthesis.#arguments inputsS]) - (run "with_local") - (//case.verify expectation))) - (_.test "Can partially apply functions." - (or (n.= 1 arity) - (let [preS (list.first partial_arity inputsS) - postS (list.after partial_arity inputsS) - partialS (synthesis.function/apply [synthesis.#function functionS - synthesis.#arguments preS])] - (|> (synthesis.function/apply [synthesis.#function partialS - synthesis.#arguments postS]) - (run "partial_application") - (//case.verify expectation))))) - (_.test "Can read environment." - (or (n.= 1 arity) - (let [environment (|> partial_arity - (enum.range n.enum 1) - (list#each (|>> {reference.#Local}))) - variableS (if (n.<= partial_arity local) - (synthesis.variable/foreign (-- local)) - (synthesis.variable/local (|> local (n.- partial_arity)))) - inner_arity (n.- partial_arity arity) - innerS (synthesis.function/abstraction - [synthesis.#environment environment - synthesis.#arity inner_arity - synthesis.#body variableS]) - outerS (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity partial_arity - synthesis.#body innerS])] - (|> (synthesis.function/apply [synthesis.#function outerS - synthesis.#arguments inputsS]) - (run "with_foreign") - (//case.verify expectation))))) - ))) diff --git a/stdlib/source/specification/compositor/generation/primitive.lux b/stdlib/source/specification/compositor/generation/primitive.lux deleted file mode 100644 index 167f219e8..000000000 --- a/stdlib/source/specification/compositor/generation/primitive.lux +++ /dev/null @@ -1,51 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" try]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)] - [number - ["f" frac]] - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]]] - [math - ["r" random]] - [meta - [compiler - ["[0]" synthesis]]] - [test - ["_" property (.only Test)]]]] - [/// - [common (.only Runner)]]) - -(def (f/=' reference subject) - (-> Frac Frac Bit) - (or (f.= reference subject) - (and (f.not_a_number? reference) - (f.not_a_number? subject)))) - -(def .public (spec run) - (-> Runner Test) - (`` (all _.and - (,, (with_template [<evaluation_name> <synthesis> <gen> <test>] - [(do r.monad - [expected <gen>] - (_.test (%.symbol (symbol <synthesis>)) - (|> (run <evaluation_name> (<synthesis> expected)) - (pipe.when - {try.#Success actual} - (<test> expected (as_expected actual)) - - {try.#Failure _} - false))))] - - ["bit" synthesis.bit r.bit bit#=] - ["i64" synthesis.i64 r.i64 .i64_=#] - ["f64" synthesis.f64 r.frac f.='] - ["text" synthesis.text (r.ascii 5) text#=] - )) - ))) diff --git a/stdlib/source/specification/compositor/generation/reference.lux b/stdlib/source/specification/compositor/generation/reference.lux deleted file mode 100644 index 74c556d80..000000000 --- a/stdlib/source/specification/compositor/generation/reference.lux +++ /dev/null @@ -1,64 +0,0 @@ -(.require - [library - [lux (.except symbol) - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" try]] - [data - [number - ["n" nat] - ["f" frac]]] - [meta - [compiler - ["[0]" reference] - ["[0]" synthesis]]] - [math - ["r" random (.only Random)]] - [test - ["_" property (.only Test)]]]] - [/// - [common (.only Runner Definer)]]) - -(def symbol - (Random Symbol) - (let [symbol_part (r.upper_case_alpha 5)] - [(r.and symbol_part symbol_part)])) - -(def (definition define) - (-> Definer Test) - (do r.monad - [name ..symbol - expected r.safe_frac] - (_.test "Definitions." - (|> (define name (synthesis.f64 expected)) - (pipe.when - {try.#Success actual} - (f.= expected (as Frac actual)) - - {try.#Failure _} - false))))) - -(def (variable run) - (-> Runner Test) - (do [! r.monad] - [register (|> r.nat (of ! each (n.% 100))) - expected r.safe_frac] - (_.test "Local variables." - (|> (synthesis.branch/let [(synthesis.f64 expected) - register - (synthesis.variable/local register)]) - (run "variable") - (pipe.when - {try.#Success actual} - (f.= expected (as Frac actual)) - - {try.#Failure _} - false))))) - -(def .public (spec runner definer) - (-> Runner Definer Test) - (all _.and - (..definition definer) - (..variable runner))) diff --git a/stdlib/source/specification/compositor/generation/structure.lux b/stdlib/source/specification/compositor/generation/structure.lux deleted file mode 100644 index b28648520..000000000 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ /dev/null @@ -1,93 +0,0 @@ -(.require - [library - [lux (.except) - ["[0]" ffi (.only import)] - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" maybe] - ["[0]" try]] - [data - [number - ["n" nat] - ["i" int]] - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]] - [collection - ["[0]" array (.only Array)] - ["[0]" list (.use "[1]#[0]" functor)]]] - [math - ["r" random]] - [meta - [compiler - ["[0]" analysis] - ["[0]" synthesis]]] - [test - ["_" property (.only Test)]]]] - [/// - [common (.only Runner)]]) - -(import java/lang/Integer) - -(def (variant run) - (-> Runner Test) - (do [! r.monad] - [num_tags (|> r.nat (of ! each (|>> (n.% 10) (n.max 2)))) - tag_in (|> r.nat (of ! each (n.% num_tags))) - .let [last?_in (|> num_tags -- (n.= tag_in))] - value_in r.i64] - (_.test (%.symbol (symbol synthesis.variant)) - (|> (synthesis.variant [analysis.#lefts (if last?_in - (-- tag_in) - tag_in) - analysis.#right? last?_in - analysis.#value (synthesis.i64 value_in)]) - (run "variant") - (pipe.when - {try.#Success valueT} - (let [valueT (as (Array Any) valueT)] - (and (n.= 3 (array.size valueT)) - (let [tag_out (as java/lang/Integer (maybe.trusted (array.read! 0 valueT))) - last?_out (array.read! 1 valueT) - value_out (as Any (maybe.trusted (array.read! 2 valueT))) - same_tag? (|> tag_out ffi.int_to_long (as Nat) (n.= tag_in)) - same_flag? (when last?_out - {.#Some last?_out'} - (and last?_in (text#= "" (as Text last?_out'))) - - {.#None} - (not last?_in)) - same_value? (|> value_out (as Int) (i.= value_in))] - (and same_tag? - same_flag? - same_value?)))) - - {try.#Failure _} - false))))) - -(def (tuple run) - (-> Runner Test) - (do [! r.monad] - [size (|> r.nat (of ! each (|>> (n.% 10) (n.max 2)))) - tuple_in (r.list size r.i64)] - (_.test (%.symbol (symbol synthesis.tuple)) - (|> (synthesis.tuple (list#each (|>> synthesis.i64) tuple_in)) - (run "tuple") - (pipe.when - {try.#Success tuple_out} - (let [tuple_out (as (Array Any) tuple_out)] - (and (n.= size (array.size tuple_out)) - (list.every? (function (_ [left right]) - (i.= left (as Int right))) - (list.zipped_2 tuple_in (array.list tuple_out))))) - - {try.#Failure _} - false))))) - -(def .public (spec runner) - (-> Runner Test) - (all _.and - (..variant runner) - (..tuple runner) - )) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 8b859955e..c9ce5c95e 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -59,5 +59,5 @@ (program args (<| io.io _.run! - (_.times 100) + (_.times 100 _.announce_success) ..test))) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 7e0d2c1cb..373393f2e 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -35,7 +35,8 @@ (all random.and (random.lower_cased size) (random.lower_cased size) - (random.lower_cased size)))) + (random.lower_cased size) + ))) (def .public test Test @@ -43,7 +44,9 @@ (do random.monad [sample ..random]) (_.for [/.Group /.Name /.Version - /.Artifact] + + /.Artifact + /.#group /.#name /.#version] (all _.and (_.for [/.equivalence] (equivalenceT.spec /.equivalence ..random)) diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux index 3e7350050..9db5b07b5 100644 --- a/stdlib/source/test/aedifex/dependency/deployment.lux +++ b/stdlib/source/test/aedifex/dependency/deployment.lux @@ -26,11 +26,12 @@ ["n" nat]]] [world [net (.only URL) - ["[0]" uri (.only URI)] - ["[0]" http - ["[1]" client] - ["[1]/[0]" status] - ["@[1]" /]]]] + [uri (.only URI) + ["[0]" path]] + ["[0]" http (.only) + [response (.only Response)] + ["[0]" client (.only Client)] + ["[0]" status]]]] [test ["[0]" unit] ["_" property (.only Test)]]]] @@ -52,25 +53,25 @@ ["[0]" remote]]]]]]) (def good_upload - (@http.Response IO) - [http/status.created - [@http.#headers (http.headers (list)) - @http.#body (function (_ _) - (|> [0 (binary.empty 0)] - {try.#Success} - io.io))]]) + (Response IO) + [status.created + [http.#headers (client.headers (list)) + http.#body (function (_ _) + (|> [0 (binary.empty 0)] + {try.#Success} + io.io))]]) (type Cache (Atom (Dictionary URL Binary))) (def (http cache) - (-> Cache (http.Client IO)) + (-> Cache (Client IO)) (implementation (def (request method url headers input) (do io.monad [_ (is (IO Any) (when [method input] - [{@http.#Put} {.#Some input}] + [{http.#Put} {.#Some input}] (atom.update! (dictionary.has url input) cache) _ @@ -149,7 +150,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [address (of ! each (text.suffix uri.separator) + [address (of ! each (text.suffix path.separator) (random.upper_cased 10))] (all _.and (do [! random.monad] diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index f61f1ec50..6b4f02130 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -7,11 +7,14 @@ ["[0]" monad (.only do)]] [control ["[0]" io] - ["[0]" try] - ["[0]" exception (.only Exception)]] + ["[0]" try (.only Try)] + ["[0]" exception (.only Exception)] + [concurrency + ["[0]" async (.only Async)]]] [data ["[0]" product] - ["[0]" binary (.only Binary)] + ["[0]" binary (.only Binary) + ["_[1]" \\test]] ["[0]" text (.only) ["%" \\format (.only format)]] [collection @@ -22,7 +25,8 @@ [net ["[0]" uri (.only URI)]]] [test - ["_" property (.only Test)]]]] + ["_" property (.only Test)] + ["[0]" unit]]]] ["[0]" / ["[1][0]" identity] ["[1][0]" origin] @@ -30,8 +34,6 @@ ["[1][0]" remote] [// ["@[0]" artifact]]] - [\\specification - ["$[0]" /]] [\\program ["[0]" / (.only) ["[0]" remote] @@ -39,6 +41,40 @@ ["[1][0]" artifact (.only Version Artifact) ["[1]/[0]" extension (.only Extension)]]]]]) +(def .public (spec valid_artifact invalid_artifact subject) + (-> Artifact Artifact (/.Repository Async) + Test) + (do random.monad + [expected (_binary.random 100)] + (in (all unit.and + (do async.monad + [.let [good_uri (remote.uri (the //artifact.#version valid_artifact) valid_artifact //artifact/extension.lux_library)] + good_upload! (of subject upload good_uri expected) + good_download! (of subject download good_uri) + + .let [bad_uri (remote.uri (the //artifact.#version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] + bad_upload! (of subject upload bad_uri expected) + bad_download! (of subject download bad_uri)] + (unit.coverage [/.Repository] + (let [successfull_flow! + (when [good_upload! good_download!] + [{try.#Success _} {try.#Success actual}] + (of binary.equivalence = expected actual) + + _ + false) + + failed_flow! + (when [bad_upload! bad_download!] + [{try.#Failure _} {try.#Failure _}] + true + + _ + false)] + (and successfull_flow! + failed_flow!)))) + )))) + (def artifact (-> Version Artifact) (|>> ["com.github.luxlang" "test-artifact"])) @@ -94,14 +130,14 @@ (_.for [/.mock /.Mock] (do random.monad [_ (in [])] - ($/.spec (..artifact ..valid_version) - (..artifact ..invalid_version) - (/.mock ..mock - (|> ..empty - (dictionary.has (remote.uri ..invalid_version - (..artifact ..invalid_version) - //artifact/extension.lux_library) - (binary.empty 0))))))) + (..spec (..artifact ..valid_version) + (..artifact ..invalid_version) + (/.mock ..mock + (|> ..empty + (dictionary.has (remote.uri ..invalid_version + (..artifact ..invalid_version) + //artifact/extension.lux_library) + (binary.empty 0))))))) /identity.test /origin.test diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux index ce1def236..922290058 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux @@ -29,7 +29,8 @@ ["[1][0]" translation ["[1]/[0]" jvm ["[1]/[0]" host] - ["[1]/[0]" primitive]]]]) + ["[1]/[0]" primitive] + ["[1]/[0]" type]]]]) (def (injection value) (All (_ of) @@ -215,4 +216,5 @@ /translation/jvm/host.test /translation/jvm/primitive.test + /translation/jvm/type.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux new file mode 100644 index 000000000..e99233eca --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/type.lux @@ -0,0 +1,45 @@ +(.require + [library + [lux (.except Type) + [abstract + [monad (.only do)]] + [math + ["[0]" random (.only Random)]] + [meta + [target + [jvm + ["[0]" type (.only Type) (.use "[1]#[0]" equivalence) + [category (.only Primitive Array Class)]]]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (all _.and + (_.coverage [/.frac /.text] + (not (type#= /.frac /.text))) + (_.coverage [/.value /.error] + (not (type#= /.value /.error))) + (_.coverage [/.lefts] + (exec + (is (Type Primitive) + /.lefts) + true)) + (_.coverage [/.right?] + (exec + (is (Type Class) + /.right?) + true)) + (_.coverage [/.variant /.tuple] + (type#= /.variant /.tuple)) + (_.coverage [/.stack] + (exec + (is (Type Array) + /.stack) + true)) + ))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/archive/artifact.lux b/stdlib/source/test/lux/meta/compiler/meta/archive/artifact.lux index b233a404b..7d5bba9e1 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/archive/artifact.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/archive/artifact.lux @@ -24,7 +24,10 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Artifact /.ID]) + (_.for [/.ID + + /.Artifact + /.#id /.#category /.#mandatory?]) (all _.and (_.for [/.equivalence] (equivalenceT.spec /.equivalence ..random)) |