diff options
19 files changed, 115 insertions, 292 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 243308799..4d2f40277 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -60,17 +60,6 @@ ^:private analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe) ) -(defn ^:private analyse-text-contains? [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Cons part (&/$Nil))) ?values] - =text (&&/analyse-1 analyse &type/Text text) - =part (&&/analyse-1 analyse &type/Text part) - _ (&type/check exo-type &type/Bool) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["text" "contains?"]) - (&/|list =text =part) - (&/|list))))))) - (defn ^:private analyse-text-clip [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Cons from (&/$Cons to (&/$Nil)))) ?values] =text (&&/analyse-1 analyse &type/Text text) @@ -83,18 +72,6 @@ (&/|list =text =from =to) (&/|list))))))) -(defn ^:private analyse-text-replace-all [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Cons to-find (&/$Cons replace-with (&/$Nil)))) ?values] - =text (&&/analyse-1 analyse &type/Text text) - =to-find (&&/analyse-1 analyse &type/Text to-find) - =replace-with (&&/analyse-1 analyse &type/Text replace-with) - _ (&type/check exo-type &type/Text) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["text" "replace-all"]) - (&/|list =text =to-find =replace-with) - (&/|list))))))) - (do-template [<name> <proc>] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Nil)) ?values] @@ -449,9 +426,7 @@ "lux text index" (analyse-text-index analyse exo-type ?values) "lux text size" (analyse-text-size analyse exo-type ?values) "lux text hash" (analyse-text-hash analyse exo-type ?values) - "lux text replace-all" (analyse-text-replace-all analyse exo-type ?values) "lux text char" (analyse-text-char analyse exo-type ?values) - "lux text contains?" (analyse-text-contains? analyse exo-type ?values) "lux array new" (analyse-array-new analyse exo-type ?values) "lux array get" (analyse-array-get analyse exo-type ?values) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index aca1921fe..244e7baa8 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -408,36 +408,6 @@ ^:private compile-text-hash "java/lang/Object" "hashCode" ) -(defn ^:private compile-text-replace-all [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Cons ?pattern (&/$Cons ?replacement (&/$Nil)))) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?text) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] - _ (compile ?pattern) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] - _ (compile ?replacement) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "replace" "(Ljava/lang/CharSequence;Ljava/lang/CharSequence;)Ljava/lang/String;"))]] - (return nil))) - -(defn ^:private compile-text-contains? [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Cons ?sub (&/$Nil))) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?text) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] - _ (compile ?sub) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "contains" "(Ljava/lang/CharSequence;)Z") - &&/wrap-boolean)]] - (return nil))) - (defn ^:private compile-text-char [compile ?values special-args] (|do [:let [(&/$Cons ?text (&/$Cons ?idx (&/$Nil))) ?values] ^MethodVisitor *writer* &/get-writer @@ -657,9 +627,7 @@ "index" (compile-text-index compile ?values special-args) "size" (compile-text-size compile ?values special-args) "hash" (compile-text-hash compile ?values special-args) - "replace-all" (compile-text-replace-all compile ?values special-args) "char" (compile-text-char compile ?values special-args) - "contains?" (compile-text-contains? compile ?values special-args) ) "i64" diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux index 3f878319b..6ac2d6a0a 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux @@ -323,8 +323,6 @@ (install "index" (trinary text//index)) (install "size" (unary _.length)) (install "hash" (unary _.sxhash/1)) - ## (install "replace-once" (trinary text//replace-once)) - ## (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index d9e64d4a1..05cd0137b 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -270,22 +270,13 @@ (format "String.fromCharCode" "(" (int//to-frac inputJS) ")")) ## [[Text]] -(do-template [<name> <op>] - [(def: (<name> inputJS) - Unary - (format inputJS <op>))] - - [text//size ".length"] - ) - -(do-template [<name> <method>] - [(def: (<name> [subjectJS paramJS]) - Binary - (format subjectJS "." <method> "(" paramJS ")"))] +(def: (text//size inputJS) + Unary + (format inputJS ".length")) - [text//concat "concat"] - [text//contains? "includes"] - ) +(def: (text//concat [subjectJS paramJS]) + Binary + (format subjectJS "." "concat" "(" paramJS ")")) (def: (text//char [subjectJS paramJS]) Binary @@ -296,18 +287,11 @@ Trinary (format <runtime> "(" subjectJS "," paramJS "," extraJS ")"))] - [text//clip runtimeT.text//clip] - [text//replace-all runtimeT.text//replace-all] + [text//clip runtimeT.text//clip] + [text//index runtimeT.text//index] + ) -(def: (text//replace-once [subjectJS paramJS extraJS]) - Trinary - (format subjectJS ".replace(" paramJS "," extraJS ")")) - -(def: (text//index [textJS partJS startJS]) - Trinary - (format runtimeT.text//index "(" textJS "," partJS "," startJS ")")) - ## [[Math]] (do-template [<name> <method>] [(def: (<name> inputJS) @@ -466,8 +450,6 @@ (install "index" (trinary text//index)) (install "size" (unary text//size)) (install "hash" (unary text//hash)) - (install "replace-once" (trinary text//replace-once)) - (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux index 6039a33c7..267a3e637 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -580,12 +580,6 @@ "}") "})")) -(runtime: text//replace-all "replaceAll" - (format "(function " @ "(text,toFind,replaceWith) {" - "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');" - "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);" - "})")) - (runtime: text//char "textChar" (format "(function " @ "(text,idx) {" "var result = text.charCodeAt(idx.L);" @@ -610,7 +604,6 @@ Runtime (format __text//index __text//clip - __text//replace-all __text//char __text//hash)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index c60c424f5..06909b5d1 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -348,9 +348,6 @@ [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false) id] - [text//contains? ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "contains" ($t.method (list $CharSequence) (#.Some $t.boolean) (list)) false) - ($i.wrap #$.Boolean)] [text//char ($i.CHECKCAST "java.lang.String") jvm-intI ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) false) id] @@ -367,16 +364,6 @@ [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI ($i.INVOKESTATIC hostL.runtime-class "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) false)] - [text//replace-once ($i.CHECKCAST "java.lang.String") - (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false) - ($i.CHECKCAST "java.lang.String")) - ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t.method (list $String $String) (#.Some $String) (list)) false)] - [text//replace-all ($i.CHECKCAST "java.lang.String") - (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false) - ($i.CHECKCAST "java.lang.String")) - ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t.method (list $String $String) (#.Some $String) (list)) false)] ) (def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list))) @@ -606,8 +593,6 @@ (install "index" (trinary text//index)) (install "size" (unary text//size)) (install "hash" (unary text//hash)) - (install "replace-once" (trinary text//replace-once)) - (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index b54829a62..67aa5417a 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -284,12 +284,6 @@ Binary (format "(" subjectO " .. " paramO ")")) -(def: (text//contains? [subjectO paramO]) - Binary - (|> (lua.apply "string.find" (list subjectO paramO (lua.int 1) (lua.bool true))) - (lua.= lua.nil) - lua.not)) - (def: (text//char [subjectO paramO]) Binary (runtimeT.text//char subjectO paramO)) @@ -299,15 +293,10 @@ Trinary (<runtime> subjectO paramO extraO))] - [text//clip runtimeT.text//clip] - [text//replace-all runtimeT.text//replace-all] - [text//replace-once runtimeT.text//replace-once] + [text//clip runtimeT.text//clip] + [text//index runtimeT.text//index] ) -(def: (text//index [textO partO startO]) - Trinary - (runtimeT.text//index textO partO startO)) - ## [[Math]] (do-template [<name> <method>] [(def: (<name> inputO) @@ -451,8 +440,6 @@ (install "index" (trinary text//index)) (install "size" (unary text//size)) (install "hash" (unary text//hash)) - (install "replace-once" (trinary text//replace-once)) - (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux index 5a0d62225..9e7dc7422 100644 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux @@ -201,35 +201,6 @@ (lua.return! none) (lua.return! (some (lua.apply "string.sub" (list text from to)))))))) -(runtime: (text//replace-once text to-find replacement) - (let [find-index (lua.apply "string.find" (list text to-find (lua.int 1) (lua.bool true)))] - (lua.block! (list (lua.local! "findSize" (#.Some (lua.apply "string.len" (list to-find)))) - (lua.local! "parts" (#.Some (lua.array (list)))) - (lua.local! "idx" (#.Some find-index)) - (lua.when! (lua.not (lua.= lua.nil "idx")) - (let [find-pre (lua.apply "string.sub" (list text (lua.int 1) "idx")) - find-post (lua.apply "string.sub" (list text "idx" (lua.+ "idx" "findSize")))] - (lua.block! (list (lua.apply "table.insert" (list "parts" find-pre)) - (lua.apply "table.insert" (list "parts" replacement)) - (lua.set! text find-post))))) - (lua.apply "table.insert" (list "parts" text)) - (lua.return! (lua.apply "table.concat" (list "parts"))))))) - -(runtime: (text//replace-all text to-find replacement) - (let [find-index (lua.apply "string.find" (list text to-find (lua.int 1) (lua.bool true)))] - (lua.block! (list (lua.local! "findSize" (#.Some (lua.apply "string.len" (list to-find)))) - (lua.local! "parts" (#.Some (lua.array (list)))) - (lua.local! "idx" (#.Some find-index)) - (lua.while! (lua.not (lua.= lua.nil "idx")) - (let [find-pre (lua.apply "string.sub" (list text (lua.int 1) (lua.- (lua.int 1) "idx"))) - find-post (lua.apply "string.sub" (list text (lua.+ "findSize" "idx")))] - (lua.block! (list (lua.apply "table.insert" (list "parts" find-pre)) - (lua.apply "table.insert" (list "parts" replacement)) - (lua.set! text find-post) - (lua.set! "idx" find-index))))) - (lua.apply "table.insert" (list "parts" text)) - (lua.return! (lua.apply "table.concat" (list "parts"))))))) - (runtime: (text//char text idx) (lua.block! (list (lua.local! "char" (#.Some (lua.apply "string.byte" (list text idx)))) (lua.if! (lua.= lua.nil "char") @@ -249,8 +220,6 @@ Runtime (format @@text//index @@text//clip - @@text//replace-once - @@text//replace-all @@text//char @@text//hash)) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux index 73185ff66..8f11d98a3 100644 --- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -317,14 +317,6 @@ ## Binary ## (runtimeT.text//char subjectO paramO)) -## (def: (text//replace-all [subjectO paramO extraO]) -## Trinary -## (_.send (list paramO extraO) "replace" subjectO)) - -## (def: (text//replace-once [subjectO paramO extraO]) -## Trinary -## (_.send (list paramO extraO (_.int 1)) "replace" subjectO)) - ## (def: (text//clip [subjectO paramO extraO]) ## Trinary ## (runtimeT.text//clip subjectO paramO extraO)) @@ -343,8 +335,6 @@ ## (install "index" (trinary text//index)) ## (install "size" (unary (apply1 (_.global "len")))) ## (install "hash" (unary (apply1 (_.global "hash")))) -## (install "replace-once" (trinary text//replace-once)) -## (install "replace-all" (trinary text//replace-all)) ## (install "char" (binary text//char)) ## (install "clip" (trinary text//clip)) ## ))) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index e2ab5113c..7dbeb2ab5 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -337,14 +337,6 @@ Binary (runtimeT.text//char subjectO paramO)) -(def: (text//replace-all [subjectO paramO extraO]) - Trinary - (python.send (list paramO extraO) "replace" subjectO)) - -(def: (text//replace-once [subjectO paramO extraO]) - Trinary - (python.send (list paramO extraO (python.int 1)) "replace" subjectO)) - (def: (text//clip [subjectO paramO extraO]) Trinary (runtimeT.text//clip subjectO paramO extraO)) @@ -363,8 +355,6 @@ (install "index" (trinary text//index)) (install "size" (unary (apply1 (python.global "len")))) (install "hash" (unary (apply1 (python.global "hash")))) - (install "replace-once" (trinary text//replace-once)) - (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index 9d4fdce2a..ea85aef1e 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -319,14 +319,6 @@ Binary (runtimeT.text//char subjectO paramO)) -(def: (text//replace-all [textO patternO replacementO]) - Trinary - (r.apply (list patternO replacementO textO) (r.global "gsub"))) - -(def: (text//replace-once [textO patternO replacementO]) - Trinary - (r.apply (list patternO replacementO textO) (r.global "sub"))) - (def: (text//clip [subjectO paramO extraO]) Trinary (runtimeT.text//clip subjectO paramO extraO)) @@ -345,8 +337,6 @@ (install "index" (trinary text//index)) (install "size" (unary (|>> (apply1 (r.global "nchar")) runtimeT.int//from-float))) (install "hash" (unary runtimeT.text//hash)) - (install "replace-once" (trinary text//replace-once)) - (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index 1b90e322a..7ea0df048 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -347,23 +347,10 @@ Binary (|> subjectO (ruby.+ paramO))) -(def: (text//contains? [subjectO paramO]) - Binary - (ruby.send "include?" (list paramO) subjectO)) - (def: (text//char [subjectO paramO]) Binary (runtimeT.text//char subjectO paramO)) -(do-template [<name> <method>] - [(def: (<name> [subjectO paramO extraO]) - Trinary - (ruby.send <method> (list paramO extraO) subjectO))] - - [text//replace-all "gsub"] - [text//replace-once "sub"] - ) - (def: (text//clip [subjectO paramO extraO]) Trinary (runtimeT.text//clip subjectO paramO extraO)) @@ -382,8 +369,6 @@ (install "index" (trinary text//index)) (install "size" (unary text//size)) (install "hash" (unary text//hash)) - (install "replace-once" (trinary text//replace-once)) - (install "replace-all" (trinary text//replace-all)) (install "char" (binary text//char)) (install "clip" (trinary text//clip)) ))) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index 8b6e5f4d9..d12a5f87d 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -271,32 +271,6 @@ (#e.Error error) (exec (log! error) false)))) - (test "Can replace sub-text once." - (|> (run (` ("lux text =" - (~ (code.text post-rep-once)) - ("lux text replace-once" - (~ (code.text pre-rep-once)) - (~ sample1S) - (~ sample2S))))) - (case> (#e.Success valueV) - (:coerce Bool valueV) - - (#e.Error error) - (exec (log! error) - false)))) - (test "Can replace sub-text all times." - (|> (run (` ("lux text =" - (~ (code.text post-rep-all)) - ("lux text replace-all" - (~ (code.text pre-rep-all)) - (~ sample1S) - (~ sample2S))))) - (case> (#e.Success valueV) - (:coerce Bool valueV) - - (#e.Error error) - (exec (log! error) - false)))) (let [test-clip (function (_ from to expected) (|> (run (` ("lux text clip" (~ concatenatedS) 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<Maybe> + [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<Text,Nat>)] 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 [<type> <test>] @@ -140,7 +141,7 @@ Frac (f// 0.0 <numerator>))] - [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> <nat> <int> <rev> <frac> <error> <doc>] [(macro: #export (<macro> 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<List>)]] [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<Maybe> + [[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<Text>) - -(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<Text>) @@ -176,9 +170,8 @@ (def: #export concat (-> (List Text) Text) - (let [(^open) list.Fold<List> - (^open) Monoid<Text>] - (|>> list.reverse (fold text/compose identity)))) + (let [(^open) Monoid<Text>] + (|>> 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<Maybe> - [[pre post] (split-with pattern template) - #let [(^open) Monoid<Text>]] - (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>] - ($_ 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)))) ))) diff --git a/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux b/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux index 59d1d955a..acb58e426 100644 --- a/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux @@ -169,10 +169,6 @@ (check-success+ "lux text size" (list subjectC) Nat)) (test "Can calculate a hash code for text." (check-success+ "lux text hash" (list subjectC) Nat)) - (test "Can replace a text inside of a larger one (once)." - (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text)) - (test "Can replace a text inside of a larger one (all times)." - (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text)) (test "Can obtain the character code of a text at a given index." (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat)))) (test "Can clip a piece of text between 2 indices." |