diff options
Diffstat (limited to 'stdlib/source/specification/compositor/generation')
6 files changed, 472 insertions, 472 deletions
diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index 80faa246f..12fa81a14 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -50,52 +50,52 @@ (def: case (Random [Synthesis Path]) (<| r.rec (function (_ case)) - (`` ($_ r.either - (do r.monad - [value r.i64] - (in [(synthesis.i64 value) - synthesis.path/pop])) - (~~ (template [<gen> <synth> <path>] - [(do r.monad - [value <gen>] - (in [(<synth> value) - (<path> value)]))] + (`` (all r.either + (do r.monad + [value r.i64] + (in [(synthesis.i64 value) + synthesis.path/pop])) + (~~ (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 (# ! each (n.% size))) - [subS subP] case - .let [unitS (synthesis.text synthesis.unit) - caseS (synthesis.tuple - (list.together (list (list.repeated idx unitS) - (list subS) - (list.repeated (|> size -- (n.- idx)) unitS)))) - caseP ($_ synthesis.path/seq - (if (tail? size idx) - (synthesis.member/right idx) - (synthesis.member/left idx)) - subP)]] - (in [caseS caseP])) - (do [! r.monad] - [size ..size - idx (|> r.nat (# ! each (n.% size))) - [subS subP] case - .let [right? (tail? size idx) - caseS (synthesis.variant - [analysis.#lefts idx - analysis.#right? right? - analysis.#value subS]) - caseP ($_ synthesis.path/seq - (if right? - (synthesis.side/right idx) - (synthesis.side/left idx)) - subP)]] - (in [caseS caseP])) - )))) + [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 (# ! each (n.% size))) + [subS subP] case + .let [unitS (synthesis.text synthesis.unit) + caseS (synthesis.tuple + (list.together (list (list.repeated idx unitS) + (list subS) + (list.repeated (|> size -- (n.- idx)) unitS)))) + caseP (all synthesis.path/seq + (if (tail? size idx) + (synthesis.member/right idx) + (synthesis.member/left idx)) + subP)]] + (in [caseS caseP])) + (do [! r.monad] + [size ..size + idx (|> r.nat (# ! each (n.% size))) + [subS subP] case + .let [right? (tail? size idx) + caseS (synthesis.variant + [analysis.#lefts idx + analysis.#right? right? + analysis.#value subS]) + caseP (all synthesis.path/seq + (if right? + (synthesis.side/right idx) + (synthesis.side/left idx)) + subP)]] + (in [caseS caseP])) + )))) (def: (let_spec run) (-> Runner Test) @@ -130,11 +130,11 @@ (_.test (%.symbol (symbol synthesis.branch/case)) (|> (synthesis.branch/case [inputS - ($_ synthesis.path/alt - ($_ synthesis.path/seq - pathS - (synthesis.path/then (synthesis.f64 on_success))) - (synthesis.path/then (synthesis.f64 on_failure)))]) + (all synthesis.path/alt + (all synthesis.path/seq + pathS + (synthesis.path/then (synthesis.f64 on_success))) + (synthesis.path/then (synthesis.f64 on_failure)))]) (run "case_spec") (verify on_success))))) @@ -189,24 +189,24 @@ _head_ (synthesis.path/member {.#Left 0}) _tail_ (synthesis.path/member {.#Right 0}) _tuple_ (synthesis.path/side {.#Left 9})] - ($_ synthesis.path/alt - ($_ 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))) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ... THEN - (synthesis.path/then (synthesis.bit #0)))))) + (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 @@ -227,62 +227,62 @@ (def: special_pattern_path Path - ($_ synthesis.path/alt - (<| try.trusted - (phase.result [extension/synthesis.bundle - synthesis.init]) - (case.path phase/synthesis.phase - special_pattern) - (analysis.bit #1)) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ... THEN - (synthesis.path/then (synthesis.bit #0))))) + (all synthesis.path/alt + (<| try.trusted + (phase.result [extension/synthesis.bundle + synthesis.init]) + (case.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) - ($_ _.and - (_.test "===" - (and (text#= (synthesis.%path special_path) - (synthesis.%path special_pattern_path)) - (# synthesis.path_equivalence = special_path special_pattern_path))) - (_.test "CODE" - (|> special_input - (run "special_input") - (pipe.case - {try.#Success output} - true - - {try.#Failure _} - false))) - (_.test "PATTERN_MATCHING 0" - (|> (synthesis.branch/case [special_input - special_path]) - (run "special_path") - (pipe.case - {try.#Success output} - true - - {try.#Failure _} - false))) - (_.test "PATTERN_MATCHING 1" - (|> (synthesis.branch/case [special_input - special_pattern_path]) - (run "special_pattern_path") - (pipe.case - {try.#Success output} - true - - {try.#Failure _} - false))) - )) + (all _.and + (_.test "===" + (and (text#= (synthesis.%path special_path) + (synthesis.%path special_pattern_path)) + (# synthesis.path_equivalence = special_path special_pattern_path))) + (_.test "CODE" + (|> special_input + (run "special_input") + (pipe.case + {try.#Success output} + true + + {try.#Failure _} + false))) + (_.test "PATTERN_MATCHING 0" + (|> (synthesis.branch/case [special_input + special_path]) + (run "special_path") + (pipe.case + {try.#Success output} + true + + {try.#Failure _} + false))) + (_.test "PATTERN_MATCHING 1" + (|> (synthesis.branch/case [special_input + special_pattern_path]) + (run "special_pattern_path") + (pipe.case + {try.#Success output} + true + + {try.#Failure _} + false))) + )) (def: .public (spec run) (-> Runner Test) - ($_ _.and - (..special_spec run) - (..let_spec run) - (..if_spec run) - (..case_spec run) - )) + (all _.and + (..special_spec run) + (..let_spec run) + (..if_spec run) + (..case_spec run) + )) diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux index dc2bf6ec7..599dae209 100644 --- a/stdlib/source/specification/compositor/generation/common.lux +++ b/stdlib/source/specification/compositor/generation/common.lux @@ -58,69 +58,69 @@ ["lux i64 left-shift" i64.left_shifted (n.% 64 param)] ["lux i64 logical-right-shift" i64.logic_right_shifted (n.% 64 param)] )] - ($_ _.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.case - {try.#Success valueT} - ("lux i64 =" - (i64.arithmetic_right_shifted param subject) - (as I64 valueT)) - - {try.#Failure _} - false) - (let [param (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.case + {try.#Success valueT} + ("lux 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 (|>> ("lux i64 =" 0) not))) subject r.i64] - (`` ($_ _.and - (~~ (template [<extension> <type> <prepare> <comp> <subject_expr>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.case - {try.#Success valueT} - (<comp> (<prepare> subject) (as <type> valueT)) - - {try.#Failure _} - false) - (let [subject <subject_expr>])))] - - ["lux i64 f64" Frac i.frac f.= subject] - ["lux i64 char" Text (|>> (as Nat) text.from_code) text#= (|> subject - (as Nat) - (n.% (i64.left_shifted 8 1)) - (as Int))] - )) - (~~ (template [<extension> <reference> <outputT> <comp>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.i64 param) - (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.case - {try.#Success valueT} - (<comp> (<reference> param subject) (as <outputT> valueT)) - - {try.#Failure _} - false)))] - - ["lux i64 +" i.+ Int i.=] - ["lux i64 -" i.- Int i.=] - ["lux i64 *" i.* Int i.=] - ["lux i64 /" i./ Int i.=] - ["lux i64 %" i.% Int i.=] - ["lux i64 =" i.= Bit bit#=] - ["lux i64 <" i.< Bit bit#=] - )) - )))) + (`` (all _.and + (~~ (template [<extension> <type> <prepare> <comp> <subject_expr>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.i64 subject))} + (run (..safe <extension>)) + (pipe.case + {try.#Success valueT} + (<comp> (<prepare> subject) (as <type> valueT)) + + {try.#Failure _} + false) + (let [subject <subject_expr>])))] + + ["lux i64 f64" Frac i.frac f.= subject] + ["lux i64 char" Text (|>> (as Nat) text.from_code) text#= (|> subject + (as Nat) + (n.% (i64.left_shifted 8 1)) + (as Int))] + )) + (~~ (template [<extension> <reference> <outputT> <comp>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.i64 param) + (synthesis.i64 subject))} + (run (..safe <extension>)) + (pipe.case + {try.#Success valueT} + (<comp> (<reference> param subject) (as <outputT> valueT)) + + {try.#Failure _} + false)))] + + ["lux i64 +" i.+ Int i.=] + ["lux i64 -" i.- Int i.=] + ["lux i64 *" i.* Int i.=] + ["lux i64 /" i./ Int i.=] + ["lux i64 %" i.% Int i.=] + ["lux i64 =" i.= Bit bit#=] + ["lux i64 <" i.< Bit bit#=] + )) + )))) (def: simple_frac (Random Frac) @@ -131,53 +131,53 @@ (do r.monad [param (|> ..simple_frac (r.only (|>> (f.= +0.0) not))) subject ..simple_frac] - (`` ($_ _.and - (~~ (template [<extension> <reference> <comp>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) - (synthesis.f64 subject))} - (run (..safe <extension>)) - (//case.verify (<reference> param subject))))] - - ["lux f64 +" f.+ f.=] - ["lux f64 -" f.- f.=] - ["lux f64 *" f.* f.=] - ["lux f64 /" f./ f.=] - ["lux f64 %" f.% f.=] - )) - (~~ (template [<extension> <text>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) - (synthesis.f64 subject))} - (run (..safe <extension>)) - (pipe.case - {try.#Success valueV} - (bit#= (<text> param subject) - (as Bit valueV)) - - _ - false)))] - - ["lux f64 =" f.=] - ["lux f64 <" f.<] - )) - (~~ (template [<extension> <reference>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list)} - (run (..safe <extension>)) - (//case.verify <reference>)))] - - ["lux f64 min" ("lux f64 min")] - ["lux f64 max" ("lux f64 max")] - ["lux f64 smallest" ("lux f64 smallest")] - )) - (_.test "'lux f64 i64 && 'lux i64 f64'" - (|> (run (..safe "lux f64 i64") - (|> subject synthesis.f64 - (list) {synthesis.#Extension "lux f64 i64"} - (list) {synthesis.#Extension "lux i64 f64"})) - (//case.verify subject))) - )))) + (`` (all _.and + (~~ (template [<extension> <reference> <comp>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) + (synthesis.f64 subject))} + (run (..safe <extension>)) + (//case.verify (<reference> param subject))))] + + ["lux f64 +" f.+ f.=] + ["lux f64 -" f.- f.=] + ["lux f64 *" f.* f.=] + ["lux f64 /" f./ f.=] + ["lux f64 %" f.% f.=] + )) + (~~ (template [<extension> <text>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) + (synthesis.f64 subject))} + (run (..safe <extension>)) + (pipe.case + {try.#Success valueV} + (bit#= (<text> param subject) + (as Bit valueV)) + + _ + false)))] + + ["lux f64 =" f.=] + ["lux f64 <" f.<] + )) + (~~ (template [<extension> <reference>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list)} + (run (..safe <extension>)) + (//case.verify <reference>)))] + + ["lux f64 min" ("lux f64 min")] + ["lux f64 max" ("lux f64 max")] + ["lux f64 smallest" ("lux f64 smallest")] + )) + (_.test "'lux f64 i64 && 'lux i64 f64'" + (|> (run (..safe "lux f64 i64") + (|> subject synthesis.f64 + (list) {synthesis.#Extension "lux f64 i64"} + (list) {synthesis.#Extension "lux i64 f64"})) + (//case.verify subject))) + )))) (def: (text run) (-> Runner Test) @@ -196,174 +196,174 @@ 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))]] - ($_ _.and - (_.test "Can compare texts for equality." - (and (|> {synthesis.#Extension "lux text =" (list sample_lowerS sample_lowerS)} - (run (..safe "lux text =")) - (pipe.case - {try.#Success valueV} - (as Bit valueV) - - _ - false)) - (|> {synthesis.#Extension "lux text =" (list sample_upperS sample_lowerS)} - (run (..safe "lux text =")) - (pipe.case - {try.#Success valueV} - (not (as Bit valueV)) - - _ - false)))) - (_.test "Can compare texts for order." - (|> {synthesis.#Extension "lux text <" (list sample_lowerS sample_upperS)} - (run (..safe "lux text <")) - (pipe.case - {try.#Success valueV} - (as Bit valueV) - - {try.#Failure _} - false))) - (_.test "Can get length of text." - (|> {synthesis.#Extension "lux text size" (list sample_lowerS)} - (run (..safe "lux text size")) - (pipe.case - {try.#Success valueV} - (n.= sample_size (as Nat valueV)) - - _ - false))) - (_.test "Can concatenate text." - (|> {synthesis.#Extension "lux text size" (list concatenatedS)} - (run (..safe "lux text size")) - (pipe.case - {try.#Success valueV} - (n.= (n.* 2 sample_size) (as Nat valueV)) - - _ - false))) - (_.test "Can find index of sub-text." - (and (|> {synthesis.#Extension "lux text index" - (list concatenatedS sample_lowerS - (synthesis.i64 +0))} - (run (..safe "lux text index")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Maybe Nat) valueV) - {.#Some valueV}]) - (n.= 0 valueV) - - _ - false)) - (|> {synthesis.#Extension "lux text index" - (list concatenatedS sample_upperS - (synthesis.i64 +0))} - (run (..safe "lux text index")) - (pipe.case - (^.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 "lux text clip" - (list concatenatedS - (synthesis.i64 offset) - (synthesis.i64 length))} - (run (..safe "lux text clip")) - (pipe.case - (^.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 "lux text char" - (list sample_lowerS - (synthesis.i64 char_idx))} - (run (..safe "lux text char")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Maybe Int) valueV) - {.#Some valueV}]) - (text.contains? ("lux i64 char" valueV) - sample_lower) - - _ - false))) - ))) + (all _.and + (_.test "Can compare texts for equality." + (and (|> {synthesis.#Extension "lux text =" (list sample_lowerS sample_lowerS)} + (run (..safe "lux text =")) + (pipe.case + {try.#Success valueV} + (as Bit valueV) + + _ + false)) + (|> {synthesis.#Extension "lux text =" (list sample_upperS sample_lowerS)} + (run (..safe "lux text =")) + (pipe.case + {try.#Success valueV} + (not (as Bit valueV)) + + _ + false)))) + (_.test "Can compare texts for order." + (|> {synthesis.#Extension "lux text <" (list sample_lowerS sample_upperS)} + (run (..safe "lux text <")) + (pipe.case + {try.#Success valueV} + (as Bit valueV) + + {try.#Failure _} + false))) + (_.test "Can get length of text." + (|> {synthesis.#Extension "lux text size" (list sample_lowerS)} + (run (..safe "lux text size")) + (pipe.case + {try.#Success valueV} + (n.= sample_size (as Nat valueV)) + + _ + false))) + (_.test "Can concatenate text." + (|> {synthesis.#Extension "lux text size" (list concatenatedS)} + (run (..safe "lux text size")) + (pipe.case + {try.#Success valueV} + (n.= (n.* 2 sample_size) (as Nat valueV)) + + _ + false))) + (_.test "Can find index of sub-text." + (and (|> {synthesis.#Extension "lux text index" + (list concatenatedS sample_lowerS + (synthesis.i64 +0))} + (run (..safe "lux text index")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Maybe Nat) valueV) + {.#Some valueV}]) + (n.= 0 valueV) + + _ + false)) + (|> {synthesis.#Extension "lux text index" + (list concatenatedS sample_upperS + (synthesis.i64 +0))} + (run (..safe "lux text index")) + (pipe.case + (^.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 "lux text clip" + (list concatenatedS + (synthesis.i64 offset) + (synthesis.i64 length))} + (run (..safe "lux text clip")) + (pipe.case + (^.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 "lux text char" + (list sample_lowerS + (synthesis.i64 char_idx))} + (run (..safe "lux text char")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Maybe Int) valueV) + {.#Some valueV}]) + (text.contains? ("lux i64 char" valueV) + sample_lower) + + _ + false))) + ))) (def: (io run) (-> Runner Test) (do r.monad [message (r.ascii/alpha 5)] - ($_ _.and - (_.test "Can log messages." - (|> {synthesis.#Extension "lux io log" - (list (synthesis.text (format "LOG: " message)))} - (run (..safe "lux io log")) - (pipe.case - {try.#Success valueV} - true - - {try.#Failure _} - false))) - (_.test "Can throw runtime errors." - (and (|> {synthesis.#Extension "lux try" - (list (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity 1 - synthesis.#body {synthesis.#Extension "lux io error" - (list (synthesis.text message))}]))} - (run (..safe "lux try")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Try Text) valueV) - {try.#Failure error}]) - (text.contains? message error) - - _ - false)) - (|> {synthesis.#Extension "lux try" - (list (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity 1 - synthesis.#body (synthesis.text message)]))} - (run (..safe "lux try")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Try Text) valueV) - {try.#Success valueV}]) - (text#= message valueV) - - _ - false)))) - (_.test "Can obtain current time in milli-seconds." - (|> (synthesis.tuple (list {synthesis.#Extension "lux io current-time" (list)} - {synthesis.#Extension "lux io current-time" (list)})) - (run (..safe "lux io current-time")) - (pipe.case - {try.#Success valueV} - (let [[pre post] (as [Nat Nat] valueV)] - (n.>= pre post)) - - {try.#Failure _} - false))) - ))) + (all _.and + (_.test "Can log messages." + (|> {synthesis.#Extension "lux io log" + (list (synthesis.text (format "LOG: " message)))} + (run (..safe "lux io log")) + (pipe.case + {try.#Success valueV} + true + + {try.#Failure _} + false))) + (_.test "Can throw runtime errors." + (and (|> {synthesis.#Extension "lux try" + (list (synthesis.function/abstraction + [synthesis.#environment (list) + synthesis.#arity 1 + synthesis.#body {synthesis.#Extension "lux io error" + (list (synthesis.text message))}]))} + (run (..safe "lux try")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Try Text) valueV) + {try.#Failure error}]) + (text.contains? message error) + + _ + false)) + (|> {synthesis.#Extension "lux try" + (list (synthesis.function/abstraction + [synthesis.#environment (list) + synthesis.#arity 1 + synthesis.#body (synthesis.text message)]))} + (run (..safe "lux try")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Try Text) valueV) + {try.#Success valueV}]) + (text#= message valueV) + + _ + false)))) + (_.test "Can obtain current time in milli-seconds." + (|> (synthesis.tuple (list {synthesis.#Extension "lux io current-time" (list)} + {synthesis.#Extension "lux io current-time" (list)})) + (run (..safe "lux io current-time")) + (pipe.case + {try.#Success valueV} + (let [[pre post] (as [Nat Nat] valueV)] + (n.>= pre post)) + + {try.#Failure _} + false))) + ))) (def: .public (spec runner) (-> Runner Test) - ($_ _.and - (..bit runner) - (..i64 runner) - (..f64 runner) - (..text runner) - (..io runner) - )) + (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 index e6bdf79c0..6cc0d14b5 100644 --- a/stdlib/source/specification/compositor/generation/function.lux +++ b/stdlib/source/specification/compositor/generation/function.lux @@ -1,27 +1,27 @@ (.using - [lux {"-" function} - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - ["[0]" enum]] - [control - ["[0]" maybe]] - [data - [number - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [math - ["r" random {"+" Random} ("[1]#[0]" monad)]] - [tool - [compiler - [analysis {"+" Arity}] - ["[0]" reference {"+" Register}] - ["[0]" synthesis {"+" Synthesis}]]]] - ["[0]" // "_" - ["[1][0]" case] - [// - [common {"+" Runner}]]]) + [lux {"-" function} + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + ["[0]" enum]] + [control + ["[0]" maybe]] + [data + [number + ["n" nat]] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + ["r" random {"+" Random} ("[1]#[0]" monad)]] + [tool + [compiler + [analysis {"+" Arity}] + ["[0]" reference {"+" Register}] + ["[0]" synthesis {"+" Synthesis}]]]] + ["[0]" // "_" + ["[1][0]" case] + [// + [common {"+" Runner}]]]) (def: max_arity Arity @@ -54,41 +54,41 @@ inputs (r.list arity r.safe_frac) .let [expectation (maybe.trusted (list.item (-- local) inputs)) inputsS (list#each (|>> synthesis.f64) inputs)]] - ($_ _.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))))) - ))) + (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 index db50dc185..46ba10d00 100644 --- a/stdlib/source/specification/compositor/generation/primitive.lux +++ b/stdlib/source/specification/compositor/generation/primitive.lux @@ -28,22 +28,22 @@ (def: .public (spec run) (-> Runner Test) - (`` ($_ _.and - (~~ (template [<evaluation_name> <synthesis> <gen> <test>] - [(do r.monad - [expected <gen>] - (_.test (%.symbol (symbol <synthesis>)) - (|> (run <evaluation_name> (<synthesis> expected)) - (pipe.case - {try.#Success actual} - (<test> expected (as_expected actual)) + (`` (all _.and + (~~ (template [<evaluation_name> <synthesis> <gen> <test>] + [(do r.monad + [expected <gen>] + (_.test (%.symbol (symbol <synthesis>)) + (|> (run <evaluation_name> (<synthesis> expected)) + (pipe.case + {try.#Success actual} + (<test> expected (as_expected actual)) - {try.#Failure _} - false))))] + {try.#Failure _} + false))))] - ["bit" synthesis.bit r.bit bit#=] - ["i64" synthesis.i64 r.i64 "lux i64 ="] - ["f64" synthesis.f64 r.frac f.='] - ["text" synthesis.text (r.ascii 5) text#=] - )) - ))) + ["bit" synthesis.bit r.bit bit#=] + ["i64" synthesis.i64 r.i64 "lux 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 index 687c3ef88..f9d5e3ec9 100644 --- a/stdlib/source/specification/compositor/generation/reference.lux +++ b/stdlib/source/specification/compositor/generation/reference.lux @@ -57,6 +57,6 @@ (def: .public (spec runner definer) (-> Runner Definer Test) - ($_ _.and - (..definition definer) - (..variable runner))) + (all _.and + (..definition definer) + (..variable runner))) diff --git a/stdlib/source/specification/compositor/generation/structure.lux b/stdlib/source/specification/compositor/generation/structure.lux index b7cf6423d..4423a85bf 100644 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ b/stdlib/source/specification/compositor/generation/structure.lux @@ -85,7 +85,7 @@ (def: .public (spec runner) (-> Runner Test) - ($_ _.and - (..variant runner) - (..tuple runner) - )) + (all _.and + (..variant runner) + (..tuple runner) + )) |