diff options
Diffstat (limited to 'stdlib/source/spec')
27 files changed, 0 insertions, 2243 deletions
diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux deleted file mode 100644 index de9a05fde..000000000 --- a/stdlib/source/spec/aedifex/repository.lux +++ /dev/null @@ -1,57 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." try (#+ Try)] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." binary - ["_#" \\test]]] - [math - ["." random]]]] - [\\program - ["." / - ["#." remote] - ["/#" // #_ - ["#." artifact (#+ Artifact) - ["#/." extension]]]]] - [\\test - ["_." // #_ - ["#." artifact]]]) - -(def: #export (spec valid_artifact invalid_artifact subject) - (-> Artifact Artifact (/.Repository Promise) Test) - (do random.monad - [expected (_binary.random 100)] - (wrap ($_ _.and' - (do promise.monad - [#let [good_uri (/remote.uri (get@ #//artifact.version valid_artifact) valid_artifact //artifact/extension.lux_library)] - good_upload! (\ subject upload good_uri expected) - good_download! (\ subject download good_uri) - - #let [bad_uri (/remote.uri (get@ #//artifact.version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] - bad_upload! (\ subject upload bad_uri expected) - bad_download! (\ subject download bad_uri)] - (_.cover' [/.Repository] - (let [successfull_flow! - (case [good_upload! good_download!] - [(#try.Success _) (#try.Success actual)] - (\ binary.equivalence = expected actual) - - _ - false) - - failed_flow! - (case [bad_upload! bad_download!] - [(#try.Failure _) (#try.Failure _)] - true - - _ - false)] - (and successfull_flow! - failed_flow!)))) - )))) diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux deleted file mode 100644 index 08a294282..000000000 --- a/stdlib/source/spec/compositor.lux +++ /dev/null @@ -1,67 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." io (#+ IO)] - ["." try]] - [math - ["r" random]] - [tool - [compiler - ["." analysis] - ["." directive] - [phase - [macro (#+ Expander)] - [generation (#+ Bundle)]] - [default - [platform (#+ Platform)]]]]] - ["." / #_ - ["#." common (#+ Runner Definer)] - ["#./" analysis #_ - ["#." type]] - ["#./" generation #_ - ["#." primitive] - ["#." structure] - ["#." reference] - ["#." case] - ["#." function] - ["#." common]]]) - -(def: (test runner definer state expander) - (-> Runner Definer analysis.State+ Expander Test) - ($_ _.and - (/analysis/type.spec expander state) - (/generation/primitive.spec runner) - (/generation/structure.spec runner) - (/generation/reference.spec runner definer) - (/generation/case.spec runner) - (/generation/function.spec runner) - (/generation/common.spec runner) - )) - -(def: #export (spec platform bundle expander program) - (All [anchor expression directive] - (-> (IO (Platform IO anchor expression directive)) - (Bundle anchor expression directive) - Expander - (-> expression directive) - Test)) - (do r.monad - [_ (wrap []) - #let [?state,runner,definer (<| io.run - (do io.monad - [platform platform]) - (/common.executors platform - bundle - expander - program))]] - (case ?state,runner,definer - (#try.Success [[directive-bundle directive-state] runner definer]) - (..test runner definer - (get@ [#directive.analysis #directive.state] directive-state) - expander) - - (#try.Failure error) - (_.fail error)))) diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux deleted file mode 100644 index 7cbd5884b..000000000 --- a/stdlib/source/spec/compositor/analysis/type.lux +++ /dev/null @@ -1,63 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ case>)] - ["." io] - ["." try]] - [math - ["r" random (#+ Random)]] - [macro - ["." code]] - [tool - [compiler - [analysis (#+ State+)] - ["." phase - [macro (#+ Expander)] - ["." analysis - ["#/." scope] - ["#/." type]]]]]]) - -(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.run state) - (case> (#try.Success _) - true - - (#try.Failure _) - false))) - -(def: check - (Random [Code Type Code]) - (`` ($_ r.either - (~~ (template [<random> <type> <code>] - [(do r.monad - [value <random>] - (wrap [(` <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.ascii/upper-alpha 5) (0 #0 "#Text" (0 #0)) code.text] - ))))) - -(def: #export (spec expander state) - (-> Expander State+ Test) - (do r.monad - [[typeC exprT exprC] ..check - [other-typeC other-exprT other-exprC] ..check] - ($_ _.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/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux deleted file mode 100644 index ed3b53f30..000000000 --- a/stdlib/source/spec/compositor/common.lux +++ /dev/null @@ -1,81 +0,0 @@ -(.module: - [lux #* - [abstract - [monad (#+ do)]] - [control - ["." io (#+ IO)] - ["." try (#+ Try)]] - [tool - [compiler - ["." reference] - ["." analysis] - ["." synthesis (#+ Synthesis)] - ["." directive] - ["." phase - ["." macro (#+ Expander)] - ["." generation (#+ Operation)] - [extension (#+ Extender) - ["." bundle]]] - [default - ["." platform (#+ Platform)]]]]]) - -(type: #export Runner - (-> Text Synthesis (Try Any))) - -(type: #export Definer - (-> Name Synthesis (Try Any))) - -(type: #export (Instancer what) - (All [anchor expression directive] - (-> (Platform IO anchor expression directive) - (generation.State+ anchor expression directive) - what))) - -(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state) - (Instancer Runner) - (function (_ evaluation-name expressionS) - (do try.monad - [expressionG (<| (phase.run state) - generation.with-buffer - (do phase.monad - [_ runtime] - (phase expressionS)))] - (\ host evaluate! evaluation-name expressionG)))) - -(def: (definer (^slots [#platform.runtime #platform.phase #platform.host]) - state) - (Instancer Definer) - (function (_ lux-name expressionS) - (do try.monad - [definitionG (<| (phase.run state) - generation.with-buffer - (do phase.monad - [_ runtime - expressionG (phase expressionS) - [host-name host-value host-directive] (generation.define! lux-name expressionG) - _ (generation.learn lux-name host-name)] - (phase (synthesis.constant lux-name))))] - (\ host evaluate! "definer" definitionG)))) - -(def: #export (executors target expander platform - analysis-bundle generation-bundle directive-bundle - program extender) - (All [anchor expression directive] - (-> Text Expander (Platform IO anchor expression directive) - analysis.Bundle - (generation.Bundle anchor expression directive) - (directive.Bundle anchor expression directive) - (-> expression directive) Extender - (IO (Try [(directive.State+ anchor expression directive) - Runner - Definer])))) - (do io.monad - [?state (platform.initialize target expander analysis-bundle platform generation-bundle directive-bundle program extender)] - (wrap (do try.monad - [[directive-bundle directive-state] ?state - #let [generation-state (get@ [#directive.generation - #directive.state] - directive-state)]] - (wrap [[directive-bundle directive-state] - (..runner platform generation-state) - (..definer platform generation-state)]))))) diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux deleted file mode 100644 index 2424aa330..000000000 --- a/stdlib/source/spec/compositor/generation/case.lux +++ /dev/null @@ -1,288 +0,0 @@ -(.module: - [lux (#- case) - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ case>)] - ["." try (#+ Try)]] - [data - ["." text ("#\." equivalence) - ["%" format (#+ format)]] - [number - ["n" nat] - ["f" frac]] - [collection - ["." list ("#\." fold)]]] - [math - ["r" random (#+ Random)]] - [tool - [compiler - ["." reference] - ["." analysis] - ["." synthesis (#+ Path Synthesis)] - ["." phase - ["#/." synthesis - ["." case]] - ["." extension/synthesis]]]]] - [/// - [common (#+ Runner)]]) - -(def: limit Nat 10) - -(def: size - (Random Nat) - (|> r.nat (\ r.monad map (|>> (n.% ..limit) (n.max 2))))) - -(def: (tail? size idx) - (-> Nat Nat Bit) - (n.= (dec size) idx)) - -(def: #export (verify expected) - (-> Frac (Try Any) Bit) - (|>> (case> (#try.Success actual) - (f.= expected (:as Frac actual)) - - (#try.Failure _) - false))) - -(def: case - (Random [Synthesis Path]) - (<| r.rec (function (_ case)) - (`` ($_ r.either - (do r.monad - [value r.i64] - (wrap [(synthesis.i64 value) - synthesis.path/pop])) - (~~ (template [<gen> <synth> <path>] - [(do r.monad - [value <gen>] - (wrap [(<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 (\ ! map (n.% size))) - [subS subP] case - #let [unitS (synthesis.text synthesis.unit) - caseS (synthesis.tuple - (list.concat (list (list.repeat idx unitS) - (list subS) - (list.repeat (|> size dec (n.- idx)) unitS)))) - caseP ($_ synthesis.path/seq - (if (tail? size idx) - (synthesis.member/right idx) - (synthesis.member/left idx)) - subP)]] - (wrap [caseS caseP])) - (do {! r.monad} - [size ..size - idx (|> r.nat (\ ! map (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)]] - (wrap [caseS caseP])) - )))) - -(def: (let-spec run) - (-> Runner Test) - (do r.monad - [value r.safe-frac] - (_.test (%.name (name-of 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.filter (|>> (f.= on-true) not))) - verdict r.bit] - (_.test (%.name (name-of 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: (case-spec run) - (-> Runner Test) - (do r.monad - [[inputS pathS] ..case - on-success r.safe-frac - on-failure (|> r.safe-frac (r.filter (|>> (f.= on-success) not)))] - (_.test (%.name (name-of 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)))]) - (run "case-spec") - (verify on-success))))) - -(def: special-input - Synthesis - (let [_cursor_ (: Synthesis - (synthesis.tuple (list (synthesis.text .prelude_module) - (synthesis.i64 +901) - (synthesis.i64 +13)))) - _code_ (: (-> Synthesis Synthesis) - (function (_ content) - (synthesis.tuple (list _cursor_ content)))) - _nil_ (: Synthesis - (synthesis.variant [0 #0 (synthesis.text "")])) - _cons_ (: (-> Synthesis Synthesis Synthesis) - (function (_ head tail) - (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) - _list_ (: (-> (List Synthesis) Synthesis) - (list\fold _cons_ _nil_))] - (let [__tuple__ (: (-> (List Synthesis) Synthesis) - (|>> list.reverse _list_ [9 #0] synthesis.variant _code_)) - __form__ (: (-> (List Synthesis) Synthesis) - (|>> list.reverse _list_ [8 #0] synthesis.variant _code_)) - __text__ (: (-> Text Synthesis) - (function (_ value) - (_code_ (synthesis.variant [5 #0 (synthesis.text value)])))) - __identifier__ (: (-> Name Synthesis) - (function (_ [module short]) - (_code_ (synthesis.variant [6 #0 (synthesis.tuple (list (synthesis.text module) - (synthesis.text short)))])))) - __tag__ (: (-> Name Synthesis) - (function (_ [module short]) - (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module) - (synthesis.text short)))])))) - __list__ (: (-> (List Synthesis) Synthesis) - (list\fold (function (_ head tail) - (__form__ (list (__tag__ ["" "Cons"]) head tail))) - (__tag__ ["" "Nil"]))) - __apply__ (: (-> Synthesis Synthesis Synthesis) - (function (_ func arg) - (__form__ (list func arg))))] - (|> _nil_ - (_cons_ (__apply__ (__identifier__ ["" "form$"]) - (__list__ (list (__apply__ (__identifier__ ["" "tag$"]) - (__tuple__ (list (__text__ .prelude_module) - (__text__ "Cons")))) - (__identifier__ ["" "export?-meta"]) - (__identifier__ ["" "tail"]))))) - (_cons_ (__tuple__ (list (__identifier__ ["" "tail"])))) - )))) - -(def: special-path - Path - (let [_nil_ (synthesis.path/side (#.Left 0)) - _cons_ (synthesis.path/side (#.Right 0)) - _head_ (synthesis.path/member (#.Left 0)) - _tail_ (synthesis.path/member (#.Right 0)) - _tuple_ (synthesis.path/side (#.Left 9))] - ($_ synthesis.path/alt - ($_ synthesis.path/seq - _cons_ - _head_ - _head_ (synthesis.path/bind 2) synthesis.path/pop - _tail_ _tuple_ _cons_ - _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_ _cons_ - _head_ (synthesis.path/bind 5) synthesis.path/pop - _tail_ _nil_ - ## THEN - (synthesis.path/then (synthesis.bit #1))) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ## THEN - (synthesis.path/then (synthesis.bit #0)))))) - -(def: special-pattern - analysis.Pattern - (let [## [_ (#Tuple (#Cons 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))) - ## (#Cons body #Nil) - tail (<| analysis.pattern/variant [0 #1] - analysis.pattern/tuple (list (analysis.pattern/bind 5)) - analysis.pattern/variant [0 #0] - (analysis.pattern/unit))] - ## (#Cons <head> <tail>) - (<| analysis.pattern/variant [0 #1] - (analysis.pattern/tuple (list head tail))))) - -(def: special-pattern-path - Path - ($_ synthesis.path/alt - (<| try.assume - (phase.run [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))))) - -## 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") - (case> (#try.Success output) - true - - (#try.Failure _) - false))) - (_.test "PATTERN-MATCHING 0" - (|> (synthesis.branch/case [special-input - special-path]) - (run "special-path") - (case> (#try.Success output) - true - - (#try.Failure _) - false))) - (_.test "PATTERN-MATCHING 1" - (|> (synthesis.branch/case [special-input - special-pattern-path]) - (run "special-pattern-path") - (case> (#try.Success output) - true - - (#try.Failure _) - false))) - )) - -(def: #export (spec run) - (-> Runner Test) - ($_ _.and - (..special-spec run) - (..let-spec run) - (..if-spec run) - (..case-spec run) - )) diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux deleted file mode 100644 index 3d377b7ca..000000000 --- a/stdlib/source/spec/compositor/generation/common.lux +++ /dev/null @@ -1,343 +0,0 @@ -(.module: - [lux (#- i64) - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ case>)] - ["." try (#+ Try)]] - [data - ["." bit ("#\." equivalence)] - [number - ["." i64] - ["n" nat] - ["i" int] - ["f" frac]] - ["." text ("#\." equivalence) - ["%" format (#+ format)]] - [collection - ["." list]]] - [math - ["r" random (#+ Random)]] - [tool - [compiler - ["." reference] - ["." synthesis]]]] - ["." // #_ - ["#." case] - [// - [common (#+ Runner)]]]) - -(def: sanitize - (-> Text Text) - (text.replace-all " " "_")) - -(def: (bit run) - (-> Runner Test) - (do r.monad - [param r.i64 - subject r.i64] - (with-expansions [<binary> (template [<extension> <reference> <param-expr>] - [(_.test <extension> - (|> (#synthesis.Extension <extension> (list (synthesis.i64 param) - (synthesis.i64 subject))) - (run (..sanitize <extension>)) - (case> (#try.Success valueT) - (n.= (<reference> param subject) (:as Nat valueT)) - - (#try.Failure _) - false) - (let [param <param-expr>])))] - - ["lux i64 and" i64.and param] - ["lux i64 or" i64.or param] - ["lux i64 xor" i64.xor param] - ["lux i64 left-shift" i64.left-shift (n.% 64 param)] - ["lux i64 logical-right-shift" i64.logic-right-shift (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 (..sanitize "lux i64 arithmetic-right-shift")) - (case> (#try.Success valueT) - ("lux i64 =" - (i64.arithmetic-right-shift 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.filter (|>> ("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 (..sanitize <extension>)) - (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-shift 8 1)) - (:as Int))] - )) - (~~ (template [<extension> <reference> <outputT> <comp>] - [(_.test <extension> - (|> (#synthesis.Extension <extension> (list (synthesis.i64 param) - (synthesis.i64 subject))) - (run (..sanitize <extension>)) - (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) - (|> r.nat (\ r.monad map (|>> (n.% 1000) .int i.frac)))) - -(def: (f64 run) - (-> Runner Test) - (do r.monad - [param (|> ..simple-frac (r.filter (|>> (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 (..sanitize <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 (..sanitize <extension>)) - (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 (..sanitize <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 (..sanitize "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) - (do {! r.monad} - [sample-size (|> r.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - sample-lower (r.ascii/lower-alpha sample-size) - sample-upper (r.ascii/upper-alpha sample-size) - sample-alpha (|> (r.ascii/alpha sample-size) - (r.filter (|>> (text\= sample-upper) not))) - char-idx (|> r.nat (\ ! map (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 "lux text concat" (list sample-lowerS sample-upperS)) - pre-rep-once (format sample-lower sample-upper) - post-rep-once (format sample-lower sample-alpha) - pre-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-upper)) - post-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-alpha))]] - ($_ _.and - (_.test "Can compare texts for equality." - (and (|> (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS)) - (run (..sanitize "lux text =")) - (case> (#try.Success valueV) - (:as Bit valueV) - - _ - false)) - (|> (#synthesis.Extension "lux text =" (list sample-upperS sample-lowerS)) - (run (..sanitize "lux text =")) - (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 (..sanitize "lux text <")) - (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 (..sanitize "lux text size")) - (case> (#try.Success valueV) - (n.= sample-size (:as Nat valueV)) - - _ - false))) - (_.test "Can concatenate text." - (|> (#synthesis.Extension "lux text size" (list concatenatedS)) - (run (..sanitize "lux text size")) - (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 (..sanitize "lux text index")) - (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 (..sanitize "lux text index")) - (case> (^multi (#try.Success valueV) - [(:as (Maybe Nat) valueV) (#.Some valueV)]) - (n.= sample-size valueV) - - _ - false)))) - (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit) - (function (_ offset length expected) - (|> (#synthesis.Extension "lux text clip" - (list concatenatedS - (synthesis.i64 offset) - (synthesis.i64 length))) - (run (..sanitize "lux text clip")) - (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 (..sanitize "lux text char")) - (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 (..sanitize "lux io log")) - (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 (..sanitize "lux try")) - (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 (..sanitize "lux try")) - (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 (..sanitize "lux io current-time")) - (case> (#try.Success valueV) - (let [[pre post] (:as [Nat Nat] valueV)] - (n.>= pre post)) - - (#try.Failure _) - false))) - ))) - -(def: #export (spec runner) - (-> Runner Test) - ($_ _.and - (..bit runner) - (..i64 runner) - (..f64 runner) - (..text runner) - (..io runner) - )) diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux deleted file mode 100644 index 6d0f8d541..000000000 --- a/stdlib/source/spec/compositor/generation/function.lux +++ /dev/null @@ -1,93 +0,0 @@ -(.module: - [lux (#- function) - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - ["." enum]] - [control - [pipe (#+ case>)]] - [data - ["." maybe] - [number - ["n" nat]] - [collection - ["." list ("#\." functor)]]] - [math - ["r" random (#+ Random) ("#\." monad)]] - [tool - [compiler - [analysis (#+ Arity)] - ["." reference (#+ Register)] - ["." synthesis (#+ Synthesis)]]]] - ["." // #_ - ["#." case] - [// - [common (#+ Runner)]]]) - -(def: max-arity Arity 10) - -(def: arity - (Random Arity) - (|> r.nat (r\map (|>> (n.% max-arity) (n.max 1))))) - -(def: (local arity) - (-> Arity (Random Register)) - (|> r.nat (r\map (|>> (n.% arity) inc)))) - -(def: function - (Random [Arity Register Synthesis]) - (do r.monad - [arity ..arity - local (..local arity)] - (wrap [arity local - (synthesis.function/abstraction - {#synthesis.environment (list) - #synthesis.arity arity - #synthesis.body (synthesis.variable/local local)})]))) - -(def: #export (spec run) - (-> Runner Test) - (do {! r.monad} - [[arity local functionS] ..function - partial-arity (|> r.nat (\ ! map (|>> (n.% arity) (n.max 1)))) - inputs (r.list arity r.safe-frac) - #let [expectation (maybe.assume (list.nth (dec local) inputs)) - inputsS (list\map (|>> 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.take partial-arity inputsS) - postS (list.drop 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\map (|>> #reference.Local))) - variableS (if (n.<= partial-arity local) - (synthesis.variable/foreign (dec 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/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux deleted file mode 100644 index 3b6dd657b..000000000 --- a/stdlib/source/spec/compositor/generation/primitive.lux +++ /dev/null @@ -1,48 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ case>)] - ["." try]] - [data - ["." bit ("#\." equivalence)] - [number - ["f" frac]] - ["." text ("#\." equivalence) - ["%" format (#+ format)]]] - [math - ["r" random]] - [tool - [compiler - ["." synthesis]]]] - [/// - [common (#+ Runner)]]) - -(def: (f/=' reference subject) - (-> Frac Frac Bit) - (or (f.= reference subject) - (and (f.not-a-number? reference) - (f.not-a-number? subject)))) - -(def: #export (spec run) - (-> Runner Test) - (`` ($_ _.and - (~~ (template [<evaluation-name> <synthesis> <gen> <test>] - [(do r.monad - [expected <gen>] - (_.test (%.name (name-of <synthesis>)) - (|> (run <evaluation-name> (<synthesis> expected)) - (case> (#try.Success actual) - (<test> expected (:assume actual)) - - (#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\=] - )) - ))) diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux deleted file mode 100644 index 665175ab4..000000000 --- a/stdlib/source/spec/compositor/generation/reference.lux +++ /dev/null @@ -1,60 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ case>)] - ["." try]] - [data - [number - ["n" nat] - ["f" frac]]] - [tool - [compiler - ["." reference] - ["." synthesis]]] - [math - ["r" random (#+ Random)]]] - [/// - [common (#+ Runner Definer)]]) - -(def: name - (Random Name) - (let [name-part (r.ascii/upper-alpha 5)] - [(r.and name-part name-part)])) - -(def: (definition define) - (-> Definer Test) - (do r.monad - [name ..name - expected r.safe-frac] - (_.test "Definitions." - (|> (define name (synthesis.f64 expected)) - (case> (#try.Success actual) - (f.= expected (:as Frac actual)) - - (#try.Failure _) - false))))) - -(def: (variable run) - (-> Runner Test) - (do {! r.monad} - [register (|> r.nat (\ ! map (n.% 100))) - expected r.safe-frac] - (_.test "Local variables." - (|> (synthesis.branch/let [(synthesis.f64 expected) - register - (synthesis.variable/local register)]) - (run "variable") - (case> (#try.Success actual) - (f.= expected (:as Frac actual)) - - (#try.Failure _) - false))))) - -(def: #export (spec runner definer) - (-> Runner Definer Test) - ($_ _.and - (..definition definer) - (..variable runner))) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux deleted file mode 100644 index 7c45d2a9b..000000000 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ case>)] - ["." try]] - [data - ["." maybe] - [number - ["n" nat] - ["i" int]] - ["." text ("#\." equivalence) - ["%" format (#+ format)]] - [collection - ["." array (#+ Array)] - ["." list ("#\." functor)]]] - [math - ["r" random]] - ["." ffi (#+ import:)] - [tool - [compiler - ["." analysis] - ["." synthesis]]]] - [/// - [common (#+ Runner)]]) - -(import: java/lang/Integer) - -(def: (variant run) - (-> Runner Test) - (do {! r.monad} - [num-tags (|> r.nat (\ ! map (|>> (n.% 10) (n.max 2)))) - tag-in (|> r.nat (\ ! map (n.% num-tags))) - #let [last?-in (|> num-tags dec (n.= tag-in))] - value-in r.i64] - (_.test (%.name (name-of synthesis.variant)) - (|> (synthesis.variant {#analysis.lefts (if last?-in - (dec tag-in) - tag-in) - #analysis.right? last?-in - #analysis.value (synthesis.i64 value-in)}) - (run "variant") - (case> (#try.Success valueT) - (let [valueT (:as (Array Any) valueT)] - (and (n.= 3 (array.size valueT)) - (let [tag-out (:as java/lang/Integer (maybe.assume (array.read 0 valueT))) - last?-out (array.read 1 valueT) - value-out (:as Any (maybe.assume (array.read 2 valueT))) - same-tag? (|> tag-out ffi.int-to-long (:as Nat) (n.= tag-in)) - same-flag? (case 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 (\ ! map (|>> (n.% 10) (n.max 2)))) - tuple-in (r.list size r.i64)] - (_.test (%.name (name-of synthesis.tuple)) - (|> (synthesis.tuple (list\map (|>> synthesis.i64) tuple-in)) - (run "tuple") - (case> (#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.zip/2 tuple-in (array.to-list tuple-out))))) - - (#try.Failure _) - false))))) - -(def: #export (spec runner) - (-> Runner Test) - ($_ _.and - (..variant runner) - (..tuple runner) - )) diff --git a/stdlib/source/spec/lux/abstract/apply.lux b/stdlib/source/spec/lux/abstract/apply.lux deleted file mode 100644 index 691e8c01c..000000000 --- a/stdlib/source/spec/lux/abstract/apply.lux +++ /dev/null @@ -1,73 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." function]] - [math - ["." random] - [number - ["n" nat]]]]] - [\\library - ["." / (#+ Apply)]] - [// - [functor (#+ Injection Comparison)]]) - -(def: (identity injection comparison (^open "\.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {! random.monad} - [sample (\ ! map injection random.nat)] - (_.test "Identity." - ((comparison n.=) - (\apply (injection function.identity) sample) - sample)))) - -(def: (homomorphism injection comparison (^open "\.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {! random.monad} - [sample random.nat - increase (\ ! map n.+ random.nat)] - (_.test "Homomorphism." - ((comparison n.=) - (\apply (injection increase) (injection sample)) - (injection (increase sample)))))) - -(def: (interchange injection comparison (^open "\.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {! random.monad} - [sample random.nat - increase (\ ! map n.+ random.nat)] - (_.test "Interchange." - ((comparison n.=) - (\apply (injection increase) (injection sample)) - (\apply (injection (function (_ f) (f sample))) (injection increase)))))) - -(def: (composition injection comparison (^open "\.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {! random.monad} - [sample random.nat - increase (\ ! map n.+ random.nat) - decrease (\ ! map n.- random.nat)] - (_.test "Composition." - ((comparison n.=) - (_$ \apply - (injection function.compose) - (injection increase) - (injection decrease) - (injection sample)) - ($_ \apply - (injection increase) - (injection decrease) - (injection sample)))))) - -(def: #export (spec injection comparison apply) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (_.for [/.Apply] - ($_ _.and - (..identity injection comparison apply) - (..homomorphism injection comparison apply) - (..interchange injection comparison apply) - (..composition injection comparison apply) - ))) diff --git a/stdlib/source/spec/lux/abstract/codec.lux b/stdlib/source/spec/lux/abstract/codec.lux deleted file mode 100644 index f58f6ce91..000000000 --- a/stdlib/source/spec/lux/abstract/codec.lux +++ /dev/null @@ -1,27 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." try]] - [math - ["." random (#+ Random)]]]] - [\\library - ["." / - [// - [equivalence (#+ Equivalence)]]]]) - -(def: #export (spec (^open "@//.") (^open "@//.") generator) - (All [m a] (-> (Equivalence a) (/.Codec m a) (Random a) Test)) - (do random.monad - [expected generator] - (_.for [/.Codec] - (_.test "Isomorphism." - (case (|> expected @//encode @//decode) - (#try.Success actual) - (@//= expected actual) - - (#try.Failure _) - false))))) diff --git a/stdlib/source/spec/lux/abstract/comonad.lux b/stdlib/source/spec/lux/abstract/comonad.lux deleted file mode 100644 index 85d00b8f2..000000000 --- a/stdlib/source/spec/lux/abstract/comonad.lux +++ /dev/null @@ -1,61 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [math - ["." random] - [number - ["n" nat]]]]] - [\\library - ["." / (#+ CoMonad)]] - [// - [functor (#+ Injection Comparison)]]) - -(def: (left-identity injection (^open "_//.")) - (All [f] (-> (Injection f) (CoMonad f) Test)) - (do {! random.monad} - [sample random.nat - morphism (\ ! map (function (_ diff) - (|>> _//unwrap (n.+ diff))) - random.nat) - #let [start (injection sample)]] - (_.test "Left identity." - (n.= (morphism start) - (|> start _//split (_//map morphism) _//unwrap))))) - -(def: (right-identity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) - (do random.monad - [sample random.nat - #let [start (injection sample) - == (comparison n.=)]] - (_.test "Right identity." - (== start - (|> start _//split (_//map _//unwrap)))))) - -(def: (associativity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) - (do {! random.monad} - [sample random.nat - increase (\ ! map (function (_ diff) - (|>> _//unwrap (n.+ diff))) - random.nat) - decrease (\ ! map (function (_ diff) - (|>> _//unwrap(n.- diff))) - random.nat) - #let [start (injection sample) - == (comparison n.=)]] - (_.test "Associativity." - (== (|> start _//split (_//map (|>> _//split (_//map increase) decrease))) - (|> start _//split (_//map increase) _//split (_//map decrease)))))) - -(def: #export (spec injection comparison subject) - (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) - (<| (_.for [/.CoMonad]) - ($_ _.and - (..left-identity injection subject) - (..right-identity injection comparison subject) - (..associativity injection comparison subject) - ))) diff --git a/stdlib/source/spec/lux/abstract/enum.lux b/stdlib/source/spec/lux/abstract/enum.lux deleted file mode 100644 index ddb2a80f1..000000000 --- a/stdlib/source/spec/lux/abstract/enum.lux +++ /dev/null @@ -1,27 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [math - ["." random (#+ Random)]]]] - [\\library - ["." /]]) - -(def: #export (spec (^open "\.") gen-sample) - (All [a] (-> (/.Enum a) (Random a) Test)) - (do random.monad - [sample gen-sample] - (<| (_.for [/.Enum]) - ($_ _.and - (_.test "Successor and predecessor are inverse functions." - (and (\= (|> sample \succ \pred) - sample) - (\= (|> sample \pred \succ) - sample) - (not (\= (\succ sample) - sample)) - (not (\= (\pred sample) - sample)))) - )))) diff --git a/stdlib/source/spec/lux/abstract/equivalence.lux b/stdlib/source/spec/lux/abstract/equivalence.lux deleted file mode 100644 index 4d6d0900a..000000000 --- a/stdlib/source/spec/lux/abstract/equivalence.lux +++ /dev/null @@ -1,24 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [math - ["." random (#+ Random)]]]] - [\\library - ["." / (#+ Equivalence)]]) - -(def: #export (spec (^open "_//.") random) - (All [a] (-> (Equivalence a) (Random a) Test)) - (do random.monad - [left random - right random] - (<| (_.for [/.Equivalence]) - ($_ _.and - (_.test "Reflexivity." - (_//= left left)) - (_.test "Symmetry." - (if (_//= left right) - (_//= right left) - (not (_//= right left)))))))) diff --git a/stdlib/source/spec/lux/abstract/fold.lux b/stdlib/source/spec/lux/abstract/fold.lux deleted file mode 100644 index 2b4a7617f..000000000 --- a/stdlib/source/spec/lux/abstract/fold.lux +++ /dev/null @@ -1,23 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [math - ["." random] - [number - ["n" nat]]]]] - [// - [functor (#+ Injection Comparison)]] - [\\library - ["." /]]) - -(def: #export (spec injection comparison (^open "@//.")) - (All [f] (-> (Injection f) (Comparison f) (/.Fold f) Test)) - (do random.monad - [subject random.nat - parameter random.nat] - (_.cover [/.Fold] - (n.= (@//fold n.+ parameter (injection subject)) - (n.+ parameter subject))))) diff --git a/stdlib/source/spec/lux/abstract/functor.lux b/stdlib/source/spec/lux/abstract/functor.lux deleted file mode 100644 index cfa6cc2ff..000000000 --- a/stdlib/source/spec/lux/abstract/functor.lux +++ /dev/null @@ -1,62 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [equivalence (#+ Equivalence)] - [monad (#+ do)]] - [control - ["." function]] - [math - ["." random] - [number - ["n" nat]]]]] - [\\library - ["." / (#+ Functor)]]) - -(type: #export (Injection f) - (All [a] (-> a (f a)))) - -(type: #export (Comparison f) - (All [a] - (-> (Equivalence a) - (Equivalence (f a))))) - -(def: (identity injection comparison (^open "@//.")) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do {! random.monad} - [sample (\ ! map injection random.nat)] - (_.test "Identity." - ((comparison n.=) - (@//map function.identity sample) - sample)))) - -(def: (homomorphism injection comparison (^open "@//.")) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do {! random.monad} - [sample random.nat - increase (\ ! map n.+ random.nat)] - (_.test "Homomorphism." - ((comparison n.=) - (@//map increase (injection sample)) - (injection (increase sample)))))) - -(def: (composition injection comparison (^open "@//.")) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do {! random.monad} - [sample (\ ! map injection random.nat) - increase (\ ! map n.+ random.nat) - decrease (\ ! map n.- random.nat)] - (_.test "Composition." - ((comparison n.=) - (|> sample (@//map increase) (@//map decrease)) - (|> sample (@//map (|>> increase decrease))))))) - -(def: #export (spec injection comparison functor) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (<| (_.for [/.Functor]) - ($_ _.and - (..identity injection comparison functor) - (..homomorphism injection comparison functor) - (..composition injection comparison functor) - ))) diff --git a/stdlib/source/spec/lux/abstract/functor/contravariant.lux b/stdlib/source/spec/lux/abstract/functor/contravariant.lux deleted file mode 100644 index cba839e94..000000000 --- a/stdlib/source/spec/lux/abstract/functor/contravariant.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [equivalence (#+ Equivalence)] - [monad (#+ do)]] - [control - ["." function]] - [math - ["." random] - [number - ["n" nat]]]]] - [\\library - ["." / (#+ Functor)]]) - -(def: (identity equivalence value (^open "@//.")) - (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test)) - (_.test "Law of identity." - (equivalence - (@//map function.identity value) - value))) - -(def: #export (spec equivalence value functor) - (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test)) - (do random.monad - [sample random.nat] - (<| (_.for [/.Functor]) - ($_ _.and - (..identity equivalence value functor) - )))) diff --git a/stdlib/source/spec/lux/abstract/hash.lux b/stdlib/source/spec/lux/abstract/hash.lux deleted file mode 100644 index 4722a48a0..000000000 --- a/stdlib/source/spec/lux/abstract/hash.lux +++ /dev/null @@ -1,23 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [data - ["." bit ("#\." equivalence)]] - [math - ["." random (#+ Random)] - [number - ["n" nat]]]]] - [\\library - ["." /]]) - -(def: #export (spec (^open "\.") random) - (All [a] (-> (/.Hash a) (Random a) Test)) - (do random.monad - [parameter random - subject random] - (_.cover [/.Hash] - (bit\= (\= parameter subject) - (n.= (\hash parameter) (\hash subject)))))) diff --git a/stdlib/source/spec/lux/abstract/interval.lux b/stdlib/source/spec/lux/abstract/interval.lux deleted file mode 100644 index 5b74bc34d..000000000 --- a/stdlib/source/spec/lux/abstract/interval.lux +++ /dev/null @@ -1,23 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - ["." order]] - [math - ["." random (#+ Random)]]]] - [\\library - ["." /]]) - -(def: #export (spec (^open "@//.") gen-sample) - (All [a] (-> (/.Interval a) (Random a) Test)) - (<| (_.for [/.Interval]) - (do random.monad - [sample gen-sample] - ($_ _.and - (_.test "No value is bigger than the top." - (@//< @//top sample)) - (_.test "No value is smaller than the bottom." - (order.> @//&order @//bottom sample)) - )))) diff --git a/stdlib/source/spec/lux/abstract/monad.lux b/stdlib/source/spec/lux/abstract/monad.lux deleted file mode 100644 index 869eb24c7..000000000 --- a/stdlib/source/spec/lux/abstract/monad.lux +++ /dev/null @@ -1,57 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [math - ["." random] - [number - ["n" nat]]]]] - [\\library - ["." / (#+ do)]] - [// - [functor (#+ Injection Comparison)]]) - -(def: (left-identity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) - (do {! random.monad} - [sample random.nat - morphism (\ ! map (function (_ diff) - (|>> (n.+ diff) _//wrap)) - random.nat)] - (_.test "Left identity." - ((comparison n.=) - (|> (injection sample) (_//map morphism) _//join) - (morphism sample))))) - -(def: (right-identity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) - (do random.monad - [sample random.nat] - (_.test "Right identity." - ((comparison n.=) - (|> (injection sample) (_//map _//wrap) _//join) - (injection sample))))) - -(def: (associativity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) - (do {! random.monad} - [sample random.nat - increase (\ ! map (function (_ diff) - (|>> (n.+ diff) _//wrap)) - random.nat) - decrease (\ ! map (function (_ diff) - (|>> (n.- diff) _//wrap)) - random.nat)] - (_.test "Associativity." - ((comparison n.=) - (|> (injection sample) (_//map increase) _//join (_//map decrease) _//join) - (|> (injection sample) (_//map (|>> increase (_//map decrease) _//join)) _//join))))) - -(def: #export (spec injection comparison monad) - (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) - (<| (_.for [/.Monad]) - ($_ _.and - (..left-identity injection comparison monad) - (..right-identity injection comparison monad) - (..associativity injection comparison monad) - ))) diff --git a/stdlib/source/spec/lux/abstract/monoid.lux b/stdlib/source/spec/lux/abstract/monoid.lux deleted file mode 100644 index f8626fe74..000000000 --- a/stdlib/source/spec/lux/abstract/monoid.lux +++ /dev/null @@ -1,32 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [math - ["." random (#+ Random)]]]] - [\\library - ["." / - [// - [equivalence (#+ Equivalence)]]]]) - -(def: #export (spec (^open "\.") (^open "\.") gen-sample) - (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test)) - (do random.monad - [sample gen-sample - left gen-sample - mid gen-sample - right gen-sample] - (<| (_.for [/.Monoid]) - ($_ _.and - (_.test "Left identity." - (\= sample - (\compose \identity sample))) - (_.test "Right identity." - (\= sample - (\compose sample \identity))) - (_.test "Associativity." - (\= (\compose left (\compose mid right)) - (\compose (\compose left mid) right))) - )))) diff --git a/stdlib/source/spec/lux/abstract/order.lux b/stdlib/source/spec/lux/abstract/order.lux deleted file mode 100644 index 61fc22611..000000000 --- a/stdlib/source/spec/lux/abstract/order.lux +++ /dev/null @@ -1,58 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [math - ["." random (#+ Random)]]]] - [\\library - ["." /]]) - -(def: #export (spec (^open "@//.") generator) - (All [a] (-> (/.Order a) (Random a) Test)) - (<| (_.for [/.Order]) - ($_ _.and - (do random.monad - [parameter generator - subject generator] - (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." - (cond (@//< parameter subject) - (not (or (@//< subject parameter) - (@//= parameter subject))) - - (@//< subject parameter) - (not (@//= parameter subject)) - - ## else - (@//= parameter subject)))) - (do random.monad - [parameter generator - subject (random.filter (|>> (@//= parameter) not) - generator) - extra (random.filter (function (_ value) - (not (or (@//= parameter value) - (@//= subject value)))) - generator)] - (_.test "Transitive property." - (if (@//< parameter subject) - (let [greater? (and (@//< subject extra) - (@//< parameter extra)) - lesser? (and (@//< extra parameter) - (@//< extra subject)) - in-between? (and (@//< parameter extra) - (@//< extra subject))] - (or greater? - lesser? - in-between?)) - ## (@//< subject parameter) - (let [greater? (and (@//< extra subject) - (@//< extra parameter)) - lesser? (and (@//< parameter extra) - (@//< subject extra)) - in-between? (and (@//< subject extra) - (@//< extra parameter))] - (or greater? - lesser? - in-between?))))) - ))) diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux deleted file mode 100644 index f454b61c9..000000000 --- a/stdlib/source/spec/lux/world/console.lux +++ /dev/null @@ -1,58 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [io (#+ IO)] - ["." try] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." text - ["%" format (#+ format)]]] - [math - ["." random]]]] - [\\library - ["." /]]) - -(def: #export (spec console) - (-> (IO (/.Console Promise)) Test) - (do random.monad - [message (random.ascii/alpha 10)] - (wrap (do promise.monad - [console (promise.future console) - ?write (\ console write (format message text.new_line)) - ?read (\ console read []) - ?read_line (\ console read_line []) - ?close/good (\ console close []) - ?close/bad (\ console close []) - - #let [can_write! - (case ?write - (#try.Success _) - true - - _ - false) - - can_read! - (case [?read ?read_line] - [(#try.Success _) (#try.Success _)] - true - - _ - false) - - can_close! - (case [?close/good ?close/bad] - [(#try.Success _) (#try.Failure _)] - true - - _ - false)]] - (_.cover' [/.Console] - (and can_write! - can_read! - can_close!)))))) diff --git a/stdlib/source/spec/lux/world/file.lux b/stdlib/source/spec/lux/world/file.lux deleted file mode 100644 index 7bdefb173..000000000 --- a/stdlib/source/spec/lux/world/file.lux +++ /dev/null @@ -1,351 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - ["." predicate]] - [control - [pipe (#+ case>)] - [io (#+ IO)] - ["." try ("#\." functor)] - ["." exception] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." maybe ("#\." functor)] - ["." text ("#\." equivalence) - ["%" format (#+ format)] - [encoding - ["." utf8 ("#\." codec)]]] - ["." binary (#+ Binary) ("#\." equivalence monoid) - ["$#" \\test]] - [collection - ["." list]]] - [math - ["." random] - [number - ["n" nat]]] - [time - ["." instant (#+ Instant) ("#\." equivalence)]]]] - [\\library - ["." /]]) - -(def: (for_path fs) - (-> (IO (/.System Promise)) Test) - (<| (_.for [/.Path]) - (do {! random.monad} - [parent (random.ascii/numeric 2) - child (random.ascii/numeric 2)]) - wrap - (do promise.monad - [fs (promise.future fs)] - ($_ _.and' - (_.cover' [/.un_nest] - (and (|> (/.un_nest fs parent) - (case> (#.Some _) - false - - #.None - true)) - (|> (/.un_nest fs child) - (case> (#.Some _) - false - - #.None - true)))) - (_.cover' [/.nest] - (|> (/.nest fs parent child) - (/.un_nest fs) - (case> (#.Some [parent' child']) - (and (text\= parent parent') - (text\= child child')) - - #.None - false))) - (_.cover' [/.parent] - (|> (/.nest fs parent child) - (/.parent fs) - (maybe\map (text\= parent)) - (maybe.default false))) - (_.cover' [/.name] - (|> (/.nest fs parent child) - (/.name fs) - (text\= child))) - )))) - -(def: (directory?&make_directory fs parent) - (-> (/.System Promise) /.Path (Promise Bit)) - (do promise.monad - [directory_pre! (\ fs directory? parent) - made? (\ fs make_directory parent) - directory_post! (\ fs directory? parent)] - (wrap (and (not directory_pre!) - (case made? - (#try.Success _) true - (#try.Failure _) false) - directory_post!)))) - -(def: (file?&write fs content path) - (-> (/.System Promise) Binary /.Path (Promise Bit)) - (do promise.monad - [file_pre! (\ fs file? path) - made? (\ fs write content path) - file_post! (\ fs file? path)] - (wrap (and (not file_pre!) - (case made? - (#try.Success _) true - (#try.Failure _) false) - file_post!)))) - -(def: (file_size&read&append fs expected_file_size content appendix path) - (-> (/.System Promise) Nat Binary Binary /.Path (Promise Bit)) - (do promise.monad - [pre_file_size (\ fs file_size path) - pre_content (\ fs read path) - appended? (\ fs append appendix path) - post_file_size (\ fs file_size path) - post_content (\ fs read path)] - (wrap (<| (try.default false) - (do {! try.monad} - [pre_file_size! - (\ ! map (n.= expected_file_size) pre_file_size) - - pre_content! - (\ ! map (binary\= content) pre_content) - - _ appended? - - post_file_size! - (\ ! map (n.= (n.* 2 expected_file_size)) post_file_size) - - post_content! - (\ ! map (binary\= (binary\compose content appendix)) post_content)] - (wrap (and pre_file_size! - pre_content! - post_file_size! - post_content!))))))) - -(def: (modified?&last_modified fs expected_time path) - (-> (/.System Promise) Instant /.Path (Promise Bit)) - (do promise.monad - [modified? (\ fs modify expected_time path) - last_modified (\ fs last_modified path)] - (wrap (<| (try.default false) - (do {! try.monad} - [_ modified?] - (\ ! map (instant\= expected_time) last_modified)))))) - -(def: (directory_files&sub_directories fs parent sub_dir child) - (-> (/.System Promise) /.Path /.Path /.Path (Promise Bit)) - (let [sub_dir (/.nest fs parent sub_dir) - child (/.nest fs parent child)] - (do promise.monad - [made_sub? (\ fs make_directory sub_dir) - directory_files (\ fs directory_files parent) - sub_directories (\ fs sub_directories parent) - #let [(^open "list\.") (list.equivalence text.equivalence)]] - (wrap (<| (try.default false) - (do try.monad - [_ made_sub?] - (wrap (and (|> directory_files - (try\map (list\= (list child))) - (try.default false)) - (|> sub_directories - (try\map (list\= (list sub_dir))) - (try.default false)))))))))) - -(def: (move&delete fs parent child alternate_child) - (-> (/.System Promise) /.Path Text Text (Promise Bit)) - (let [origin (/.nest fs parent child) - destination (/.nest fs parent alternate_child)] - (do {! promise.monad} - [moved? (\ fs move destination origin) - lost? (|> origin - (\ fs file?) - (\ ! map not)) - found? (\ fs file? destination) - deleted? (\ fs delete destination)] - (wrap (<| (try.default false) - (do try.monad - [_ moved? - _ deleted?] - (wrap (and lost? - found?)))))))) - -(def: (for_system fs) - (-> (IO (/.System Promise)) Test) - (<| (do {! random.monad} - [parent (random.ascii/numeric 2) - child (random.ascii/numeric 2) - sub_dir (random.filter (|>> (text\= child) not) - (random.ascii/numeric 2)) - alternate_child (random.filter (predicate.intersect - (|>> (text\= child) not) - (|>> (text\= sub_dir) not)) - (random.ascii/numeric 2)) - expected_file_size (\ ! map (|>> (n.% 10) inc) random.nat) - content ($binary.random expected_file_size) - appendix ($binary.random expected_file_size) - expected_time random.instant]) - wrap - (do {! promise.monad} - [fs (promise.future fs) - #let [path (/.nest fs parent child)] - - directory?&make_directory - (..directory?&make_directory fs parent) - - file?&write - (..file?&write fs content path) - - file_size&read&append - (..file_size&read&append fs expected_file_size content appendix path) - - modified?&last_modified - (..modified?&last_modified fs expected_time path) - - can_execute? - (|> path - (\ fs can_execute?) - (\ ! map (|>> (try.default true) not))) - - directory_files&sub_directories - (..directory_files&sub_directories fs parent sub_dir child) - - move&delete - (..move&delete fs parent child alternate_child)]) - (_.cover' [/.System] - (and directory?&make_directory - file?&write - file_size&read&append - modified?&last_modified - can_execute? - directory_files&sub_directories - move&delete)))) - -(def: (make_directories&cannot_make_directory fs) - (-> (IO (/.System Promise)) Test) - (<| (do {! random.monad} - [dir/0 (random.ascii/numeric 2) - dir/1 (random.ascii/numeric 2) - dir/2 (random.ascii/numeric 2)]) - wrap - (do {! promise.monad} - [fs (promise.future fs) - #let [dir/1 (/.nest fs dir/0 dir/1) - dir/2 (/.nest fs dir/1 dir/2)] - pre_dir/0 (\ fs directory? dir/0) - pre_dir/1 (\ fs directory? dir/1) - pre_dir/2 (\ fs directory? dir/2) - made? (/.make_directories ! fs dir/2) - post_dir/0 (\ fs directory? dir/0) - post_dir/1 (\ fs directory? dir/1) - post_dir/2 (\ fs directory? dir/2) - - cannot_make_directory!/0 (/.make_directories ! fs "") - cannot_make_directory!/1 (/.make_directories ! fs (\ fs separator))]) - ($_ _.and' - (_.cover' [/.make_directories] - (and (not pre_dir/0) - (not pre_dir/1) - (not pre_dir/2) - (case made? - (#try.Success _) true - (#try.Failure _) false) - post_dir/0 - post_dir/1 - post_dir/2)) - (_.cover' [/.cannot_make_directory] - (and (case cannot_make_directory!/0 - (#try.Success _) - false - - (#try.Failure error) - (exception.match? /.cannot_make_directory error)) - (case cannot_make_directory!/1 - (#try.Success _) - false - - (#try.Failure error) - (exception.match? /.cannot_make_directory error)))) - ))) - -(def: (make_file&cannot_make_file fs) - (-> (IO (/.System Promise)) Test) - (<| (do {! random.monad} - [file/0 (random.ascii/numeric 3)]) - wrap - (do {! promise.monad} - [fs (promise.future fs) - make_file!/0 (/.make_file ! fs (utf8\encode file/0) file/0) - make_file!/1 (/.make_file ! fs (utf8\encode file/0) file/0)]) - ($_ _.and' - (_.cover' [/.make_file] - (case make_file!/0 - (#try.Success _) true - (#try.Failure error) false)) - (_.cover' [/.cannot_make_file] - (case make_file!/1 - (#try.Success _) - false - - (#try.Failure error) - (exception.match? /.cannot_make_file error))) - ))) - -(def: (for_utilities fs) - (-> (IO (/.System Promise)) Test) - ($_ _.and - (..make_directories&cannot_make_directory fs) - (..make_file&cannot_make_file fs) - )) - -(def: (exists? fs) - (-> (IO (/.System Promise)) Test) - (<| (do {! random.monad} - [file (random.ascii/numeric 2) - dir (random.filter (|>> (text\= file) not) - (random.ascii/numeric 2))]) - wrap - (do {! promise.monad} - [fs (promise.future fs) - - pre_file/0 (\ fs file? file) - pre_file/1 (/.exists? ! fs file) - pre_dir/0 (\ fs directory? dir) - pre_dir/1 (/.exists? ! fs dir) - - made_file? (/.make_file ! fs (utf8\encode file) file) - made_dir? (\ fs make_directory dir) - - post_file/0 (\ fs file? file) - post_file/1 (/.exists? ! fs file) - post_dir/0 (\ fs directory? dir) - post_dir/1 (/.exists? ! fs dir)]) - (_.cover' [/.exists?] - (and (not pre_file/0) - (not pre_file/1) - (not pre_dir/0) - (not pre_dir/1) - - (case made_file? - (#try.Success _) true - (#try.Failure _) false) - (case made_dir? - (#try.Success _) true - (#try.Failure _) false) - - post_file/0 - post_file/1 - post_dir/0 - post_dir/1)))) - -(def: #export (spec fs) - (-> (IO (/.System Promise)) Test) - ($_ _.and - (..for_path fs) - (..for_utilities fs) - (..for_system fs) - (..exists? fs) - )) diff --git a/stdlib/source/spec/lux/world/program.lux b/stdlib/source/spec/lux/world/program.lux deleted file mode 100644 index e79429627..000000000 --- a/stdlib/source/spec/lux/world/program.lux +++ /dev/null @@ -1,32 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." try] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." text] - [collection - ["." dictionary] - ["." list]]] - [math - ["." random]]]] - [\\library - ["." /]]) - -(def: #export (spec subject) - (-> (/.Program Promise) Test) - (do random.monad - [exit random.int] - (wrap (do {! promise.monad} - [environment (/.environment ! subject)] - (_.cover' [/.Program] - (and (not (dictionary.empty? environment)) - (list.every? (|>> text.empty? not) - (dictionary.keys environment)) - (not (text.empty? (\ subject home))) - (not (text.empty? (\ subject directory))))))))) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux deleted file mode 100644 index c4fc51b99..000000000 --- a/stdlib/source/spec/lux/world/shell.lux +++ /dev/null @@ -1,92 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." try ("#\." functor)] - [concurrency - ["." promise (#+ Promise) ("#\." monad)]] - [parser - ["." environment (#+ Environment)]]] - [data - ["." product] - ["." text ("#\." equivalence) - ["%" format (#+ format)]]] - [math - ["." random] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["." / - [// - [file (#+ Path)]]]]) - -(template [<name> <command> <type> <prep>] - [(def: <name> - (-> <type> [Environment Path /.Command (List /.Argument)]) - (|>> <prep> list [environment.empty "~" <command>]))] - - [echo! "echo" Text (|>)] - [sleep! "sleep" Nat %.nat] - ) - -(def: (can_wait! process) - (-> (/.Process Promise) _.Assertion) - (|> (\ process await []) - (promise\map (|>> (try\map (i.= /.normal)) - (try.default false) - (_.cover' [/.Exit /.normal]))) - promise\join)) - -(def: (can_read! expected process) - (-> Text (/.Process Promise) (Promise Bit)) - (|> (\ process read []) - (promise\map (|>> (try\map (text\= expected)) - (try.default false))))) - -(def: (can_destroy! process) - (-> (/.Process Promise) (Promise Bit)) - (do promise.monad - [?destroy (\ process destroy []) - ?await (\ process await [])] - (wrap (and (case ?destroy - (#try.Success _) - true - - (#try.Failure error) - false) - (case ?await - (#try.Success _) - false - - (#try.Failure error) - true))))) - -(with_expansions [<shell_coverage> (as_is [/.Command /.Argument])] - (def: #export (spec shell) - (-> (/.Shell Promise) Test) - (<| (_.for [/.Shell /.Process]) - (do {! random.monad} - [message (random.ascii/alpha 10) - seconds (\ ! map (|>> (n.% 5) (n.+ 5)) random.nat)] - (wrap (do {! promise.monad} - [?echo (\ shell execute (..echo! message)) - ?sleep (\ shell execute (..sleep! seconds))] - (case [?echo ?sleep] - [(#try.Success echo) (#try.Success sleep)] - (do ! - [can_read! (..can_read! message echo) - can_destroy! (..can_destroy! sleep)] - ($_ _.and' - (_.cover' <shell_coverage> - (and can_read! - can_destroy!)) - (..can_wait! echo) - )) - - _ - (_.cover' <shell_coverage> - false)))))))) |