diff options
| -rw-r--r-- | commands.md | 2 | ||||
| -rw-r--r-- | new-luxc/source/program.lux | 48 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/stm.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/control/continuation.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/lux/control/function/contract.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/tar.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/context.lux | 88 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/program/compositor/cli.lux | 69 | ||||
| -rw-r--r-- | stdlib/source/program/compositor/export.lux | 60 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/stm.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/continuation.lux | 122 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function/contract.lux | 39 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/format/tar.lux | 2 |
16 files changed, 390 insertions, 181 deletions
diff --git a/commands.md b/commands.md index 64d877e19..542bf9932 100644 --- a/commands.md +++ b/commands.md @@ -296,6 +296,8 @@ 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/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 f525d14d5..54f1437c7 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -10,7 +10,7 @@ [parser [cli (#+ program:)]] [concurrency - [promise (#+ Promise)]]] + ["." promise (#+ Promise)]]] [data ["." product] [text @@ -147,20 +147,34 @@ (host.array-write 3 (:coerce java/lang/Object state))) method)))) -(program: [{configuration /cli.configuration}] - (let [jar-path (format (get@ #/cli.target configuration) (:: file.system separator) "program.jar")] - (exec (/.compiler {#/static.host @.jvm - #/static.host-module-extension ".jvm" - #/static.target (get@ #/cli.target configuration) - #/static.artifact-extension ".class"} - ..expander - analysis.bundle - ..platform - ## generation.bundle - translation.bundle - (directive.bundle ..extender) - jvm/program.program - ..extender - configuration - [(packager.package jvm/program.class) jar-path]) +(def: (target service) + (-> /cli.Service /cli.Target) + (case service + (^or (#/cli.Compilation [sources target module]) + (#/cli.Interpretation [sources target module]) + (#/cli.Export [sources target])) + target)) + +(def: (declare-success! _) + (-> Any (Promise Any)) + (promise.future (io.exit +0))) + +(program: [{service /cli.service}] + (let [jar-path (format (..target service) (:: file.system separator) "program.jar")] + (exec (do promise.monad + [_ (/.compiler {#/static.host @.jvm + #/static.host-module-extension ".jvm" + #/static.target (..target service) + #/static.artifact-extension ".class"} + ..expander + analysis.bundle + ..platform + ## generation.bundle + translation.bundle + (directive.bundle ..extender) + jvm/program.program + ..extender + service + [(packager.package jvm/program.class) jar-path])] + (..declare-success! [])) (io.io [])))) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 3c4c26f59..9c82788ad 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -168,7 +168,8 @@ (def: &functor ..functor) (def: (wrap a) - (function (_ tx) [tx a])) + (function (_ tx) + [tx a])) (def: (join mma) (function (_ tx) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index 5bfe690e3..d53f103cf 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -56,11 +56,15 @@ (f (function (_ a) (function (_ ic) (ic (oc a)))) function.identity))) -(structure: #export functor (All [o] (Functor (All [i] (Cont i o)))) +(structure: #export functor + (All [o] (Functor (All [i] (Cont i o)))) + (def: (map f fv) (function (_ k) (fv (function.compose k f))))) -(structure: #export apply (All [o] (Apply (All [i] (Cont i o)))) +(structure: #export apply + (All [o] (Apply (All [i] (Cont i o)))) + (def: &functor ..functor) (def: (apply ff fv) @@ -69,7 +73,9 @@ (function (_ v)) fv (function (_ f)) ff)))) -(structure: #export monad (All [o] (Monad (All [i] (Cont i o)))) +(structure: #export monad + (All [o] (Monad (All [i] (Cont i o)))) + (def: &functor ..functor) (def: (wrap value) diff --git a/stdlib/source/lux/control/function/contract.lux b/stdlib/source/lux/control/function/contract.lux index 3d1359fdf..1c9236877 100644 --- a/stdlib/source/lux/control/function/contract.lux +++ b/stdlib/source/lux/control/function/contract.lux @@ -1,20 +1,26 @@ (.module: [lux #* - [abstract - monad] [control - [parser - ["s" code]]] + ["." exception (#+ exception:)]] [data [number ["i" int]] [text ["%" format (#+ format)]]] [macro (#+ with-gensyms) - ["." code] - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)] + ["." code]]]) -(def: #export (assert! message test) +(template [<name>] + [(exception: (<name> {condition Code}) + (exception.report + ["Condition" (%.code condition)]))] + + [pre-condition-failed] + [post-condition-failed] + ) + +(def: (assert! message test) (-> Text Bit []) (if test [] @@ -26,8 +32,8 @@ "Otherwise, an error is raised." (pre (i.= +4 (i.+ +2 +2)) (foo +123 +456 +789)))} - (wrap (list (` (exec (assert! (~ (code.text (format "Pre-condition failed: " (%.code test)))) - (~ test)) + (wrap (list (` (exec ((~! ..assert!) (~ (code.text (exception.construct ..pre-condition-failed test))) + (~ test)) (~ expr)))))) (syntax: #export (post test expr) @@ -39,6 +45,6 @@ (i.+ +2 +2)))} (with-gensyms [g!output] (wrap (list (` (let [(~ g!output) (~ expr)] - (exec (assert! (~ (code.text (format "Post-condition failed: " (%.code test)))) - ((~ test) (~ g!output))) + (exec ((~! ..assert!) (~ (code.text (exception.construct ..post-condition-failed test))) + ((~ test) (~ g!output))) (~ g!output)))))))) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 42e8103e7..b803e6453 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -686,10 +686,7 @@ (Writer Path) (..header-writer {#path ..no-path - #mode ($_ ..and - ..read-by-other - ..read-by-group - ..read-by-owner) + #mode ..none #user-id ..no-id #group-id ..no-id #size (..coerce-big 0) @@ -707,10 +704,7 @@ (Writer Path) (..header-writer {#path path - #mode ($_ ..and - ..read-by-other - ..read-by-group - ..read-by-owner) + #mode ..none #user-id ..no-id #group-id ..no-id #size (..coerce-big 0) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 4cec42038..5f117325c 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -52,7 +52,7 @@ ["ioW" archive]]]]] [program [compositor - ["." cli (#+ Configuration)] + ["." cli (#+ Compilation)] ["." static (#+ Static)]]]) (type: #export (Platform anchor expression directive) @@ -351,10 +351,11 @@ try.assume product.left)) - (def: #export (compile static expander platform configuration context) + (def: #export (compile static expander platform compilation context) (All [<type-vars>] - (-> Static Expander <Platform> Configuration <Context> <Return>)) - (let [base-compiler (:share [<type-vars>] + (-> Static Expander <Platform> Compilation <Context> <Return>)) + (let [[compilation-sources compilation-target compilation-module] compilation + base-compiler (:share [<type-vars>] {<Context> context} {(///.Compiler <State+> .Module Any) @@ -366,7 +367,7 @@ (do (try.with promise.monad) [#let [state (..set-current-module module state)] input (context.read (get@ #&file-system platform) - (get@ #cli.sources configuration) + compilation-sources (get@ #static.host-module-extension static) module)] (loop [[archive state] [archive state] @@ -429,6 +430,6 @@ (promise@wrap (#try.Failure error)))) )) )))] - (parallel-compiler (get@ #cli.module configuration)) + (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 b95e02ee9..574b24290 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -2,7 +2,8 @@ [lux (#- Module Code) ["@" target] [abstract - [monad (#+ Monad do)]] + [predicate (#+ Predicate)] + ["." monad (#+ Monad do)]] [control ["." try (#+ Try)] ["." exception (#+ Exception exception:)] @@ -14,7 +15,9 @@ [binary (#+ Binary)] ["." text ("#@." hash) ["%" format (#+ format)] - ["." encoding]]] + ["." encoding]] + [collection + ["." dictionary (#+ Dictionary)]]] [world ["." file (#+ Path File)]]] ["." // (#+ Context Code) @@ -55,7 +58,7 @@ (#.Cons context contexts') (do promise.monad [#let [path (format (..path system context module) extension)] - file (!.use (:: system file) path)] + file (!.use (:: system file) [path])] (case file (#try.Success file) (wrap (#try.Success [path file])) @@ -63,20 +66,23 @@ (#try.Failure _) (find-source-file system contexts' module extension))))) +(def: (full-host-extension partial-host-extension) + (-> 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)]))) - (let [full-host-extension (format partial-host-extension lux-extension)] - ## 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)] - (case outcome - (#try.Success output) - (wrap outcome) + ## 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 output) + (wrap outcome) - (#try.Failure _) - (find-source-file system contexts module ..lux-extension))))) + (#try.Failure _) + (find-source-file system contexts module ..lux-extension)))) (def: #export (read system contexts partial-host-extension module) (-> (file.System Promise) (List Context) Extension Module @@ -93,3 +99,59 @@ (#try.Failure _) (promise@wrap (exception.throw ..cannot-read-module [module]))))) + +(type: #export Enumeration + (Dictionary Path Binary)) + +(exception: #export (cannot-clean-path {prefix Path} {path Path}) + (exception.report + ["Prefix" (%.text prefix)] + ["Path" (%.text path)])) + +(def: (clean-path system context path) + (All [!] (-> (file.System !) Context Path (Try Path))) + (let [prefix (format context (:: system separator))] + (case (text.split-with prefix path) + #.None + (exception.throw ..cannot-clean-path [prefix path]) + + (#.Some [_ path]) + (#try.Success path)))) + +(def: (enumerate-context system partial-host-extension context enumeration) + (-> (file.System Promise) Extension Context Enumeration + (Promise (Try Enumeration))) + (do {@ (try.with promise.monad)} + [directory (!.use (:: system directory) [context])] + (loop [directory directory + enumeration enumeration] + (do @ + [files (!.use (:: directory files) []) + enumeration (monad.fold @ (let [full-host-extension (..full-host-extension partial-host-extension)] + (function (_ file enumeration) + (let [path (!.use (:: file path) [])] + (if (or (text.ends-with? full-host-extension path) + (text.ends-with? ..lux-extension path)) + (do @ + [path (promise@wrap (..clean-path system context path)) + source-code (!.use (:: file content) [])] + (promise@wrap + (dictionary.try-put path source-code enumeration))) + (wrap enumeration))))) + enumeration + files) + directories (!.use (:: directory directories) [])] + (monad.fold @ recur enumeration directories))))) + +(def: Action + (type (All [a] (Promise (Try a))))) + +(def: #export (enumerate system partial-host-extension contexts) + (-> (file.System Promise) Extension (List Context) + (Action Enumeration)) + (monad.fold (: (Monad Action) + (try.with promise.monad)) + (enumerate-context system partial-host-extension) + (: Enumeration + (dictionary.new text.hash)) + contexts)) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 8993f21e7..d431198fa 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -49,8 +49,9 @@ ## ["." interpreter] ]] ["." / #_ - ["#." cli (#+ Configuration)] - ["#." static (#+ Static)]]) + ["#." cli (#+ Service)] + ["#." static (#+ Static)] + ["#." export]]) (def: (or-crash! failure-description action) (All [a] @@ -70,7 +71,7 @@ (with-expansions [<parameters> (as-is anchor expression artifact)] (def: #export (compiler static expander host-analysis platform generation-bundle host-directive-bundle program extender - configuration + service packager,package) (All [<parameters>] (-> Static @@ -81,7 +82,7 @@ (directive.Bundle <parameters>) (-> expression artifact) Extender - Configuration + Service [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path] (Promise Any))) (do {@ promise.monad} @@ -89,27 +90,36 @@ console (|> console.system promise.future (:: @ map (|>> try.assume console.async)))] - (case (get@ #/cli.service configuration) - #/cli.Compilation + (case service + (#/cli.Compilation compilation) (<| (or-crash! "Compilation failed:") (do (try.with promise.monad) - [[state archive] (:share [<parameters>] + [#let [[compilation-sources compilation-target compilation-module] compilation] + [state archive] (:share [<parameters>] {(Platform <parameters>) platform} {(Promise (Try [(directive.State+ <parameters>) Archive])) - (:assume (platform.initialize static (get@ #/cli.module configuration) expander host-analysis platform generation-bundle host-directive-bundle program extender))}) + (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program extender))}) [archive state] (:share [<parameters>] {(Platform <parameters>) platform} {(Promise (Try [Archive (directive.State+ <parameters>)])) - (:assume (platform.compile static expander platform configuration [archive state]))}) + (:assume (platform.compile 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!")))) + + (#/cli.Export export) + (<| (or-crash! "Export failed:") + (do (try.with promise.monad) + [_ (/export.export (get@ #platform.&file-system platform) + (get@ #/static.host-module-extension static) + export)] + (wrap (log! "Export complete!")))) - #/cli.Interpretation + (#/cli.Interpretation interpretation) ## TODO: Fix the interpreter... (undefined) ## (<| (or-crash! "Interpretation failed:") - ## (interpreter.run (try.with promise.monad) console platform configuration generation-bundle)) + ## (interpreter.run (try.with promise.monad) console platform interpretation generation-bundle)) )))) diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux index 0c20257ed..940665680 100644 --- a/stdlib/source/program/compositor/cli.lux +++ b/stdlib/source/program/compositor/cli.lux @@ -1,42 +1,55 @@ (.module: - [lux #* + [lux (#- Module Source) [control - ["p" parser + ["<>" parser ["." cli (#+ Parser)]]] + [tool + [compiler + [meta + [archive + [descriptor (#+ Module)]]]]] [world [file (#+ Path)]]]) -(type: #export Service - #Compilation - #Interpretation) +(type: #export Source Path) +(type: #export Target Path) + +(type: #export Compilation + [(List Source) Target Module]) + +(type: #export Export + [(List Source) Target]) -(type: #export Configuration - {#service Service - #sources (List Path) - #target Path - #module Text}) +(type: #export Service + (#Compilation Compilation) + (#Interpretation Compilation) + (#Export Export)) -(template [<name> <long>] +(template [<name> <long> <type>] [(def: <name> - (Parser Text) + (Parser <type>) (cli.named <long> cli.any))] - [source "--source"] - [target "--target"] - [module "--module"] + [source "--source" Source] + [target "--target" Target] + [module "--module" Module] ) - -(def: service +(def: #export service (Parser Service) - ($_ p.or - (cli.this "build") - (cli.this "repl"))) - -(def: #export configuration - (Parser Configuration) - ($_ p.and - ..service - (p.some ..source) - ..target - ..module)) + ($_ <>.or + (<>.after (cli.this "build") + ($_ <>.and + (<>.some ..source) + ..target + ..module)) + (<>.after (cli.this "repl") + ($_ <>.and + (<>.some ..source) + ..target + ..module)) + (<>.after (cli.this "export") + ($_ <>.and + (<>.some ..source) + ..target)) + )) diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux new file mode 100644 index 000000000..6e364800f --- /dev/null +++ b/stdlib/source/program/compositor/export.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise) ("#@." monad)]] + [security + ["!" capability]]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." dictionary] + ["." row]] + [format + ["." binary] + ["." tar]]] + [time + ["." instant]] + [tool + [compiler + [meta + ["." io #_ + ["#" context (#+ Extension)]]]]] + [world + ["." file]]] + [// + [cli (#+ Export)]]) + +(def: no-ownership + tar.Ownership + (let [commons (: tar.Owner + {#tar.name tar.anonymous + #tar.id tar.no-id})] + {#tar.user commons + #tar.group commons})) + +(def: #export (export system extension [sources target]) + (-> (file.System Promise) Extension Export (Promise (Try Any))) + (let [package (format target (:: system separator) "library.tar")] + (do (try.with promise.monad) + [package (: (Promise (Try (file.File Promise))) + (file.get-file promise.monad system package)) + files (io.enumerate system extension sources) + tar (|> (dictionary.entries files) + (monad.map try.monad + (function (_ [path source-code]) + (do try.monad + [path (tar.path path) + source-code (tar.content source-code)] + (wrap (#tar.Normal [path + (instant.from-millis +0) + tar.none + ..no-ownership + source-code]))))) + (:: try.monad map (|>> row.from-list (binary.run tar.writer))) + promise@wrap)] + (!.use (:: package over-write) tar)))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index dbfb5b4a4..5c7f7b9ef 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -5,7 +5,9 @@ ["#." concatenative] ["#." continuation] ["#." exception] - ["#." function] + ["#." function + ["#/." memo] + ["#/." contract]] ["#." try] ["#." io] ["#." parser] @@ -28,9 +30,7 @@ ["#/." text] ["#/." cli]] [security - ["#." policy]] - [function - ["#." memo]]]) + ["#." policy]]]) (def: concurrency Test @@ -44,9 +44,18 @@ /stm.test )) +(def: function + Test + ($_ _.and + /function.test + /function/memo.test + /function/contract.test + )) + (def: parser Test ($_ _.and + /parser.test /parser/text.test /parser/cli.test )) @@ -57,22 +66,16 @@ /policy.test )) -(def: function - Test - ($_ _.and - /memo.test - )) - (def: #export test Test ($_ _.and /concatenative.test /continuation.test /exception.test - /function.test + ..function /try.test /io.test - /parser.test + ..parser /pipe.test /reader.test /region.test @@ -81,7 +84,5 @@ /thread.test /writer.test ..concurrency - ..parser ..security - ..function )) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index ab795ea79..628aedfaf 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -11,6 +11,7 @@ [control ["." io (#+ IO)]] [data + ["." product] [number ["n" nat]] [collection @@ -31,17 +32,8 @@ (def: comparison (Comparison /.STM) (function (_ == left right) - (io.run - (do io.monad - [?left (promise.poll (/.commit left)) - ?right (promise.poll (/.commit right))] - (wrap (case [?left ?right] - [(#.Some left) - (#.Some right)] - (== left right) - - _ - false)))))) + (== (product.right (left (list))) + (product.right (right (list)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 1d07460c9..95aa5ec7a 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -11,78 +11,86 @@ [data [number ["n" nat]] - [text - ["%" format (#+ format)]] [collection ["." list]]] [math - ["r" random]]] + ["." random]]] {1 - ["." / (#+ Cont)]}) + ["." /]}) (def: injection - (All [o] (Injection (All [i] (Cont i o)))) + (All [o] (Injection (All [i] (/.Cont i o)))) (|>> /.pending)) (def: comparison - (Comparison Cont) + (Comparison /.Cont) (function (_ == left right) (== (/.run left) (/.run right)))) (def: #export test Test - (<| (_.context (%.name (name-of /.Cont))) - (do r.monad - [sample r.nat + (<| (_.covering /._) + (do random.monad + [sample random.nat #let [(^open "_@.") /.apply (^open "_@.") /.monad] - elems (r.list 3 r.nat)] - ($_ _.and - ($functor.spec ..injection ..comparison /.functor) - ($apply.spec ..injection ..comparison /.apply) - ($monad.spec ..injection ..comparison /.monad) + elems (random.list 3 random.nat)]) + (_.with-cover [/.Cont]) + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.test "Can run continuations to compute their values." - (n.= sample (/.run (_@wrap sample)))) + (_.cover [/.run] + (n.= sample (/.run (_@wrap sample)))) + (_.cover [/.call/cc] + (n.= (n.* 2 sample) + (/.run (do {@ /.monad} + [value (/.call/cc + (function (_ k) + (do @ + [temp (k sample)] + ## If this code where to run, + ## the output would be + ## (n.* 4 sample) + (k temp))))] + (wrap (n.* 2 value)))))) + (_.cover [/.portal] + (n.= (n.+ 100 sample) + (/.run (do /.monad + [[restart [output idx]] (/.portal [sample 0])] + (if (n.< 10 idx) + (restart [(n.+ 10 output) (inc idx)]) + (wrap output)))))) + (_.cover [/.shift /.reset] + (let [(^open "_@.") /.monad + (^open "list@.") (list.equivalence n.equivalence) + visit (: (-> (List Nat) + (/.Cont (List Nat) (List Nat))) + (function (visit xs) + (case xs + #.Nil + (_@wrap #.Nil) - (_.test "Can use the current-continuation as a escape hatch." - (n.= (n.* 2 sample) - (/.run (do {@ /.monad} - [value (/.call/cc - (function (_ k) - (do @ - [temp (k sample)] - ## If this code where to run, - ## the output would be - ## (n.* 4 sample) - (k temp))))] - (wrap (n.* 2 value)))))) - - (_.test "Can use the current-continuation to build a time machine." - (n.= (n.+ 100 sample) - (/.run (do /.monad - [[restart [output idx]] (/.portal [sample 0])] - (if (n.< 10 idx) - (restart [(n.+ 10 output) (inc idx)]) - (wrap output)))))) - - (_.test "Can use delimited continuations with shifting." - (let [(^open "_@.") /.monad - (^open "list@.") (list.equivalence n.equivalence) - visit (: (-> (List Nat) - (Cont (List Nat) (List Nat))) - (function (visit xs) - (case xs - #.Nil - (_@wrap #.Nil) - - (#.Cons x xs') - (do {@ /.monad} - [output (/.shift (function (_ k) - (do @ - [tail (k xs')] - (wrap (#.Cons x tail)))))] - (visit output)))))] - (list@= elems - (/.run (/.reset (visit elems)))))) - )))) + (#.Cons x xs') + (do {@ /.monad} + [output (/.shift (function (_ k) + (do @ + [tail (k xs')] + (wrap (#.Cons x tail)))))] + (visit output)))))] + (list@= elems + (/.run (/.reset (visit elems)))))) + (_.cover [/.continue] + (/.continue (is? sample) + (: (/.Cont Nat Bit) + (function (_ next) + (next sample))))) + (_.cover [/.pending] + (/.continue (is? sample) + (: (/.Cont Nat Bit) + (/.pending sample)))) + ))) diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux new file mode 100644 index 000000000..0cde16295 --- /dev/null +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -0,0 +1,39 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." host] + [abstract + [monad (#+ do)]] + [control + ["." try]] + [math + ["." random]] + [data + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {@ random.monad} + [expected random.nat]) + ($_ _.and + (_.cover [/.pre] + (case (host.try (/.pre (n.even? expected) + true)) + (#try.Success output) + output + + (#try.Failure error) + (not (n.even? expected)))) + (_.cover [/.post] + (case (host.try (/.post n.odd? + expected)) + (#try.Success actual) + (is? expected actual) + + (#try.Failure error) + (not (n.odd? expected)))) + ))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index b8ba1af51..ebbdd8f1e 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -152,7 +152,7 @@ Test (do {@ random.monad} [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (:: @ map (|>> (n.% 1,00,00,00,00,00,000) .int instant.from-millis) + expected-moment (:: @ map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) random.nat) chunk (random.ascii/lower-alpha chunk-size) chunks (:: @ map (n.% 100) random.nat) |