From 6eaa3b57f3f1ea2ce13b942bdb4ef502fc1729bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 29 May 2020 00:19:24 -0400 Subject: Can now import previously exported libraries. --- commands.md | 1 + new-luxc/source/program.lux | 4 +- stdlib/source/lux/abstract/comonad.lux | 10 +- stdlib/source/lux/abstract/monad.lux | 10 +- .../source/lux/tool/compiler/default/platform.lux | 149 +++++++++++---------- .../source/lux/tool/compiler/meta/io/context.lux | 61 +++++++-- stdlib/source/program/compositor.lux | 4 +- stdlib/source/program/compositor/cli.lux | 6 +- stdlib/source/program/compositor/export.lux | 6 +- stdlib/source/program/compositor/import.lux | 62 +++++++++ stdlib/source/test/lux/abstract.lux | 21 ++- stdlib/source/test/lux/abstract/monad/free.lux | 57 ++++++++ stdlib/source/test/lux/abstract/predicate.lux | 113 ++++++++++------ 13 files changed, 346 insertions(+), 158 deletions(-) create mode 100644 stdlib/source/program/compositor/import.lux create mode 100644 stdlib/source/test/lux/abstract/monad/free.lux diff --git a/commands.md b/commands.md index 542bf9932..f29b148e3 100644 --- a/commands.md +++ b/commands.md @@ -297,6 +297,7 @@ cd ~/lux/new-luxc/ && java -jar target/program.jar repl --source ~/lux/stdlib/so ``` cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux cd ~/lux/stdlib/ && lein clean && cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +cd ~/lux/stdlib/ && lein clean && cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux cd ~/lux/new-luxc/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target cd ~/lux/stdlib/target/ && java -jar program.jar diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 54f1437c7..e2cf047e9 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -150,8 +150,8 @@ (def: (target service) (-> /cli.Service /cli.Target) (case service - (^or (#/cli.Compilation [sources target module]) - (#/cli.Interpretation [sources target module]) + (^or (#/cli.Compilation [sources libraries target module]) + (#/cli.Interpretation [sources libraries target module]) (#/cli.Export [sources target])) target)) diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index 988d7c255..874b96913 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -6,7 +6,7 @@ [collection ["." list ("#@." fold)]]]] [// - ["." functor (#+ Functor)]]) + [functor (#+ Functor)]]) (signature: #export (CoMonad w) {#.doc (doc "CoMonads are the opposite/complement to monads." @@ -66,17 +66,13 @@ (#.Some name) (let [name [_cursor (#.Identifier ["" name])]] (` ({(~ name) - ({{#..&functor {#functor.map (~ g!map)} - #..unwrap (~' unwrap) - #..split (~ g!split)} + ({[(~ g!map) (~' unwrap) (~ g!split)] (~ body')} (~ name))} (~ comonad)))) #.None - (` ({{#..&functor {#functor.map (~ g!map)} - #..unwrap (~' unwrap) - #..split (~ g!split)} + (` ({[(~ g!map) (~' unwrap) (~ g!split)] (~ body')} (~ comonad)))))])) (#.Left "'be' bindings must have an even number of parts.")) diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux index 12f75e9ac..4c03e937c 100644 --- a/stdlib/source/lux/abstract/monad.lux +++ b/stdlib/source/lux/abstract/monad.lux @@ -1,7 +1,7 @@ (.module: [lux #*] [// - ["." functor (#+ Functor)]]) + [functor (#+ Functor)]]) (def: (list@fold f init xs) (All [a b] @@ -92,17 +92,13 @@ (#.Some name) (let [name [_cursor (#.Identifier ["" name])]] (` ({(~ name) - ({{#..&functor {#functor.map (~ g!map)} - #..wrap (~' wrap) - #..join (~ g!join)} + ({[(~ g!map) (~' wrap) (~ g!join)] (~ body')} (~ name))} (~ monad)))) #.None - (` ({{#..&functor {#functor.map (~ g!map)} - #..wrap (~' wrap) - #..join (~ g!join)} + (` ({[(~ g!map) (~' wrap) (~ g!join)] (~ body')} (~ monad)))))])) (#.Left "'do' bindings must have an even number of parts.")) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 5f117325c..7813ba799 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -52,8 +52,9 @@ ["ioW" archive]]]]] [program [compositor - ["." cli (#+ Compilation)] - ["." static (#+ Static)]]]) + ["." cli (#+ Compilation Library)] + ["." static (#+ Static)] + ["." import]]]) (type: #export (Platform anchor expression directive) {#&file-system (file.System Promise) @@ -351,85 +352,85 @@ try.assume product.left)) - (def: #export (compile static expander platform compilation context) + (def: #export (compile libraries static expander platform compilation context) (All [] - (-> Static Expander Compilation )) - (let [[compilation-sources compilation-target compilation-module] compilation + (-> (List Library) Static Expander Compilation )) + (let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation base-compiler (:share [] { context} {(///.Compiler .Module Any) (:assume - ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))}) - parallel-compiler (..parallel - context - (function (_ import! module-id [archive state] module) - (do (try.with promise.monad) - [#let [state (..set-current-module module state)] - input (context.read (get@ #&file-system platform) - compilation-sources - (get@ #static.host-module-extension static) - module)] - (loop [[archive state] [archive state] - compilation (base-compiler (:coerce ///.Input input)) - all-dependencies (: (List Module) - (list))] - (do {@ (try.with promise.monad)} - [#let [new-dependencies (get@ #///.dependencies compilation) - all-dependencies (list@compose new-dependencies all-dependencies) - continue! (:share [] - { - platform} - {(-> (///.Compilation .Module Any) (List Module) - (Action [Archive ])) - (:assume - recur)})] - [archive state] (case new-dependencies - #.Nil - (wrap [archive state]) + ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})] + (do (try.with promise.monad) + [libraries (import.import (get@ #&file-system platform) compilation-libraries) + #let [parallel-compiler (..parallel + context + (function (_ import! module-id [archive state] module) + (do (try.with promise.monad) + [#let [state (..set-current-module module state)] + input (context.read (get@ #&file-system platform) + libraries + compilation-sources + (get@ #static.host-module-extension static) + module)] + (loop [[archive state] [archive state] + compilation (base-compiler (:coerce ///.Input input)) + all-dependencies (: (List Module) + (list))] + (do {@ (try.with promise.monad)} + [#let [new-dependencies (get@ #///.dependencies compilation) + all-dependencies (list@compose new-dependencies all-dependencies) + continue! (:share [] + { + platform} + {(-> (///.Compilation .Module Any) (List Module) + (Action [Archive ])) + (:assume + recur)})] + [archive state] (case new-dependencies + #.Nil + (wrap [archive state]) - (#.Cons _) - (do @ - [archive,document+ (|> new-dependencies - (list@map import!) - (monad.seq ..monad)) - #let [archive (|> archive,document+ - (list@map product.left) - (list@fold archive.merge archive))]] - (wrap [archive (try.assume - (..updated-state archive state))])))] - (case ((get@ #///.process compilation) - ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP. - ## TODO: The context shouldn't need to be re-set either. - (|> (///directive.set-current-module module) - (///phase.run' state) - try.assume - product.left) - archive) - (#try.Success [state more|done]) - (case more|done - (#.Left more) - (continue! [archive state] more all-dependencies) + (#.Cons _) + (do @ + [archive,document+ (|> new-dependencies + (list@map import!) + (monad.seq ..monad)) + #let [archive (|> archive,document+ + (list@map product.left) + (list@fold archive.merge archive))]] + (wrap [archive (try.assume + (..updated-state archive state))])))] + (case ((get@ #///.process compilation) + ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP. + ## TODO: The context shouldn't need to be re-set either. + (|> (///directive.set-current-module module) + (///phase.run' state) + try.assume + product.left) + archive) + (#try.Success [state more|done]) + (case more|done + (#.Left more) + (continue! [archive state] more all-dependencies) - (#.Right [[descriptor document] output]) - (do (try.with promise.monad) - [#let [_ (log! (..module-compilation-log state)) - descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)] - _ (..cache-module static platform module-id [[descriptor document] output])] - (case (archive.add module [descriptor document] archive) - (#try.Success archive) - (wrap [archive - (..with-reset-log state)]) - - (#try.Failure error) - (promise@wrap (#try.Failure error))))) + (#.Right [[descriptor document] output]) + (do (try.with promise.monad) + [#let [_ (log! (..module-compilation-log state)) + descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)] + _ (..cache-module static platform module-id [[descriptor document] output])] + (case (archive.add module [descriptor document] archive) + (#try.Success archive) + (wrap [archive + (..with-reset-log state)]) + + (#try.Failure error) + (promise@wrap (#try.Failure error))))) - (#try.Failure error) - (do (try.with promise.monad) - [_ (ioW.freeze (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static) archive)] - (promise@wrap (#try.Failure error)))) - )) - )))] - (parallel-compiler compilation-module) - )) + (#try.Failure error) + (do (try.with promise.monad) + [_ (ioW.freeze (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static) archive)] + (promise@wrap (#try.Failure error)))))))))]] + (parallel-compiler compilation-module)))) )) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index 574b24290..1dceaaba6 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -6,7 +6,7 @@ ["." monad (#+ Monad do)]] [control ["." try (#+ Try)] - ["." exception (#+ Exception exception:)] + ["." exception (#+ exception:)] [security ["!" capability]] [concurrency @@ -20,6 +20,9 @@ ["." dictionary (#+ Dictionary)]]] [world ["." file (#+ Path File)]]] + [program + [compositor + [import (#+ Import)]]] ["." // (#+ Context Code) ["/#" // #_ [archive @@ -70,26 +73,60 @@ (-> Extension Extension) (format partial-host-extension ..lux-extension)) -(def: #export (find-any-source-file system contexts partial-host-extension module) - (-> (file.System Promise) (List Context) Extension Module - (Promise (Try [Path (File Promise)]))) +(def: (find-local-source-file system import contexts partial-host-extension module) + (-> (file.System Promise) Import (List Context) Extension Module + (Promise (Try [Path Binary]))) + ## Preference is explicitly being given to Lux files that have a host extension. + ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. + (do {@ promise.monad} + [outcome (..find-source-file system contexts module (..full-host-extension partial-host-extension))] + (case outcome + (#try.Success [path file]) + (do (try.with @) + [data (!.use (:: file content) [])] + (wrap [path data])) + + (#try.Failure _) + (do (try.with @) + [[path file] (..find-source-file system contexts module ..lux-extension) + data (!.use (:: file content) [])] + (wrap [path data]))))) + +(def: (find-library-source-file import partial-host-extension module) + (-> Import Extension Module (Try [Path Binary])) + (let [path (format module (..full-host-extension partial-host-extension))] + (case (dictionary.get path import) + (#.Some data) + (#try.Success [path data]) + + #.None + (let [path (format module ..lux-extension)] + (case (dictionary.get path import) + (#.Some data) + (#try.Success [path data]) + + #.None + (exception.throw ..cannot-find-module [module])))))) + +(def: (find-any-source-file system import contexts partial-host-extension module) + (-> (file.System Promise) Import (List Context) Extension Module + (Promise (Try [Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. - (do promise.monad - [outcome (find-source-file system contexts module (..full-host-extension partial-host-extension))] + (do {@ promise.monad} + [outcome (find-local-source-file system import contexts partial-host-extension module)] (case outcome - (#try.Success output) + (#try.Success [path data]) (wrap outcome) (#try.Failure _) - (find-source-file system contexts module ..lux-extension)))) + (wrap (..find-library-source-file import partial-host-extension module))))) -(def: #export (read system contexts partial-host-extension module) - (-> (file.System Promise) (List Context) Extension Module +(def: #export (read system import contexts partial-host-extension module) + (-> (file.System Promise) Import (List Context) Extension Module (Promise (Try Input))) (do (try.with promise.monad) - [[path file] (..find-any-source-file system contexts partial-host-extension module) - binary (!.use (:: file content) [])] + [[path binary] (..find-any-source-file system import contexts partial-host-extension module)] (case (encoding.from-utf8 binary) (#try.Success code) (wrap {#////.module module diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index d431198fa..63a73260d 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -94,7 +94,7 @@ (#/cli.Compilation compilation) (<| (or-crash! "Compilation failed:") (do (try.with promise.monad) - [#let [[compilation-sources compilation-target compilation-module] compilation] + [#let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation] [state archive] (:share [] {(Platform ) platform} @@ -105,7 +105,7 @@ {(Platform ) platform} {(Promise (Try [Archive (directive.State+ )])) - (:assume (platform.compile static expander platform compilation [archive state]))}) + (:assume (platform.compile compilation-libraries static expander platform compilation [archive state]))}) _ (ioW.freeze (get@ #platform.&file-system platform) (get@ #/static.host static) (get@ #/static.target static) archive)] (wrap (log! "Compilation complete!")))) diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux index 940665680..e0bcd6e00 100644 --- a/stdlib/source/program/compositor/cli.lux +++ b/stdlib/source/program/compositor/cli.lux @@ -12,10 +12,11 @@ [file (#+ Path)]]]) (type: #export Source Path) +(type: #export Library Path) (type: #export Target Path) (type: #export Compilation - [(List Source) Target Module]) + [(List Source) (List Library) Target Module]) (type: #export Export [(List Source) Target]) @@ -31,6 +32,7 @@ (cli.named cli.any))] [source "--source" Source] + [library "--library" Library] [target "--target" Target] [module "--module" Module] ) @@ -41,11 +43,13 @@ (<>.after (cli.this "build") ($_ <>.and (<>.some ..source) + (<>.some ..library) ..target ..module)) (<>.after (cli.this "repl") ($_ <>.and (<>.some ..source) + (<>.some ..library) ..target ..module)) (<>.after (cli.this "export") diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index 6e364800f..f6a78ed78 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -9,7 +9,7 @@ [security ["!" capability]]] [data - [text + ["." text ["%" format (#+ format)]] [collection ["." dictionary] @@ -48,7 +48,9 @@ (monad.map try.monad (function (_ [path source-code]) (do try.monad - [path (tar.path path) + [path (|> path + (text.replace-all (:: system separator) .module-separator) + tar.path) source-code (tar.content source-code)] (wrap (#tar.Normal [path (instant.from-millis +0) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux new file mode 100644 index 000000000..2e53e0976 --- /dev/null +++ b/stdlib/source/program/compositor/import.lux @@ -0,0 +1,62 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise) ("#@." monad)]] + [security + ["!" capability]] + ["<>" parser + ["" binary]]] + [data + [binary (#+ Binary)] + ["." text] + [collection + ["." dictionary (#+ Dictionary)] + ["." row]] + [format + ["." tar]]] + [world + ["." file (#+ Path File)]]] + [// + [cli (#+ Library)]]) + +(def: Action + (type (All [a] (Promise (Try a))))) + +(exception: #export useless-tar-entry) + +(type: #export Import + (Dictionary Path Binary)) + +(def: (import-library system library import) + (-> (file.System Promise) Library Import (Action Import)) + (do (try.with promise.monad) + [library (: (Action (File Promise)) + (!.use (:: system file) [library])) + binary (!.use (:: library content) [])] + (promise@wrap + (do {@ try.monad} + [tar (.run tar.parser binary)] + (monad.fold @ (function (_ entry import) + (case entry + (#tar.Normal [path instant mode ownership content]) + (dictionary.try-put (tar.from-path path) + (tar.data content) + import) + + _ + (exception.throw ..useless-tar-entry []))) + import + (row.to-list tar)))))) + +(def: #export (import system libraries) + (-> (file.System Promise) (List Library) (Action Import)) + (monad.fold (: (Monad Action) + (try.with promise.monad)) + (..import-library system) + (dictionary.new text.hash) + libraries)) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index aa93df86f..12c3625b3 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -8,21 +8,28 @@ ["#." enum] ["#." equivalence] ["#." fold] - ["#." functor] + ["#." functor + ["#/." contravariant]] ["#." hash] ["#." interval] - ["#." monad] + ["#." monad + ["#/." free]] ["#." monoid] ["#." order] - ["#." predicate] - [functor - ["#." contravariant]]]) + ["#." predicate]]) (def: functor Test ($_ _.and /functor.test - /contravariant.test + /functor/contravariant.test + )) + +(def: monad + Test + ($_ _.and + /monad.test + /monad/free.test )) (def: #export test @@ -37,7 +44,7 @@ ..functor /hash.test /interval.test - /monad.test + ..monad /monoid.test /order.test /predicate.test diff --git a/stdlib/source/test/lux/abstract/monad/free.lux b/stdlib/source/test/lux/abstract/monad/free.lux new file mode 100644 index 000000000..7241dc8b9 --- /dev/null +++ b/stdlib/source/test/lux/abstract/monad/free.lux @@ -0,0 +1,57 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] + [data + [collection + ["." list ("#@." functor)]]] + [math + ["." random]]] + {1 + ["." /]}) + +(def: injection + (Injection (/.Free List)) + (|>> #/.Pure)) + +(def: (interpret free) + (All [a] (-> (/.Free List a) (List a))) + (case free + (#/.Pure value) + (list value) + + (#/.Effect effect) + (|> effect + (list@map interpret) + list.concat))) + +(def: comparison + (Comparison (/.Free List)) + (function (_ == left right) + (:: (list.equivalence ==) = + (..interpret left) + (..interpret right)))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Free]) + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison (: (Functor (/.Free List)) + (/.functor list.functor)))) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison (: (Apply (/.Free List)) + (/.apply list.functor)))) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison (: (Monad (/.Free List)) + (/.monad list.functor)))) + ))) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index 3831ac0fb..1a0d457db 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -3,21 +3,25 @@ ["_" test (#+ Test)] [abstract [equivalence (#+ Equivalence)] - [monad (#+ do)]] + [monad (#+ do)] + {[0 #spec] + [/ + [functor + ["." contravariant]]]}] [control ["." function]] [data ["." bit ("#@." equivalence)] - [text - ["%" format (#+ format)]] [number - ["n" nat]]] + ["n" nat]] + [collection + ["." list]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] ["." // #_ ["#." monoid]] {1 - ["." / (#+ Predicate)]}) + ["." /]}) (def: (multiple? factor) (-> Nat (/.Predicate Nat)) @@ -27,41 +31,62 @@ (def: #export test Test - (let [/2? (multiple? 2) - /3? (multiple? 3)] - (<| (_.context (%.name (name-of /.Predicate))) - (do {@ r.monad} - [sample r.nat]) - ($_ _.and - (_.test (%.name (name-of /.none)) - (bit@= false (/.none sample))) - (_.test (%.name (name-of /.all)) - (bit@= true (/.all sample))) - (_.test (%.name (name-of /.unite)) - (bit@= (/.all sample) - ((/.unite /.none /.all) sample))) - (_.test (%.name (name-of /.intersect)) - (bit@= (/.none sample) - ((/.intersect /.none /.all) sample))) - (_.test (%.name (name-of /.complement)) - (and (not (bit@= (/.none sample) - ((/.complement /.none) sample))) - (not (bit@= (/.all sample) - ((/.complement /.all) sample))))) - (_.test (%.name (name-of /.difference)) - (bit@= (and (/2? sample) - (not (/3? sample))) - ((/.difference /3? /2?) sample))) - (let [equivalence (: (Equivalence (/.Predicate Nat)) - (structure - (def: (= left right) - (bit@= (left sample) - (right sample))))) - generator (: (Random (/.Predicate Nat)) - (|> r.nat - (r.filter (|>> (n.= 0) not)) - (:: @ map multiple?)))] - ($_ _.and - (//monoid.spec equivalence /.union generator) - (//monoid.spec equivalence /.intersection generator))) - )))) + (<| (_.covering /._) + (do {@ random.monad} + [sample random.nat + samples (random.list 10 random.nat) + #let [equivalence (: (Equivalence (/.Predicate Nat)) + (structure + (def: (= left right) + (bit@= (left sample) + (right sample)))))]]) + (_.with-cover [/.Predicate]) + ($_ _.and + (_.with-cover [/.functor] + (contravariant.spec equivalence (multiple? 2) /.functor)) + (let [generator (: (Random (/.Predicate Nat)) + (|> random.nat + (random.filter (|>> (n.= 0) not)) + (:: @ map multiple?)))] + ($_ _.and + (_.with-cover [/.union] + (//monoid.spec equivalence /.union generator)) + (_.with-cover [/.intersection] + (//monoid.spec equivalence /.intersection generator)))) + + (_.cover [/.none] + (bit@= false (/.none sample))) + (_.cover [/.all] + (bit@= true (/.all sample))) + (_.cover [/.unite] + (bit@= (/.all sample) + ((/.unite /.none /.all) sample))) + (_.cover [/.intersect] + (bit@= (/.none sample) + ((/.intersect /.none /.all) sample))) + (_.cover [/.complement] + (and (not (bit@= (/.none sample) + ((/.complement /.none) sample))) + (not (bit@= (/.all sample) + ((/.complement /.all) sample))))) + (_.cover [/.difference] + (let [/2? (multiple? 2) + /3? (multiple? 3)] + (bit@= (and (/2? sample) + (not (/3? sample))) + ((/.difference /3? /2?) sample)))) + (_.cover [/.rec] + (let [even? (multiple? 2) + any-even? (: (/.Predicate (List Nat)) + (/.rec (function (_ recur) + (function (_ values) + (case values + #.Nil + false + + (#.Cons head tail) + (or (even? head) + (recur tail)))))))] + (bit@= (list.any? even? samples) + (any-even? samples)))) + ))) -- cgit v1.2.3