diff options
author | Eduardo Julian | 2019-04-12 22:47:22 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-04-12 22:47:22 -0400 |
commit | 69d3c6200daf0570f27b719f2e12f06235b4077b (patch) | |
tree | 757d383d83dfa36a5ca075c3dccbccc5576c5405 /stdlib/source | |
parent | d2d6e69133ccfe7b2ee1723d1785e8cb3458678d (diff) |
Improvements and fixes to "tuple//left" and "tuple//right".
Diffstat (limited to '')
7 files changed, 116 insertions, 96 deletions
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 5e867b9b6..73b6dab3b 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -360,17 +360,15 @@ (do p.monad [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ - tail (p.some (p.after (l.this "|") sub^)) - #let [g!op (code.identifier ["" " alt "])]] + tail (p.some (p.after (l.this "|") sub^))] (if (list.empty? tail) (wrap head) (wrap [(list@fold n/max (product.left head) (list@map product.left tail)) - (` (let [(~ g!op) (~ (if capturing? - (` (~! |||^)) - (` (~! |||_^))))] - ($_ (~ g!op) - (~ (prep-alternative head)) - (~+ (list@map prep-alternative tail)))))])))) + (` ($_ ((~ (if capturing? + (` (~! |||^)) + (` (~! |||_^))))) + (~ (prep-alternative head)) + (~+ (list@map prep-alternative tail))))])))) (def: (re-scoped^ current-module) (-> Text (l.Lexer [Re-Group Code])) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index f492479d4..8908c3335 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -177,30 +177,33 @@ @lux//program-args )) -(runtime: (tuple//left lefts tuple) - (with-vars [last-index-right] - ($_ _.then - (_.define last-index-right (..last-index tuple)) - (_.if (_.> lefts last-index-right) - ## No need for recursion - (_.return (_.at lefts tuple)) - ## Needs recursion - (_.return (tuple//left (_.- last-index-right lefts) - (_.at last-index-right tuple))))))) - -(runtime: (tuple//right lefts tuple) - (with-vars [last-index-right right-index] - ($_ _.then - (_.define last-index-right (..last-index tuple)) - (_.define right-index (_.+ (_.i32 +1) lefts)) - (_.cond (list [(_.= right-index last-index-right) - (_.return (_.at right-index tuple))] - [(_.> right-index last-index-right) - ## Needs recursion. - (_.return (tuple//right (_.- last-index-right lefts) - (_.at last-index-right tuple)))]) - (_.return (_.do "slice" (list right-index) tuple))) - ))) +(with-expansions [<recur> (as-is ($_ _.then + (_.set lefts (_.- last-index-right lefts)) + (_.set tuple (_.at last-index-right tuple))))] + (runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] + (<| (_.while (_.boolean true)) + ($_ _.then + (_.define last-index-right (..last-index tuple)) + (_.if (_.> lefts last-index-right) + ## No need for recursion + (_.return (_.at lefts tuple)) + ## Needs recursion + <recur>))))) + + (runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index] + (<| (_.while (_.boolean true)) + ($_ _.then + (_.define last-index-right (..last-index tuple)) + (_.define right-index (_.+ (_.i32 +1) lefts)) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.at right-index tuple))] + [(_.> right-index last-index-right) + ## Needs recursion. + <recur>]) + (_.return (_.do "slice" (list right-index) tuple))) + ))))) (runtime: (sum//get sum wants-last wanted-tag) (let [no-match! (_.return _.null) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux index 5e45682d1..648d35d32 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux @@ -137,6 +137,9 @@ (def: last-index (|>> _.length (_.- (_.int +1)))) +## No need to turn tuple//left and tuple//right into loops, as Lua +## does tail-call optimization. +## https://www.lua.org/pil/6.3.html (runtime: (tuple//left lefts tuple) (with-vars [last-right] ($_ _.then diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index bdb0a8d2b..896b9e18a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -183,30 +183,33 @@ (def: last-index (|>> _.len/1 (_.- (_.int +1)))) -(runtime: (tuple//left lefts tuple) - (with-vars [last-index-right] - ($_ _.then - (_.set (list last-index-right) (..last-index tuple)) - (_.if (_.> lefts last-index-right) - ## No need for recursion - (_.return (_.nth lefts tuple)) - ## Needs recursion - (_.return (tuple//left (_.- last-index-right lefts) - (_.nth last-index-right tuple))))))) - -(runtime: (tuple//right lefts tuple) - (with-vars [last-index-right right-index] - ($_ _.then - (_.set (list last-index-right) (..last-index tuple)) - (_.set (list right-index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= right-index last-index-right) - (_.return (_.nth right-index tuple))] - [(_.> right-index last-index-right) - ## Needs recursion. - (_.return (tuple//right (_.- last-index-right lefts) - (_.nth last-index-right tuple)))]) - (_.return (_.slice-from right-index tuple))) - ))) +(with-expansions [<recur> (as-is ($_ _.then + (_.set (list lefts) (_.- last-index-right lefts)) + (_.set (list tuple) (_.nth last-index-right tuple))))] + (runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] + (<| (_.while (_.bool true)) + ($_ _.then + (_.set (list last-index-right) (..last-index tuple)) + (_.if (_.> lefts last-index-right) + ## No need for recursion + (_.return (_.nth lefts tuple)) + ## Needs recursion + <recur>))))) + + (runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index] + (<| (_.while (_.bool true)) + ($_ _.then + (_.set (list last-index-right) (..last-index tuple)) + (_.set (list right-index) (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.nth right-index tuple))] + [(_.> right-index last-index-right) + ## Needs recursion. + <recur>]) + (_.return (_.slice-from right-index tuple))) + ))))) (runtime: (sum//get sum wantsLast wantedTag) (let [no-match! (_.return _.none) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux index e39e6af8e..71edc3e07 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux @@ -135,30 +135,33 @@ (def: last-index (|>> ..tuple-size (_.- (_.int +1)))) -(runtime: (tuple//left lefts tuple) - (with-vars [last-index-right] - ($_ _.then - (_.set (list last-index-right) (..last-index tuple)) - (_.if (_.> lefts last-index-right) - ## No need for recursion - (_.return (_.nth lefts tuple)) - ## Needs recursion - (_.return (tuple//left (_.- last-index-right lefts) - (_.nth last-index-right tuple))))))) - -(runtime: (tuple//right lefts tuple) - (with-vars [last-index-right right-index] - ($_ _.then - (_.set (list last-index-right) (..last-index tuple)) - (_.set (list right-index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= right-index last-index-right) - (_.return (_.nth right-index tuple))] - [(_.> right-index last-index-right) - ## Needs recursion. - (_.return (tuple//right (_.- last-index-right lefts) - (_.nth last-index-right tuple)))]) - (_.return (_.array-range right-index (..tuple-size tuple) tuple))) - ))) +(with-expansions [<recur> (as-is ($_ _.then + (_.set (list lefts) (_.- last-index-right lefts)) + (_.set (list tuple) (_.nth last-index-right tuple))))] + (runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] + (<| (_.while (_.bool true)) + ($_ _.then + (_.set (list last-index-right) (..last-index tuple)) + (_.if (_.> lefts last-index-right) + ## No need for recursion + (_.return (_.nth lefts tuple)) + ## Needs recursion + <recur>))))) + + (runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index] + (<| (_.while (_.bool true)) + ($_ _.then + (_.set (list last-index-right) (..last-index tuple)) + (_.set (list right-index) (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.nth right-index tuple))] + [(_.> right-index last-index-right) + ## Needs recursion. + <recur>]) + (_.return (_.array-range right-index (..tuple-size tuple) tuple))) + ))))) (runtime: (sum//get sum wantsLast wantedTag) (let [no-match! (_.return _.nil) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 21e529ecc..fa6a511d5 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -381,8 +381,6 @@ (<| io _.run! (_.times 100) - ## (_.seed 16966479879996440699) - ## (_.seed 16140950815046933697) ## (_.seed 8804587020128699091) ## (_.seed 9353282359333487462) ..test)) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 58ef21b8b..a683c446f 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -8,11 +8,12 @@ ["p" parser]] [data [number (#+ hex)] + ["." error] ["." text ("#@." equivalence) ["." lexer (#+ Lexer)]]] [math ["r" random]] - [macro + ["." macro ["s" syntax (#+ syntax:)]]] {1 ["." /]}) @@ -20,7 +21,7 @@ (def: (should-pass regex input) (-> (Lexer Text) Text Bit) (|> (lexer.run input regex) - (case> (#.Right parsed) + (case> (#error.Success parsed) (text@= parsed input) _ @@ -29,24 +30,34 @@ (def: (text-should-pass test regex input) (-> Text (Lexer Text) Text Bit) (|> (lexer.run input regex) - (case> (#.Right parsed) + (case> (#error.Success parsed) (text@= test parsed) _ - #0))) + false))) (def: (should-fail regex input) (All [a] (-> (Lexer a) Text Bit)) (|> (lexer.run input regex) - (case> (#.Left _) #1 _ #0))) + (case> (#error.Failure _) + true + + _ + false))) (syntax: (should-check pattern regex input) - (wrap (list (` (|> (lexer.run (~ input) (~ regex)) - (case> (^ (#.Right (~ pattern))) - #1 + (macro.with-gensyms [g!message g!_] + (wrap (list (` (|> (lexer.run (~ input) (~ regex)) + (case> (^ (#error.Success (~ pattern))) + true - (~' _) - #0)))))) + (#error.Failure (~ g!message)) + (exec (log! (format "{{{Failure}}} " (~ g!message))) + false) + + (~ g!_) + (exec (log! (format "{{{Success}}} " "OH NO")) + false)))))))) (def: basics Test @@ -177,7 +188,9 @@ Test (let [number (/.regex "\d+")] (_.test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) + (should-check ["809-345-6789" "809" "345" "6789"] + (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") + "809-345-6789")))) (def: fuzzy-quantifiers Test @@ -244,15 +257,14 @@ (and (should-check ["a" (0 [])] (/.regex "a|b") "a") (should-check ["b" (1 [])] (/.regex "a|b") "b") (should-fail (/.regex "a|b") "c"))) - (_.test "Can have groups within alternations." (and (should-check ["abc" (0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") (should-check ["bcd" (1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") (should-fail (/.regex "a(.)(.)|b(.)(.)") "cde") - (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])] + (should-check ["123-456-7890" (0 ["123" "456-7890" "456" "7890"])] (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") - "809-345-6789"))) + "123-456-7890"))) )) (def: pattern-matching |