From 0097e306a1e3b53e4cda304aac82b8778036eddf Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 11 Jul 2018 21:17:42 -0400 Subject: - Got rid of "lux text replace-once" and "lux text replace-all" extensions. --- stdlib/source/lux.lux | 26 ++++- stdlib/source/lux/data/collection/list.lux | 23 ++++- stdlib/source/lux/data/number.lux | 9 +- stdlib/source/lux/data/text.lux | 107 ++++++++++----------- .../compiler/extension/analysis/common.lux | 2 - 5 files changed, 104 insertions(+), 63 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 9dde82dc8..56fa96018 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -4144,9 +4144,33 @@ #import-refer {#refer-defs _referrals #refer-open _openings}}))))) +(def: (split at x) + (-> Nat Text (Maybe [Text Text])) + (case [(..clip2 +0 at x) (..clip1 at x)] + [(#.Some pre) (#.Some post)] + (#.Some [pre post]) + + _ + #.None)) + +(def: (split-with token sample) + (-> Text Text (Maybe [Text Text])) + (do ..Monad + [index (..index-of token sample) + pre+post' (split index sample) + #let [[pre post'] pre+post'] + _+post (split ("lux text size" token) post') + #let [[_ post] _+post]] + (wrap [pre post]))) + (def: (replace-all pattern value template) (-> Text Text Text Text) - ("lux text replace-all" template pattern value)) + (case (..split-with pattern template) + (#.Some [pre post]) + ($_ "lux text concat" pre value (replace-all pattern value post)) + + #.None + template)) (def: (count-ups ups input) (-> Nat Text Nat) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 7ea58354e..b3089a01e 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -8,7 +8,6 @@ [equivalence (#+ Equivalence)] [fold]] [data - [number ("nat/" Codec)] bool [product]]]) @@ -385,6 +384,28 @@ (-> Text Code) [["" +0 +0] (#.Symbol "" name)]) +(def: (nat/encode value) + (-> Nat Text) + (loop [input value + output ""] + (let [digit (case (n/% +10 input) + +0 "0" + +1 "1" + +2 "2" + +3 "3" + +4 "4" + +5 "5" + +6 "6" + +7 "7" + +8 "8" + +9 "9" + _ (undefined)) + output' ("lux text concat" digit output) + input' (n// +10 input)] + (if (n/= +0 input') + ("lux text concat" "+" output') + (recur input' output'))))) + (macro: #export (zip tokens state) {#.doc (doc "Create list zippers with the specified number of input lists." (def: #export zip2 (zip +2)) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 615565c16..1b2fc62d7 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,7 +12,8 @@ [data ["e" error] [maybe] - [bit]]]) + [bit] + [text]]]) ## [Structures] (do-template [ ] @@ -140,7 +141,7 @@ Frac (f// 0.0 ))] - [not-a-number 0.0 "Not a number."] + [not-a-number 0.0 "Not a number."] [positive-infinity 1.0 "Positive infinity."] [negative-infinity -1.0 "Negative infinity."] ) @@ -675,9 +676,9 @@ _ false)) -(def: (clean-underscores number) +(def: clean-underscores (-> Text Text) - ("lux text replace-all" number "_" "")) + (text.replace-all "_" "")) (do-template [ ] [(macro: #export ( tokens state) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index a7fbd8a18..6fc05aa9c 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -8,10 +8,9 @@ [codec (#+ Codec)] hash] [data - [collection [list]] + [collection [list ("list/" Fold)]] [maybe]]]) -## [Functions] (def: #export (size x) (-> Text Nat) ("lux text size" x)) @@ -20,27 +19,6 @@ (-> Nat Text (Maybe Nat)) ("lux text char" input idx)) -(def: #export (contains? sub text) - (-> Text Text Bool) - (case ("lux text index" text sub +0) - (#.Some _) - true - - _ - false)) - -(def: #export (clip from to input) - (-> Nat Nat Text (Maybe Text)) - ("lux text clip" input from to)) - -(def: #export (clip' from input) - (-> Nat Text (Maybe Text)) - ("lux text clip" input from (size input))) - -(def: #export (replace-all pattern value template) - (-> Text Text Text Text) - ("lux text replace-all" template pattern value)) - (def: #export (index-of' pattern from input) (-> Text Nat Text (Maybe Nat)) ("lux text index" input pattern from)) @@ -95,9 +73,26 @@ _ false)) +(def: #export (contains? sub text) + (-> Text Text Bool) + (case ("lux text index" text sub +0) + (#.Some _) + true + + _ + false)) + +(def: #export (clip from to input) + (-> Nat Nat Text (Maybe Text)) + ("lux text clip" input from to)) + +(def: #export (clip' from input) + (-> Nat Text (Maybe Text)) + ("lux text clip" input from (size input))) + (def: #export (split at x) (-> Nat Text (Maybe [Text Text])) - (case [(clip +0 at x) (clip' at x)] + (case [(..clip +0 at x) (..clip' at x)] [(#.Some pre) (#.Some post)] (#.Some [pre post]) @@ -114,7 +109,7 @@ (def: #export (split-all-with token sample) (-> Text Text (List Text)) - (case (split-with token sample) + (case (..split-with token sample) (#.Some [pre post]) (#.Cons pre (split-all-with token post)) @@ -122,9 +117,24 @@ (#.Cons sample #.Nil))) (def: #export split-lines - (split-all-with "\n")) + (..split-all-with "\n")) + +(def: #export (replace-once pattern value template) + (-> Text Text Text Text) + (<| (maybe.default template) + (do maybe.Monad + [[pre post] (split-with pattern template)] + (wrap ($_ "lux text concat" pre value post))))) + +(def: #export (replace-all pattern value template) + (-> Text Text Text Text) + (case (..split-with pattern template) + (#.Some [pre post]) + ($_ "lux text concat" pre value (replace-all pattern value post)) + + #.None + template)) -## [Structures] (structure: #export _ (Equivalence Text) (def: (= test subject) ("lux text =" subject test))) @@ -152,22 +162,6 @@ (def: (compose left right) ("lux text concat" left right))) -(open: "text/" Monoid) - -(def: #export (encode original) - (-> Text Text) - (let [escaped (|> original - (replace-all "\\" "\\\\") - (replace-all "\t" "\\t") - (replace-all "\v" "\\v") - (replace-all "\b" "\\b") - (replace-all "\n" "\\n") - (replace-all "\r" "\\r") - (replace-all "\f" "\\f") - (replace-all "\"" "\\\"") - )] - ($_ text/compose "\"" escaped "\""))) - (structure: #export _ (Hash Text) (def: eq Equivalence) @@ -176,9 +170,8 @@ (def: #export concat (-> (List Text) Text) - (let [(^open) list.Fold - (^open) Monoid] - (|>> list.reverse (fold text/compose identity)))) + (let [(^open) Monoid] + (|>> list.reverse (list/fold compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) @@ -190,25 +183,29 @@ "" true _ false)) -(def: #export (replace-once pattern value template) - (-> Text Text Text Text) - (maybe.default template - (do maybe.Monad - [[pre post] (split-with pattern template) - #let [(^open) Monoid]] - (wrap ($_ text/compose pre value post))))) - (def: #export (enclose [left right] content) {#.doc "Surrounds the given content text with left and right side additions."} (-> [Text Text] Text Text) (let [(^open) Monoid] - ($_ text/compose left content right))) + ($_ "lux text concat" left content right))) (def: #export (enclose' boundary content) {#.doc "Surrounds the given content text with the same boundary text."} (-> Text Text Text) (enclose [boundary boundary] content)) +(def: #export encode + (-> Text Text) + (|>> (replace-all "\\" "\\\\") + (replace-all "\t" "\\t") + (replace-all "\v" "\\v") + (replace-all "\b" "\\b") + (replace-all "\n" "\\n") + (replace-all "\r" "\\r") + (replace-all "\f" "\\f") + (replace-all "\"" "\\\"") + (..enclose' "\""))) + (def: #export from-code (-> Nat Text) (|>> (:coerce Int) "lux int char")) diff --git a/stdlib/source/lux/language/compiler/extension/analysis/common.lux b/stdlib/source/lux/language/compiler/extension/analysis/common.lux index 66189cec8..fff844417 100644 --- a/stdlib/source/lux/language/compiler/extension/analysis/common.lux +++ b/stdlib/source/lux/language/compiler/extension/analysis/common.lux @@ -208,8 +208,6 @@ (///bundle.install "index" (trinary Text Text Nat (type (Maybe Nat)))) (///bundle.install "size" (unary Text Nat)) (///bundle.install "hash" (unary Text Nat)) - (///bundle.install "replace-once" (trinary Text Text Text Text)) - (///bundle.install "replace-all" (trinary Text Text Text Text)) (///bundle.install "char" (binary Text Nat (type (Maybe Nat)))) (///bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) ))) -- cgit v1.2.3