diff options
Diffstat (limited to '')
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 4 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 4 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 31 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/structure.lux | 75 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/syntax.lux | 66 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 8 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 94 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/xml.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 66 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number/complex.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text.lux | 54 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/lexer.lux | 4 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/number/complex.lux | 16 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/text.lux | 13 |
16 files changed, 249 insertions, 224 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 182c08d63..a1758f845 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -58,7 +58,6 @@ (&/|list))))))) ^:private analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe) - ^:private analyse-text-last-index "last-index" (&/$Apply &type/Nat &type/Maybe) ) (defn ^:private analyse-text-contains? [analyse exo-type ?values] @@ -77,7 +76,7 @@ =text (&&/analyse-1 analyse &type/Text text) =from (&&/analyse-1 analyse &type/Nat from) =to (&&/analyse-1 analyse &type/Nat to) - _ (&type/check exo-type (&/$Apply &type/Text &type/Maybe)) + _ (&type/check exo-type &type/Text) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "clip"]) @@ -489,7 +488,6 @@ "lux text concat" (analyse-text-concat analyse exo-type ?values) "lux text clip" (analyse-text-clip analyse exo-type ?values) "lux text index" (analyse-text-index analyse exo-type ?values) - "lux text last-index" (analyse-text-last-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) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index d7821e9af..e925c7fc0 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -512,7 +512,7 @@ &&/unwrap-long (.visitInsn Opcodes/L2I))] :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;"))]] + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)Ljava/lang/String;"))]] (return nil))) (do-template [<name> <method>] @@ -548,7 +548,6 @@ (return nil))) ^:private compile-text-index "indexOf" - ^:private compile-text-last-index "lastIndexOf" ) (do-template [<name> <class> <method>] @@ -828,7 +827,6 @@ "concat" (compile-text-concat compile ?values special-args) "clip" (compile-text-clip compile ?values special-args) "index" (compile-text-index compile ?values special-args) - "last-index" (compile-text-last-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) diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 83f02af3e..c26265f87 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -667,28 +667,15 @@ nil)) (defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] - (do (let [$from (new Label) - $to (new Label) - $handler (new Label) - $end (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;" nil nil) - (.visitCode) - (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") - (.visitLabel $from) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitVarInsn Opcodes/ILOAD 2) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") - (.visitLabel $end) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd))) + (do (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)Ljava/lang/String;" nil nil) + (.visitCode) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitVarInsn Opcodes/ILOAD 2) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)) (let [$from (new Label) $to (new Label) $handler (new Label)] diff --git a/new-luxc/source/luxc/lang/analysis/procedure.lux b/new-luxc/source/luxc/lang/analysis/procedure.lux index 9f5f61d59..8ab868036 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure.lux @@ -20,7 +20,7 @@ (def: #export (analyse-procedure analyse eval proc-name proc-args) (-> &;Analyser &;Eval Text (List Code) (Meta la;Analysis)) - (<| (maybe;default (&;throw Unknown-Procedure proc-name)) + (<| (maybe;default (&;throw Unknown-Procedure (%t proc-name))) (do maybe;Monad<Maybe> [proc (dict;get proc-name procedures)] (wrap ((proc proc-name) analyse eval proc-args))))) diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index 1f1ef15d7..d2107c640 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -85,26 +85,47 @@ [#;ExQ tc;var]) (#;Apply inputT funT) - (case (type;apply (list inputT) funT) - #;None - (&;throw Not-Quantified-Type (%type funT)) - - (#;Some outputT) - (&;with-expected-type outputT - (analyse-sum analyse tag valueC))) + (case funT + (#;Var funT-id) + (do @ + [?funT' (&;with-type-env (tc;read funT-id))] + (case ?funT' + (#;Some funT') + (&;with-expected-type (#;Apply inputT funT') + (analyse-sum analyse tag valueC)) + + _ + (&;throw Not-Variant-Type (format " Type: " (%type expectedT) "\n" + " Tag: " (%n tag) "\n" + "Value: " (%code valueC))))) + + _ + (case (type;apply (list inputT) funT) + #;None + (&;throw Not-Quantified-Type (%type funT)) + + (#;Some outputT) + (&;with-expected-type outputT + (analyse-sum analyse tag valueC)))) _ (&;throw Not-Variant-Type (format " Type: " (%type expectedT) "\n" " Tag: " (%n tag) "\n" "Value: " (%code valueC))))))) -(def: (analyse-typed-product analyse members) +(def: (analyse-typed-product analyse membersC+) (-> &;Analyser (List Code) (Meta la;Analysis)) (do meta;Monad<Meta> [expectedT meta;expected-type] (loop [expectedT expectedT - members members] - (case [expectedT members] + membersC+ membersC+] + (case [expectedT membersC+] + ## If the tuple runs out, whatever expression is the last gets + ## matched to the remaining type. + [tailT (#;Cons tailC #;Nil)] + (&;with-expected-type tailT + (analyse tailC)) + ## If the type and the code are still ongoing, match each ## sub-expression to its corresponding type. [(#;Product leftT rightT) (#;Cons leftC rightC)] @@ -114,12 +135,6 @@ rightA (recur rightT rightC)] (wrap (` [(~ leftA) (~ rightA)]))) - ## If the tuple runs out, whatever expression is the last gets - ## matched to the remaining type. - [tailT (#;Cons tailC #;Nil)] - (&;with-expected-type tailT - (analyse tailC)) - ## If, however, the type runs out but there is still enough ## tail, the remaining elements get packaged into another ## tuple, and analysed through the intermediation of a @@ -190,13 +205,27 @@ [#;ExQ tc;var]) (#;Apply inputT funT) - (case (type;apply (list inputT) funT) - #;None - (&;throw Not-Quantified-Type (%type funT)) - - (#;Some outputT) - (&;with-expected-type outputT - (analyse-product analyse membersC))) + (case funT + (#;Var funT-id) + (do @ + [?funT' (&;with-type-env (tc;read funT-id))] + (case ?funT' + (#;Some funT') + (&;with-expected-type (#;Apply inputT funT') + (analyse-product analyse membersC)) + + _ + (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n" + "Value: " (%code (` [(~@ membersC)])))))) + + _ + (case (type;apply (list inputT) funT) + #;None + (&;throw Not-Quantified-Type (%type funT)) + + (#;Some outputT) + (&;with-expected-type outputT + (analyse-product analyse membersC)))) _ (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n" diff --git a/new-luxc/source/luxc/lang/syntax.lux b/new-luxc/source/luxc/lang/syntax.lux index 93800c1b7..2d8cb364a 100644 --- a/new-luxc/source/luxc/lang/syntax.lux +++ b/new-luxc/source/luxc/lang/syntax.lux @@ -518,18 +518,20 @@ tail tail-lexer] (wrap (format head tail)))) -(def: ident^ - (l;Lexer [Ident Nat]) +(def: current-module-mark Text (format identifier-separator identifier-separator)) + +(def: (ident^ current-module) + (-> Text (l;Lexer [Ident Nat])) ($_ p;either - ## When an identifier starts with 2 marks, it's module is + ## When an identifier starts with 2 marks, its module is ## taken to be the current-module being compiled at the moment. ## This can be useful when mentioning identifiers and tags ## inside quoted/templated code in macros. (do p;Monad<Parser> - [#let [current-module-mark (format identifier-separator identifier-separator)] - _ (l;this current-module-mark) + [_ (l;this current-module-mark) def-name ident-part^] - (p;fail (format "Cannot handle " current-module-mark " syntax for identifiers."))) + (wrap [[current-module def-name] + (n.+ +2 (text;size def-name))])) ## If the identifier is prefixed by the mark, but no module ## part, the module is assumed to be "lux" (otherwise known as ## the 'prelude'). @@ -571,38 +573,40 @@ ## provide the compiler with information related to data-structure ## construction and de-structuring (during pattern-matching). (do-template [<name> <tag> <lexer> <extra>] - [(def: #export (<name> where) - (-> Cursor (l;Lexer [Cursor Code])) + [(def: #export (<name> current-module where) + (-> Text Cursor (l;Lexer [Cursor Code])) (do p;Monad<Parser> [[value length] <lexer>] (wrap [(update@ #;column (|>. ($_ n.+ <extra> length)) where) [where (<tag> value)]])))] - [symbol #;Symbol ident^ +0] - [tag #;Tag (p;after (l;this "#") ident^) +1] + [symbol #;Symbol (ident^ current-module) +0] + [tag #;Tag (p;after (l;this "#") (ident^ current-module)) +1] ) -(def: (ast where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [where (left-padding^ where)] - ($_ p;either - (form where ast) - (tuple where ast) - (record where ast) - (bool where) - (nat where) - (frac where) - (int where) - (deg where) - (symbol where) - (tag where) - (text where) - ))) - -(def: #export (parse [where offset source]) - (-> Source (e;Error [Source Code])) - (case (p;run [offset source] (ast where)) +(def: (ast current-module) + (-> Text Cursor (l;Lexer [Cursor Code])) + (: (-> Cursor (l;Lexer [Cursor Code])) + (function ast' [where] + (do p;Monad<Parser> + [where (left-padding^ where)] + ($_ p;either + (form where ast') + (tuple where ast') + (record where ast') + (bool where) + (nat where) + (frac where) + (int where) + (deg where) + (symbol current-module where) + (tag current-module where) + (text where) + ))))) + +(def: #export (parse current-module [where offset source]) + (-> Text Source (e;Error [Source Code])) + (case (p;run [offset source] (ast current-module where)) (#e;Error error) (#e;Error error) diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 6726470cc..62b56783c 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -145,10 +145,10 @@ _ (&module;flag-compiled! module-name)] (wrap output))) -(def: parse - (Meta Code) +(def: (parse current-module) + (-> Text (Meta Code)) (function [compiler] - (case (&syntax;parse (get@ #;source compiler)) + (case (&syntax;parse current-module (get@ #;source compiler)) (#e;Error error) (#e;Error error) @@ -171,7 +171,7 @@ file-content] (exhaust (do @ - [code parse + [code (parse module-name) #let [[cursor _] code]] (&;with-cursor cursor (translate code)))))))] diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux index 2cdf65e32..e680c46e8 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux @@ -423,8 +423,16 @@ [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 $Object-Array) (list)) false)] - [text//replace ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") - ($i;INVOKEVIRTUAL "java.lang.String" "replace" ($t;method (list $CharSequence $CharSequence) (#;Some $String) (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))) @@ -674,7 +682,8 @@ (install "text index" (trinary text//index)) (install "text size" (unary text//size)) (install "text hash" (unary text//hash)) - (install "text replace" (trinary text//replace)) + (install "text replace-once" (trinary text//replace-once)) + (install "text replace-all" (trinary text//replace-all)) (install "text char" (binary text//char)) (install "text clip" (trinary text//clip)) )) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 9b41010d9..70563181a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2364,7 +2364,7 @@ "" "-")] (("lux check" (-> Int Text Text) - (function' recur [input output] + (function' recur [input output] (if (i.= 0 input) ("lux text concat" sign output) (recur (i./ 10 input) @@ -3355,22 +3355,57 @@ (#Some y) (#Some y)))) -(do-template [<name> <proc> <start>] - [(def: (<name> part text) - (-> Text Text (Maybe Nat)) - (<proc> text part <start>))] +(do-template [<name> <form> <message> <doc-msg>] + [(macro: #export (<name> tokens) + {#;doc <doc-msg>} + (case (reverse tokens) + (^ (list& last init)) + (return (list (fold (: (-> Code Code Code) + (function [pre post] (` <form>))) + last + init))) + + _ + (fail <message>)))] - [index-of "lux text index" +0] - [last-index-of "lux text last-index" ("lux text size" text)] - ) + [and (if (~ pre) (~ post) false) "'and' requires >=1 clauses." "Short-circuiting \"and\".\n(and true false true) ## => false"] + [or (if (~ pre) true (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\".\n(or true false true) ## => true"]) + +(def: (index-of part text) + (-> Text Text (Maybe Nat)) + ("lux text index" text part +0)) + +(def: (last-index-of' part part-size since text) + (-> Text Nat Nat Text (Maybe Nat)) + (case ("lux text index" text part (n.+ part-size since)) + #;None + (#;Some since) + + (#;Some since') + (last-index-of' part part-size since' text))) + +(def: (last-index-of part text) + (-> Text Text (Maybe Nat)) + (case ("lux text index" text part +0) + (#;Some since) + (last-index-of' part ("lux text size" part) since text) + + #;None + #;None)) (def: (clip1 from text) (-> Nat Text (Maybe Text)) - ("lux text clip" text from ("lux text size" text))) + (let [to ("lux text size" text)] + (if (n.<= to from) + (#;Some ("lux text clip" text from to)) + #;None))) (def: (clip2 from to text) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" text from to)) + (if (and (n.<= ("lux text size" text) to) + (n.<= to from)) + (#;Some ("lux text clip" text from to)) + #;None)) (def: #export (error! message) {#;doc "## Causes an error, with the given error message. @@ -3762,22 +3797,6 @@ (All [a] (-> a a)) x) -(do-template [<name> <form> <message> <doc-msg>] - [(macro: #export (<name> tokens) - {#;doc <doc-msg>} - (case (reverse tokens) - (^ (list& last init)) - (return (list (fold (: (-> Code Code Code) - (function [pre post] (` <form>))) - last - init))) - - _ - (fail <message>)))] - - [and (if (~ pre) (~ post) false) "'and' requires >=1 clauses." "Short-circuiting \"and\".\n(and true false true) ## => false"] - [or (if (~ pre) true (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\".\n(or true false true) ## => true"]) - (macro: #export (type: tokens) {#;doc "## The type-definition macro. (type: (List a) @@ -5094,10 +5113,6 @@ (-> Text Nat) ("lux text size" x)) -(def: (text/trim x) - (-> Text Text) - ("lux text trim" x)) - (def: (update-cursor [file line column] code-text) (-> Cursor Text Cursor) [file line (n.+ column (text/size code-text))]) @@ -5181,7 +5196,6 @@ (#;Text (~ (|> tokens (map (. doc-fragment->Text identify-doc-fragment)) text/join - text/trim text$)))])))) (def: (interleave xs ys) @@ -5746,13 +5760,13 @@ (-> (List Code) (Meta [(Maybe Export-Level') (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "export"])] tokens')) - (:: Monad<Meta> wrap [(#;Some #Export) tokens']) + (return [(#;Some #Export) tokens']) (^ (list& [_ (#Tag ["" "hidden"])] tokens')) - (:: Monad<Meta> wrap [(#;Some #Hidden) tokens']) + (return [(#;Some #Hidden) tokens']) _ - (:: Monad<Meta> wrap [#;None tokens]) + (return [#;None tokens]) )) (def: (gen-export-level ?export-level) @@ -5792,7 +5806,7 @@ (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& token tokens')) - (:: Monad<Meta> wrap [token tokens']) + (return [token tokens']) _ (fail "Could not parse anything.") @@ -5802,7 +5816,7 @@ (-> (List Code) (Meta Unit)) (case tokens (^ (list)) - (:: Monad<Meta> wrap []) + (return []) _ (fail "Expected input Codes to be empty.") @@ -5812,10 +5826,10 @@ (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) - (:: Monad<Meta> wrap [(record$ _anns) tokens']) + (return [(record$ _anns) tokens']) _ - (:: Monad<Meta> wrap [(' {}) tokens]) + (return [(' {}) tokens]) )) (macro: #export (template: tokens) @@ -5957,7 +5971,7 @@ [ann (#Record (map right =kvs))]])) _ - (:: Monad<Meta> wrap [(list) code]))) + (return [(list) code]))) (macro: #export (`` tokens) (case tokens @@ -6017,7 +6031,7 @@ (wrap (` [(~ g!meta) (#;Record (~ (untemplate-list =fields)))]))) [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))] - (:: Monad<Meta> wrap unquoted) + (return unquoted) [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] (fail "Cannot use (~@) inside of ^code unless it is the last element in a form or a tuple.") diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index f2d1eb056..1e705e513 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -140,7 +140,7 @@ (l;Lexer XML) (|> (p;either cdata^ (l;many xml-char^)) - (p/map (|>. text;trim #Text)))) + (p/map (|>. #Text)))) (def: xml^ (l;Lexer XML) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index e9009102b..06a8809e1 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -172,8 +172,8 @@ ) ## [Values & Syntax] -(def: (get-char full idx) - (-> Text Nat (Maybe Text)) +(def: (get-char idx full) + (-> Nat Text Text) ("lux text clip" full idx (n.inc idx))) (do-template [<struct> <base> <char-set> <error>] @@ -181,7 +181,7 @@ (def: (encode value) (loop [input value output ""] - (let [digit (maybe;assume (get-char <char-set> (n.% <base> input))) + (let [digit (get-char (n.% <base> input) <char-set>) output' ("lux text concat" digit output) input' (n./ <base> input)] (if (n.= +0 input') @@ -197,7 +197,7 @@ (loop [idx +1 output +0] (if (n.< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (get-char idx input)] (case ("lux text index" <char-set> digit +0) #;None (#E;Error ("lux text concat" <error> repr)) @@ -226,20 +226,19 @@ "-" "")] (loop [input (|> value (i./ <base>) (:: Number<Int> abs)) - output (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat - (get-char <char-set>) - maybe;assume)] + output (get-char (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat) + <char-set>)] (if (i.= 0 input) ("lux text concat" sign output) - (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i.% <base> input))))] + (let [digit (get-char (int-to-nat (i.% <base> input)) <char-set>)] (recur (i./ <base> input) ("lux text concat" digit output)))))))) (def: (decode repr) (let [input-size ("lux text size" repr)] (if (n.>= +1 input-size) - (let [sign (case (get-char repr +0) - (^ (#;Some "-")) + (let [sign (case (get-char +0 repr) + "-" -1 _ @@ -248,7 +247,7 @@ (loop [idx (if (i.= -1 sign) +1 +0) output 0] (if (n.< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (get-char idx input)] (case ("lux text index" <char-set> digit +0) #;None (#E;Error <error>) @@ -267,7 +266,7 @@ (def: (de-prefix input) (-> Text Text) - (maybe;assume ("lux text clip" input +1 ("lux text size" input)))) + ("lux text clip" input +1 ("lux text size" input))) (do-template [<struct> <nat> <char-bit-size> <error>] [(struct: #export <struct> (Codec Text Deg) @@ -315,8 +314,8 @@ (if (f.= 0.0 dec-left) ("lux text concat" "." output) (let [shifted (f.* <base> dec-left) - digit (|> shifted (f.% <base>) frac-to-int int-to-nat - (get-char <char-set>) maybe;assume)] + digit (get-char (|> shifted (f.% <base>) frac-to-int int-to-nat) + <char-set>)] (recur (f.% 1.0 shifted) ("lux text concat" output digit))))))] ("lux text concat" whole-part decimal-part))) @@ -324,8 +323,8 @@ (def: (decode repr) (case ("lux text index" repr "." +0) (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr)))] + (let [whole-part ("lux text clip" repr +0 split-index) + decimal-part ("lux text clip" repr (n.inc split-index) ("lux text size" repr))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] (^multi [(#;Some whole) (#;Some decimal)] @@ -369,8 +368,8 @@ (if (n.<= chunk-size num-digits) (list digits) (let [boundary (n.- chunk-size num-digits) - chunk (maybe;assume ("lux text clip" digits boundary num-digits)) - remaining (maybe;assume ("lux text clip" digits +0 boundary))] + chunk ("lux text clip" digits boundary num-digits) + remaining ("lux text clip" digits +0 boundary)] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -499,10 +498,10 @@ (let [sign (:: Number<Frac> signum value) raw-bin (:: Binary@Codec<Text,Frac> encode value) dot-idx (maybe;assume ("lux text index" raw-bin "." +0)) - whole-part (maybe;assume ("lux text clip" raw-bin - (if (f.= -1.0 sign) +1 +0) - dot-idx)) - decimal-part (maybe;assume ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin))) + whole-part ("lux text clip" raw-bin + (if (f.= -1.0 sign) +1 +0) + dot-idx) + decimal-part ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin)) hex-output (|> (<from> false decimal-part) ("lux text concat" ".") ("lux text concat" (<from> true whole-part)) @@ -518,8 +517,8 @@ 1.0)] (case ("lux text index" repr "." +0) (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr))) + (let [whole-part ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index) + decimal-part ("lux text clip" repr (n.inc split-index) ("lux text size" repr)) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) @@ -672,14 +671,13 @@ (loop [idx +0 output (make-digits [])] (if (n.< length idx) - (let [char (maybe;assume (get-char input idx))] - (case ("lux text index" "0123456789" char +0) - #;None - #;None - - (#;Some digit) - (recur (n.inc idx) - (digits-put idx digit output)))) + (case ("lux text index" "0123456789" (get-char idx input) +0) + #;None + #;None + + (#;Some digit) + (recur (n.inc idx) + (digits-put idx digit output))) (#;Some output))) #;None))) @@ -743,9 +741,7 @@ false)] (if (and dotted? (n.<= (n.inc bit;width) length)) - (case (|> ("lux text clip" input +1 length) - maybe;assume - text-to-digits) + (case (text-to-digits ("lux text clip" input +1 length)) (#;Some digits) (loop [digits digits idx +0 diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 778b4a1db..870474890 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -307,22 +307,3 @@ (math;sin inner))] {#real real #imaginary imaginary}))))))) - -(struct: #export _ (Codec Text Complex) - (def: (encode (^slots [#real #imaginary])) - ($_ text/compose "(" (f/encode real) ", " (f/encode imaginary) ")")) - - (def: (decode input) - (case (do maybe;Monad<Maybe> - [input' (text;clip +1 (n.- +1 (text;size input)) input)] - (text;split-with "," input')) - #;None - (#;Left (text/compose "Wrong syntax for complex numbers: " input)) - - (#;Some [r' i']) - (do E;Monad<Error> - [r (f/decode (text;trim r')) - i (f/decode (text;trim i'))] - (wrap {#real r - #imaginary i})) - ))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 812047e35..21a170003 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -29,12 +29,14 @@ [lower-case "lux text lower-case"] [upper-case "lux text upper-case"] - [trim "lux text trim"] ) (def: #export (clip from to input) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" input from to)) + (if (and (n.<= ("lux text size" input) to) + (n.<= to from)) + (#;Some ("lux text clip" input from to)) + #;None)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) @@ -44,22 +46,44 @@ (-> Text Text Text Text) ("lux text replace-all" template pattern value)) -(do-template [<general> <common> <proc> <start>] - [(def: #export (<common> pattern input) - (-> Text Text (Maybe Nat)) - (<proc> input pattern <start>)) +(def: #export (index-of' pattern from input) + (-> Text Nat Text (Maybe Nat)) + ("lux text index" input pattern from)) - (def: #export (<general> pattern from input) - (-> Text Nat Text (Maybe Nat)) - (<proc> input pattern from))] +(def: #export (index-of pattern input) + (-> Text Text (Maybe Nat)) + ("lux text index" input pattern +0)) - [index-of index-of' "lux text index" +0] - [last-index-of last-index-of' "lux text last-index" (size input)] - ) +(def: (last-index-of'' part part-size since text) + (-> Text Nat Nat Text (Maybe Nat)) + (case ("lux text index" text part (n.+ part-size since)) + #;None + (#;Some since) + + (#;Some since') + (last-index-of'' part part-size since' text))) + +(def: #export (last-index-of' part from text) + (-> Text Nat Text (Maybe Nat)) + (case ("lux text index" text part from) + (#;Some since) + (last-index-of'' part ("lux text size" part) since text) + + #;None + #;None)) + +(def: #export (last-index-of part text) + (-> Text Text (Maybe Nat)) + (case ("lux text index" text part +0) + (#;Some since) + (last-index-of'' part ("lux text size" part) since text) + + #;None + #;None)) (def: #export (starts-with? prefix x) (-> Text Text Bool) - (case (index-of' prefix x) + (case (index-of prefix x) (#;Some +0) true @@ -68,7 +92,7 @@ (def: #export (ends-with? postfix x) (-> Text Text Bool) - (case (last-index-of' postfix x) + (case (last-index-of postfix x) (#;Some n) (n.= (size x) (n.+ (size postfix) n)) @@ -88,7 +112,7 @@ (def: #export (split-with token sample) (-> Text Text (Maybe [Text Text])) (do maybe;Monad<Maybe> - [index (index-of' token sample) + [index (index-of token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] (wrap [pre post]))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 45effa773..9ae2bdd8f 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -65,7 +65,7 @@ {#;doc "Lex a text if it matches the given sample."} (-> Text (Lexer Unit)) (function [[offset tape]] - (case (text;index-of reference offset tape) + (case (text;index-of' reference offset tape) (#;Some where) (if (n.= offset where) (#E;Success [[(n.+ (text;size reference) offset) tape] []]) @@ -78,7 +78,7 @@ {#;doc "Lex a text if it matches the given sample."} (-> Text (Lexer Bool)) (function [(^@ input [offset tape])] - (case (text;index-of reference offset tape) + (case (text;index-of' reference offset tape) (^multi (#;Some where) (n.= offset where)) (#E;Success [[(n.+ (text;size reference) offset) tape] true]) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index 5b7e2e1e7..410fa1cb9 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -117,8 +117,7 @@ quotient (|> x (&;c.- rem) (&;c./ y)) floored (|> quotient (update@ #&;real math;floor) - (update@ #&;imaginary math;floor)) - (^open "&/") &;Codec<Text,Complex>] + (update@ #&;imaginary math;floor))] (within? 0.000000000001 x (|> quotient (&;c.* y) (&;c.+ rem))))) @@ -195,16 +194,3 @@ (&;nth-roots degree) (List/map (&;pow' (|> degree nat-to-int int-to-frac))) (list;every? (within? margin-of-error sample))))))) - -(context: "Codec" - (<| (times +100) - (do @ - [sample gen-complex - #let [(^open "c/") &;Codec<Text,Complex>]] - (test "Can encode/decode complex numbers." - (|> sample c/encode c/decode - (case> (#;Right output) - (&;c.= sample output) - - _ - false)))))) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index 92914ba25..10f51708e 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -1,7 +1,7 @@ (;module: lux (lux [io] - (control ["M" monad #+ do Monad] + (control [monad #+ do Monad] pipe) (data ["&" text] text/format @@ -34,10 +34,10 @@ (&;nth idx) (case> (^multi (#;Some char) [(&;from-code char) char] - [[(&;index-of' char sample) - (&;last-index-of' char sample) - (&;index-of char idx sample) - (&;last-index-of char idx sample)] + [[(&;index-of char sample) + (&;last-index-of char sample) + (&;index-of' char idx sample) + (&;last-index-of' char idx sample)] [(#;Some io) (#;Some lio) (#;Some io') (#;Some lio')]]) (and (n.<= idx io) @@ -128,8 +128,7 @@ ($_ seq (test "Can transform texts in certain ways." (and (&/= "abc" (&;lower-case "ABC")) - (&/= "ABC" (&;upper-case "abc")) - (&/= "ABC" (&;trim " \tABC\n\r")))) + (&/= "ABC" (&;upper-case "abc")))) ))) (context: "Structures" |