From 68b1dd82f23d6648ac3d9075a8f84b0174392945 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 17 Dec 2020 22:03:54 -0400 Subject: More optimizations to the Lux syntax parser. --- stdlib/source/test/lux/control/concurrency/frp.lux | 2 +- .../source/test/lux/control/concurrency/thread.lux | 16 ++-- stdlib/source/test/lux/control/parser/text.lux | 3 +- stdlib/source/test/lux/data/format/tar.lux | 3 +- stdlib/source/test/lux/data/text.lux | 3 +- stdlib/source/test/lux/data/text/unicode.lux | 91 --------------------- stdlib/source/test/lux/data/text/unicode/set.lux | 93 ++++++++++++++++++++++ stdlib/source/test/lux/macro/syntax/common.lux | 6 +- .../source/test/lux/macro/syntax/common/check.lux | 35 ++++++++ 9 files changed, 151 insertions(+), 101 deletions(-) delete mode 100644 stdlib/source/test/lux/data/text/unicode.lux create mode 100644 stdlib/source/test/lux/data/text/unicode/set.lux create mode 100644 stdlib/source/test/lux/macro/syntax/common/check.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 3e0aee4f0..933a599c0 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -171,7 +171,7 @@ actual)))) (let [polling-delay 1 amount-of-polls 5 - wiggle-room ($_ n.* amount-of-polls 2 polling-delay) + wiggle-room ($_ n.* amount-of-polls 4 polling-delay) total-delay (|> polling-delay (n.* amount-of-polls) (n.+ wiggle-room))] diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index 210ff4b1d..f8abf6a84 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -26,7 +26,8 @@ (do {! random.monad} [dummy random.nat expected random.nat - delay (|> random.nat (\ ! map (n.% 100)))] + delay (\ ! map (|>> (n.% 5) (n.+ 5)) + random.nat)] ($_ _.and (_.cover [/.parallelism] (n.> 0 /.parallelism)) @@ -37,10 +38,15 @@ (/.schedule delay (do io.monad [execution-time instant.now] (atom.write [execution-time expected] box)))) - _ (promise.wait delay) + _ (promise.wait (n.* 2 delay)) [execution-time actual] (promise.future (atom.read box))] (_.cover' [/.schedule] - (and (i.>= (.int delay) - (duration.to-millis (instant.span reference-time execution-time))) - (n.= expected actual))))) + (let [expected-delay! + (i.>= (.int delay) + (duration.to-millis (instant.span reference-time execution-time))) + + correct-value! + (n.= expected actual)] + (and expected-delay! + correct-value!))))) )))) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 7c1f5d932..dd5f4d6a8 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -11,7 +11,8 @@ ["." maybe] ["." text ("#\." equivalence) ["%" format (#+ format)] - ["." unicode + ["." unicode #_ + ["#" set] ["#/." segment]]] [number ["n" nat]] diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 73ccec27f..92f5915c7 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -15,7 +15,8 @@ ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding] - ["." unicode + ["." unicode #_ + ["#" set] ["#/." segment]]] [number ["n" nat] diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index b9dfdb1a9..c751e6a78 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -24,7 +24,8 @@ ["#." encoding] ["#." format] ["#." regex] - ["#." unicode]] + ["#." unicode #_ + ["#" set]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/text/unicode.lux b/stdlib/source/test/lux/data/text/unicode.lux deleted file mode 100644 index 1b47c8cdb..000000000 --- a/stdlib/source/test/lux/data/text/unicode.lux +++ /dev/null @@ -1,91 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - {[0 #spec] - [/ - ["$." equivalence]]}] - [data - ["." product] - ["." bit ("#\." equivalence)] - [number - ["n" nat]] - [collection - ["." set ("#\." equivalence)]]] - [math - ["." random (#+ Random)]]] - ["." / #_ - ["#." segment]] - {1 - ["." / - ["." segment]]}) - -(def: #export random - (Random /.Set) - (do {! random.monad} - [left /segment.random - right /segment.random] - (wrap (/.set [left (list right)])))) - -(def: #export test - Test - (<| (_.covering /._) - (_.for [/.Set]) - (do {! random.monad} - [segment /segment.random - inside (\ ! map - (|>> (n.% (segment.size segment)) - (n.+ (segment.start segment))) - random.nat) - left /segment.random - right /segment.random - #let [equivalence (product.equivalence n.equivalence - n.equivalence)]] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.range] - (let [[start end] (/.range (/.set [left (list right)]))] - (and (n.= (n.min (segment.start left) - (segment.start right)) - start) - (n.= (n.max (segment.end left) - (segment.end right)) - end)))) - (_.cover [/.member?] - (bit\= (segment.within? segment inside) - (/.member? (/.set [segment (list)]) inside))) - (_.cover [/.compose] - (\ equivalence = - [(n.min (segment.start left) - (segment.start right)) - (n.max (segment.end left) - (segment.end right))] - (/.range (/.compose (/.set [left (list)]) - (/.set [right (list)]))))) - (_.cover [/.set] - (\ equivalence = - (/.range (/.compose (/.set [left (list)]) - (/.set [right (list)]))) - (/.range (/.set [left (list right)])))) - (~~ (template [] - [(do random.monad - [char (random.char ) - #let [[start end] (/.range )]] - (_.cover [] - (and (/.member? char) - (not (/.member? (dec start))) - (not (/.member? (inc end))))))] - - [/.ascii] - [/.ascii/alpha] - [/.ascii/alpha-num] - [/.ascii/lower-alpha] - [/.ascii/upper-alpha] - [/.full] - )) - - /segment.test - ))))) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux new file mode 100644 index 000000000..21c5a90f1 --- /dev/null +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -0,0 +1,93 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [data + ["." product] + ["." bit ("#\." equivalence)] + [number + ["n" nat]] + [collection + ["." set ("#\." equivalence)]]] + [math + ["." random (#+ Random)]]] + ["." / #_ + ["/#" // #_ + ["#." segment]]] + {1 + ["." / + [// + ["." segment]]]}) + +(def: #export random + (Random /.Set) + (do {! random.monad} + [left //segment.random + right //segment.random] + (wrap (/.set [left (list right)])))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Set]) + (do {! random.monad} + [segment //segment.random + inside (\ ! map + (|>> (n.% (segment.size segment)) + (n.+ (segment.start segment))) + random.nat) + left //segment.random + right //segment.random + #let [equivalence (product.equivalence n.equivalence + n.equivalence)]] + (`` ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.range] + (let [[start end] (/.range (/.set [left (list right)]))] + (and (n.= (n.min (segment.start left) + (segment.start right)) + start) + (n.= (n.max (segment.end left) + (segment.end right)) + end)))) + (_.cover [/.member?] + (bit\= (segment.within? segment inside) + (/.member? (/.set [segment (list)]) inside))) + (_.cover [/.compose] + (\ equivalence = + [(n.min (segment.start left) + (segment.start right)) + (n.max (segment.end left) + (segment.end right))] + (/.range (/.compose (/.set [left (list)]) + (/.set [right (list)]))))) + (_.cover [/.set] + (\ equivalence = + (/.range (/.compose (/.set [left (list)]) + (/.set [right (list)]))) + (/.range (/.set [left (list right)])))) + (~~ (template [] + [(do random.monad + [char (random.char ) + #let [[start end] (/.range )]] + (_.cover [] + (and (/.member? char) + (not (/.member? (dec start))) + (not (/.member? (inc end))))))] + + [/.ascii] + [/.ascii/alpha] + [/.ascii/alpha-num] + [/.ascii/lower-alpha] + [/.ascii/upper-alpha] + [/.full] + )) + + //segment.test + ))))) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index 998671dd5..9fcb10006 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -27,7 +27,9 @@ ["#." reader] ["#." writer]]} ["." /// #_ - ["#." code]]) + ["#." code]] + ["." / #_ + ["#." check]]) (def: annotations-equivalence (Equivalence /.Annotations) @@ -132,4 +134,6 @@ (#try.Failure error) false)))) + + /check.test ))) diff --git a/stdlib/source/test/lux/macro/syntax/common/check.lux b/stdlib/source/test/lux/macro/syntax/common/check.lux new file mode 100644 index 000000000..63d042620 --- /dev/null +++ b/stdlib/source/test/lux/macro/syntax/common/check.lux @@ -0,0 +1,35 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["<>" parser + ["<.>" code]]] + [math + ["." random (#+ Random)]] + [macro + ["." code ("#\." equivalence)]]] + {1 + ["." /]} + ["$." //// #_ + ["#." code]]) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Check]) + (do random.monad + [type $////code.random + value $////code.random] + (_.cover [/.write /.parser] + (case (.run /.parser + (list (/.write {#/.type type + #/.value value}))) + (#try.Failure _) + false + + (#try.Success check) + (and (code\= type (get@ #/.type check)) + (code\= value (get@ #/.value check)))))))) -- cgit v1.2.3