From a1944a9d561e76b02717673647b87704118c03a6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 20 Aug 2018 23:21:01 -0400 Subject: - More minor optimizations. - Removed ratio syntax for Frac. --- stdlib/test/test/lux/compiler/default/syntax.lux | 36 ------------------------ 1 file changed, 36 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 2b4a8f5b6..a9baa546c 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -112,42 +112,6 @@ (:: code.Equivalence = other =other))))) )))) -(context: "Frac special syntax." - (<| (times 100) - (do @ - [numerator (|> r.nat (:: @ map (|>> (n/% 100) .int int-to-frac))) - denominator (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1) .int int-to-frac))) - signed? r.bit - #let [expected (|> numerator (f// denominator) (f/* (if signed? -1.0 +1.0)))]] - (test "Can parse frac ratio syntax." - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 - (format (if signed? "-" "+") - (%i (frac-to-int numerator)) - "/" - (%i (frac-to-int denominator)))]) - (#e.Success [_ [_ (#.Frac actual)]]) - (f/= expected actual) - - _ - #0) - )))) - -(context: "Nat special syntax." - (<| (times 100) - (do @ - [expected (|> r.nat (:: @ map (n/% 1_000)))] - (test "Can parse nat char syntax." - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 - (format "#" (%t (text.from-code expected)) "")]) - (#e.Success [_ [_ (#.Nat actual)]]) - (n/= expected actual) - - _ - #0) - )))) - (def: comment-text^ (r.Random Text) (let [char-gen (|> r.nat (r.filter (function (_ value) -- cgit v1.3.1 From 6c896325238b63b6fc09f774968be6da0b9c89c1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 17:40:33 -0400 Subject: No more multi-line comments. --- luxc/src/lux/lexer.clj | 17 +------ stdlib/source/lux/compiler/default/syntax.lux | 63 +----------------------- stdlib/test/test/lux/compiler/default/syntax.lux | 36 ++------------ 3 files changed, 6 insertions(+), 110 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 0a09c0619..9e1414b7f 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -106,26 +106,11 @@ (|do [[meta _ white-space] (&reader/read-regex #"^(\s+|$)")] (return (&/T [meta ($White_Space white-space)])))) -(def ^:private lex-single-line-comment +(def ^:private lex-comment (|do [_ (&reader/read-text "##") [meta _ comment] (&reader/read-regex #"^(.*)$")] (return (&/T [meta ($Comment comment)])))) -(defn- lex-multi-line-comment [_] - (|do [_ (&reader/read-text "#(") - [meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex+ #"(?is)^(?!#\()((?!\)#).)*")] - (return (&/T [meta comment]))) - (|do [[meta pre] (&reader/read-regex+ #"(?is)^((?!#\().)*") - [_ ($Comment inner)] (lex-multi-line-comment nil) - [_ post] (&reader/read-regex+ #"(?is)^((?!\)#).)*")] - (return (&/T [meta (str pre "#(" inner ")#" post)]))))) - _ (&reader/read-text ")#")] - (return (&/T [meta ($Comment comment)])))) - -(def ^:private lex-comment - (&/try-all% (&/|list lex-single-line-comment - (lex-multi-line-comment nil)))) - (do-template [ ] (def (|do [[meta _ token] (&reader/read-regex )] diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 6a52687ec..3b3b3e411 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -132,7 +132,7 @@ ## Single-line comments can start anywhere, but only go up to the ## next new-line. -(def: (single-line-comment^ where) +(def: (comment^ where) (-> Cursor (Lexer Cursor)) (do p.Monad [_ (l.this ..single-line-comment-marker) @@ -142,67 +142,6 @@ (update@ #.line inc) (set@ #.column 0))))) -## This is just a helper parser to find text which doesn't run into -## any special character sequences for multi-line comments. -(def: multi-line-comment-start^ (l.this (format ..sigil open-form))) -(def: multi-line-comment-end^ (l.this (format close-form ..sigil))) - -(def: multi-line-comment-bound^ - (Lexer Any) - ($_ p.either - ..new-line^ - ..multi-line-comment-start^ - ..multi-line-comment-end^)) - -## Multi-line comments are bounded by #( these delimiters, #(and, they may -## also be nested)# )#. -## Multi-line comment syntax must be balanced. -## That is, any nested comment must have matched delimiters. -## Unbalanced comments ought to be rejected as invalid code. -(def: (multi-line-comment^ where) - (-> Cursor (Lexer Cursor)) - (do p.Monad - [_ ..multi-line-comment-start^] - (loop [where (update@ #.column (n/+ 2) where)] - ($_ p.either - ## These are normal chunks of commented text. - (do @ - [chunk (l.many! (l.not! multi-line-comment-bound^))] - (recur (|> where - (update@ #.column (n/+ (get@ #l.distance chunk)))))) - ## This is a special rule to handle new-lines within - ## comments properly. - (do @ - [_ ..new-line^] - (recur (|> where - (update@ #.line inc) - (set@ #.column 0)))) - ## This is the rule for handling nested sub-comments. - ## Ultimately, the whole comment is just treated as text - ## (the comment must respect the syntax structure, but the - ## output produced is just a block of text). - ## That is why the sub-comment is covered in delimiters - ## and then appended to the rest of the comment text. - (do @ - [sub-where (multi-line-comment^ where)] - (recur sub-where)) - ## Finally, this is the rule for closing the comment. - (do @ - [_ ..multi-line-comment-end^] - (wrap (update@ #.column (n/+ 2) where))) - )))) - -## This is the only parser that should be used directly by other -## parsers, since all comments must be treated as either being -## single-line or multi-line. -## That is, there is no syntactic rule prohibiting one type of comment -## from being used in any situation (alternatively, forcing one type -## of comment to be the only usable one). -(def: (comment^ where) - (-> Cursor (Lexer Cursor)) - (p.either (single-line-comment^ where) - (multi-line-comment^ where))) - ## To simplify parsing, I remove any left-padding that a Code token ## may have prior to parsing the token itself. ## Left-padding is assumed to be either white-space or a comment. diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index a9baa546c..1bcb9dad8 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -114,25 +114,16 @@ (def: comment-text^ (r.Random Text) - (let [char-gen (|> r.nat (r.filter (function (_ value) - (not (or (text.space? value) - (n/= (char "#") value) - (n/= (char "(") value) - (n/= (char ")") value))))))] + (let [char-gen (|> r.nat (r.filter (|>> (n/= (char "\n")) not)))] (do r.Monad [size (|> r.nat (r/map (n/% 20)))] (r.text char-gen size)))) (def: comment^ (r.Random Text) - (r.either (do r.Monad - [comment comment-text^] - (wrap (format "## " comment "\n"))) - (r.rec (function (_ nested^) - (do r.Monad - [comment (r.either comment-text^ - nested^)] - (wrap (format "#( " comment " )#"))))))) + (do r.Monad + [comment comment-text^] + (wrap (format "## " comment "\n")))) (context: "Multi-line text & comments." (<| (seed 12137892244981970631) @@ -189,23 +180,4 @@ (#e.Success [_ parsed]) (:: code.Equivalence = parsed sample))) - (test "Will reject unbalanced multi-line comments." - (and (case (&.read "" (dict.new text.Hash) - [default-cursor 0 - (format "#(" "#(" unbalanced-comment ")#" - (code.to-text sample))]) - (#e.Error error) - #1 - - (#e.Success [_ parsed]) - #0) - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 - (format "#(" unbalanced-comment ")#" ")#" - (code.to-text sample))]) - (#e.Error error) - #1 - - (#e.Success [_ parsed]) - #0))) )))) -- cgit v1.3.1 From 5e13ae0ad68947249a98dc69ab513bdbeca1697e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:50:33 -0400 Subject: No more escaping of horizontal-tab. --- luxc/src/lux/lexer.clj | 2 - stdlib/source/lux.lux | 12 +----- .../compiler/default/phase/analysis/expression.lux | 4 +- .../lux/compiler/default/phase/extension.lux | 6 ++- .../default/phase/extension/analysis/host.jvm.lux | 2 +- stdlib/source/lux/compiler/default/syntax.lux | 4 +- stdlib/source/lux/data/collection/list.lux | 12 +++--- stdlib/source/lux/data/format/json.lux | 21 ++++++---- stdlib/source/lux/data/text.lux | 47 +++++++++++++--------- stdlib/source/lux/data/text/regex.lux | 20 ++++----- stdlib/source/lux/host.jvm.lux | 2 +- stdlib/test/test/lux/compiler/default/syntax.lux | 2 +- stdlib/test/test/lux/data/text/regex.lux | 6 +-- 13 files changed, 71 insertions(+), 69 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index e81599957..37f5fdbed 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -37,8 +37,6 @@ (if (= \\ current-char) (do (assert (< (+ 1 idx) line-length) (str "[Lexer Error] Text is too short for escaping: " raw-line " " idx)) (case (.charAt raw-line (+ 1 idx)) - \t (do (.append buffer "\t") - (recur (+ 2 idx))) \v (do (.append buffer "\u000B") (recur (+ 2 idx))) \b (do (.append buffer "\b") diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 1b64aa22b..5ffe8d939 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5154,17 +5154,7 @@ (def: (text/encode original) (-> Text Text) - (let [escaped (|> original - (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 "\"" "\\\"") - (replace-all "\\" "\\\\") - )] - ($_ text/compose "\"" escaped "\""))) + ($_ text/compose "\"" original "\"")) (do-template [ ] [(def: #export ( value) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux index ed2f81735..073cc9950 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux @@ -26,14 +26,14 @@ (exception: #export (macro-expansion-failed {macro Name} {inputs (List Code)} {error Text}) (ex.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format "\n\t"))) + (list/map (|>> %code (format "\n" text.tab))) (text.join-with ""))] ["Error" error])) (exception: #export (macro-call-must-have-single-expansion {macro Name} {inputs (List Code)}) (ex.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format "\n\t"))) + (list/map (|>> %code (format "\n" text.tab))) (text.join-with ""))])) (exception: #export (unrecognized-syntax {code Code}) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index 38ca02700..c7a2048a8 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -49,7 +49,7 @@ ["Available" (|> bundle dictionary.keys (list.sort text/<) - (list/map (|>> %t (format "\n\t"))) + (list/map (|>> %t (format "\n" text.tab))) (text.join-with ""))])) (exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) @@ -75,7 +75,9 @@ (ex.throw unknown [where name bundle]) (#.Some handler) - ((handler name phase) parameters stateE)))) + ((<| (//.timed (name-of ..apply) (%t name)) + ((handler name phase) parameters)) + stateE)))) (def: #export (localized get set transform) (All [s s' i o v] diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 5406ac20a..31f4b33ff 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -95,7 +95,7 @@ (ex.report ["Class" class] ["Method" method] ["Hints" (|> hints - (list/map (|>> product.left %type (format "\n\t"))) + (list/map (|>> product.left %type (format "\n" text.tab))) (text.join-with ""))]))] [no-candidates] diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index f333917d8..2aaa46992 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -140,7 +140,6 @@ [code l.any] (case code ## Handle special cases. - "t" (wrap [2 "\t"]) "v" (wrap [2 "\v"]) "b" (wrap [2 "\b"]) "n" (wrap [2 ..new-line]) @@ -624,8 +623,7 @@ (^template [ ] (^ (char )) (!find-next-escape 2 next-escape end source-code total )) - (["t" "\t"] - ["v" "\v"] + (["v" "\v"] ["b" "\b"] ["n" (static ..new-line)] ["r" "\r"] diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index ef1ebf5ac..c49a7ba9f 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -435,8 +435,8 @@ (identifier$ ("lux text concat" base "'"))])))) pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) vars+lists))]) - g!step (identifier$ "\tstep\t") - g!blank (identifier$ "\t_\t") + g!step (identifier$ "0step0") + g!blank (identifier$ "0_0") list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function ((~ g!step) (~+ list-vars)) @@ -466,8 +466,8 @@ (if (n/> 0 num-lists) (let [(^open ".") Functor indices (..indices num-lists) - g!return-type (identifier$ "\treturn-type\t") - g!func (identifier$ "\tfunc\t") + g!return-type (identifier$ "0return-type0") + g!func (identifier$ "0func0") type-vars (: (List Code) (map (|>> nat/encode identifier$) indices)) zip-type (` (All [(~+ type-vars) (~ g!return-type)] (-> (-> (~+ type-vars) (~ g!return-type)) @@ -482,8 +482,8 @@ (identifier$ ("lux text concat" base "'"))])))) pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) vars+lists))]) - g!step (identifier$ "\tstep\t") - g!blank (identifier$ "\t_\t") + g!step (identifier$ "0step0") + g!blank (identifier$ "0_0") list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function ((~ g!step) (~ g!func) (~+ list-vars)) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index c26df1893..1d0837b90 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -452,13 +452,20 @@ (def: escaped~ (l.Lexer Text) ($_ p.either - (p.after (l.this "\\t") (parser/wrap "\t")) - (p.after (l.this "\\b") (parser/wrap "\b")) - (p.after (l.this "\\n") (parser/wrap "\n")) - (p.after (l.this "\\r") (parser/wrap "\r")) - (p.after (l.this "\\f") (parser/wrap "\f")) - (p.after (l.this "\\\"") (parser/wrap "\"")) - (p.after (l.this "\\\\") (parser/wrap "\\")))) + (p.after (l.this "\\t") + (parser/wrap text.tab)) + (p.after (l.this "\\b") + (parser/wrap text.back-space)) + (p.after (l.this "\\n") + (parser/wrap text.new-line)) + (p.after (l.this "\\r") + (parser/wrap text.carriage-return)) + (p.after (l.this "\\f") + (parser/wrap text.form-feed)) + (p.after (l.this (text/compose "\\" text.double-quote)) + (parser/wrap text.double-quote)) + (p.after (l.this "\\\\") + (parser/wrap "\\")))) (def: string~ (l.Lexer String) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 48f35febe..0c6a5ea45 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -216,30 +216,37 @@ (-> 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")) +(do-template [ ] + [(def: #export (from-code ))] + + [back-space 8] + [tab 9] + [new-line 10] + [vertical-tab 11] + [form-feed 12] + [carriage-return 13] + [double-quote 34] + ) + +(def: #export encode + (-> Text Text) + (..enclose' ..double-quote)) + (def: #export (space? char) {#.doc "Checks whether the character is white-space."} (-> Nat Bit) - (case char - (^or (^ (char "\t")) (^ (char "\v")) - (^ (char " ")) (^ (char "\n")) - (^ (char "\r")) (^ (char "\f"))) - #1 - - _ - #0)) + (`` (case char + (^or (^ (char (~~ (static ..tab)))) + (^ (char (~~ (static ..vertical-tab)))) + (^ (char " ")) + (^ (char (~~ (static ..new-line)))) + (^ (char (~~ (static ..carriage-return)))) + (^ (char (~~ (static ..form-feed))))) + #1 + + _ + #0))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index ffd937d8e..a5409438e 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -8,14 +8,14 @@ ["e" error] ["." maybe] ["." number ("int/." Codec)] - ["." text - ["l" lexer] - format] [collection ["." list ("list/." Fold Monad)]]] ["." macro (#+ with-gensyms) ["." code] - ["s" syntax (#+ syntax:)]]]) + ["s" syntax (#+ syntax:)]]] + ["." // + ["l" lexer] + format]) ## [Utils] (def: regex-char^ @@ -50,7 +50,7 @@ (-> (l.Lexer (List Text)) (l.Lexer Text)) (do p.Monad [parts part^] - (wrap (text.join-with "" parts)))) + (wrap (//.join-with "" parts)))) (def: name-char^ (l.Lexer Text) @@ -81,9 +81,9 @@ (def: re-range^ (l.Lexer Code) (do p.Monad - [from (|> regex-char^ (:: @ map (|>> (text.nth 0) maybe.assume))) + [from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume))) _ (l.this "-") - to (|> regex-char^ (:: @ map (|>> (text.nth 0) maybe.assume)))] + to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))] (wrap (` (l.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ @@ -122,7 +122,7 @@ (def: blank^ (l.Lexer Text) - (l.one-of " \t")) + (l.one-of (format " " //.tab))) (def: ascii^ (l.Lexer Text) @@ -278,7 +278,7 @@ [idx names (list& (list g!temp complex - (' #let) (` [(~ g!total) (:: (~! text.Monoid) (~' compose) (~ g!total) (~ g!temp))])) + (' #let) (` [(~ g!total) (:: (~! //.Monoid) (~' compose) (~ g!total) (~ g!temp))])) steps)] (#.Right [(#Capturing [?name num-captures]) scoped]) @@ -294,7 +294,7 @@ [idx! (list& name! names) (list& (list name! scoped - (' #let) (` [(~ g!total) (:: (~! text.Monoid) (~' compose) (~ g!total) (~ access))])) + (' #let) (` [(~ g!total) (:: (~! //.Monoid) (~' compose) (~ g!total) (~ access))])) steps)]) ))) [+0 diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b7a55dfaa..9bb839aec 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1088,7 +1088,7 @@ (def: (annotation$ [name params]) (-> Annotation JVM-Code) - (format "(" name " " "{" (text.join-with "\t" (list/map annotation-param$ params)) "}" ")")) + (format "(" name " " "{" (text.join-with text.tab (list/map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) (-> BoundKind JVM-Code) diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 1bcb9dad8..6a447e9c1 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (do r.Monad [#let [digits "0123456789" delimiters "()[]{}#.\"" - space "\t\v \n\r\f" + space "\v \n\r\f" invalid-range (format digits delimiters space) char-gen (|> r.nat (:: @ map (|>> (n/% 256) (n/max 1))) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 96f56c3d9..7a6e88d33 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -5,7 +5,7 @@ pipe ["p" parser]] [data - [text ("text/." Equivalence) + ["." text ("text/." Equivalence) format ["." lexer (#+ Lexer)] ["&" regex]]] @@ -117,10 +117,10 @@ (and (should-pass (&.regex "\\p{OctDigit}") "6") (should-fail (&.regex "\\p{OctDigit}") ".")) - (and (should-pass (&.regex "\\p{Blank}") "\t") + (and (should-pass (&.regex "\\p{Blank}") text.tab) (should-fail (&.regex "\\p{Blank}") ".")) - (and (should-pass (&.regex "\\p{ASCII}") "\t") + (and (should-pass (&.regex "\\p{ASCII}") text.tab) (should-fail (&.regex "\\p{ASCII}") "\u1234")) (and (should-pass (&.regex "\\p{Contrl}") "\u0012") -- cgit v1.3.1 From 533864f86be183cbbb7c11516910acf711d281f4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:54:59 -0400 Subject: No more escaping of form-feed. --- luxc/src/lux/lexer.clj | 2 -- stdlib/source/lux/compiler/default/syntax.lux | 2 -- stdlib/test/test/lux/compiler/default/syntax.lux | 2 +- 3 files changed, 1 insertion(+), 5 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 981b35178..00964a057 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -43,8 +43,6 @@ (recur (+ 2 idx))) \r (do (.append buffer "\r") (recur (+ 2 idx))) - \f (do (.append buffer "\f") - (recur (+ 2 idx))) \" (do (.append buffer "\"") (recur (+ 2 idx))) \\ (do (.append buffer "\\") diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 1d1572859..aa77be1e5 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -143,7 +143,6 @@ "v" (wrap [2 "\v"]) "n" (wrap [2 ..new-line]) "r" (wrap [2 "\r"]) - "f" (wrap [2 "\f"]) (^ (static ..text-delimiter)) (wrap [2 ..text-delimiter]) (^ (static ..escape)) (wrap [2 ..escape]) @@ -625,7 +624,6 @@ (["v" "\v"] ["n" (static ..new-line)] ["r" "\r"] - ["f" "\f"] [(~~ (static ..escape)) (static ..escape)]) (^ (char (~~ (static ..text-delimiter)))) diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 6a447e9c1..e8b5bb5b4 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (do r.Monad [#let [digits "0123456789" delimiters "()[]{}#.\"" - space "\v \n\r\f" + space "\v \n\r" invalid-range (format digits delimiters space) char-gen (|> r.nat (:: @ map (|>> (n/% 256) (n/max 1))) -- cgit v1.3.1 From f4f1d14416770cc223676a7d89ed15a11222ef1b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:56:56 -0400 Subject: No more escaping of carriage-return. --- luxc/src/lux/lexer.clj | 2 -- stdlib/source/lux/compiler/default/syntax.lux | 5 +---- stdlib/test/test/lux/compiler/default/syntax.lux | 2 +- 3 files changed, 2 insertions(+), 7 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 00964a057..d52464d5d 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -41,8 +41,6 @@ (recur (+ 2 idx))) \n (do (.append buffer "\n") (recur (+ 2 idx))) - \r (do (.append buffer "\r") - (recur (+ 2 idx))) \" (do (.append buffer "\"") (recur (+ 2 idx))) \\ (do (.append buffer "\\") diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index aa77be1e5..06672b2aa 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -59,7 +59,6 @@ (def: digits+ (format "_" ..digits)) (def: white-space " ") -(def: carriage-return "\r") (def: new-line "\n") ## (def: new-line^ (l.this new-line)) @@ -142,7 +141,6 @@ ## Handle special cases. "v" (wrap [2 "\v"]) "n" (wrap [2 ..new-line]) - "r" (wrap [2 "\r"]) (^ (static ..text-delimiter)) (wrap [2 ..text-delimiter]) (^ (static ..escape)) (wrap [2 ..escape]) @@ -623,7 +621,6 @@ (!find-next-escape 2 next-escape end source-code total )) (["v" "\v"] ["n" (static ..new-line)] - ["r" "\r"] [(~~ (static ..escape)) (static ..escape)]) (^ (char (~~ (static ..text-delimiter)))) @@ -878,7 +875,7 @@ (!inc offset) source-code])) ([(~~ (static ..white-space)) #.column] - [(~~ (static ..carriage-return)) #.column]) + [(~~ (static text.carriage-return)) #.column]) (^ (char (~~ (static ..new-line)))) (recur tracker [(!new-line where) (!inc offset) source-code]) diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index e8b5bb5b4..14de95b52 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (do r.Monad [#let [digits "0123456789" delimiters "()[]{}#.\"" - space "\v \n\r" + space "\v \n" invalid-range (format digits delimiters space) char-gen (|> r.nat (:: @ map (|>> (n/% 256) (n/max 1))) -- cgit v1.3.1 From 79c2988c1b514657cc384070e66539e51e105987 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:59:20 -0400 Subject: No more escaping of vertical-tab. --- luxc/src/lux/lexer.clj | 2 -- stdlib/source/lux/compiler/default/syntax.lux | 4 +--- stdlib/test/test/lux/compiler/default/syntax.lux | 2 +- 3 files changed, 2 insertions(+), 6 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index d52464d5d..02f1e088a 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -37,8 +37,6 @@ (if (= \\ current-char) (do (assert (< (+ 1 idx) line-length) (str "[Lexer Error] Text is too short for escaping: " raw-line " " idx)) (case (.charAt raw-line (+ 1 idx)) - \v (do (.append buffer "\u000B") - (recur (+ 2 idx))) \n (do (.append buffer "\n") (recur (+ 2 idx))) \" (do (.append buffer "\"") diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 06672b2aa..89087d482 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -139,7 +139,6 @@ [code l.any] (case code ## Handle special cases. - "v" (wrap [2 "\v"]) "n" (wrap [2 ..new-line]) (^ (static ..text-delimiter)) (wrap [2 ..text-delimiter]) (^ (static ..escape)) (wrap [2 ..escape]) @@ -619,8 +618,7 @@ (^template [ ] (^ (char )) (!find-next-escape 2 next-escape end source-code total )) - (["v" "\v"] - ["n" (static ..new-line)] + (["n" (static ..new-line)] [(~~ (static ..escape)) (static ..escape)]) (^ (char (~~ (static ..text-delimiter)))) diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 14de95b52..5ac8e16da 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (do r.Monad [#let [digits "0123456789" delimiters "()[]{}#.\"" - space "\v \n" + space " \n" invalid-range (format digits delimiters space) char-gen (|> r.nat (:: @ map (|>> (n/% 256) (n/max 1))) -- cgit v1.3.1 From 324665cef68fa326d358733d36ed20feba5dbbd6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 23:25:04 -0400 Subject: No more escaping of unicode. --- luxc/src/lux/lexer.clj | 3 --- stdlib/source/lux/compiler/default/syntax.lux | 25 ------------------------- stdlib/source/lux/data/text/regex.lux | 10 +++++----- stdlib/source/lux/macro/poly.lux | 4 ++-- stdlib/test/test/lux/data/text/regex.lux | 9 +++++---- stdlib/test/test/lux/math/logic/fuzzy.lux | 8 ++++---- 6 files changed, 16 insertions(+), 43 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 02f1e088a..1b4722083 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -43,9 +43,6 @@ (recur (+ 2 idx))) \\ (do (.append buffer "\\") (recur (+ 2 idx))) - \u (do (assert (< (+ 5 idx) line-length) (str "[Lexer Error] Text is too short for unicode-escaping: " raw-line " " idx)) - (.append buffer (char (Integer/valueOf (.substring raw-line (+ 2 idx) (+ 6 idx)) 16))) - (recur (+ 6 idx))) ;; else (assert false (str "[Lexer Error] Invalid escaping syntax: " raw-line " " idx)))) (do (.append buffer current-char) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 89087d482..dc22de5d0 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -129,8 +129,6 @@ ## Escaped character sequences follow the usual syntax of ## back-slash followed by a letter (e.g. \n). -## Unicode escapes are possible, with hexadecimal sequences between 1 -## and 4 characters long (e.g. \u12aB). ## Escaped characters may show up in Char and Text literals. (def: escaped-char^ (Lexer [Nat Text]) @@ -143,17 +141,6 @@ (^ (static ..text-delimiter)) (wrap [2 ..text-delimiter]) (^ (static ..escape)) (wrap [2 ..escape]) - ## Handle unicode escapes. - "u" - (do p.Monad - [code (l.between 1 4 l.hexadecimal)] - (wrap (case (:: number.Hex@Codec decode code) - (#.Right value) - [("lux i64 +" 2 (text.size code)) (text.from-code value)] - - _ - (undefined)))) - _ (p.fail (format "Invalid escaping syntax: " (%t code))))))) @@ -634,18 +621,6 @@ _ (ex.throw invalid-escape-syntax []))) - ## Handle unicode escapes. - (^ (char "u")) - (if (!i/< (:coerce Int end) - (:coerce Int )) - (case (:: number.Hex@Codec decode (!clip source-code)) - (#error.Success value) - (!find-next-escape 6 next-escape end source-code total (text.from-code value)) - - (#error.Error error) - (#error.Error error)) - (ex.throw invalid-escape-syntax [])) - _ (ex.throw invalid-escape-syntax [])))))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index a5409438e..e491873dc 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -7,7 +7,7 @@ ["." product] ["e" error] ["." maybe] - ["." number ("int/." Codec)] + ["." number (#+ hex) ("int/." Codec)] [collection ["." list ("list/." Fold Monad)]]] ["." macro (#+ with-gensyms) @@ -126,12 +126,12 @@ (def: ascii^ (l.Lexer Text) - (l.range (char "\u0000") (char "\u007F"))) + (l.range (hex "0") (hex "7F"))) (def: control^ (l.Lexer Text) - (p.either (l.range (char "\u0000") (char "\u001F")) - (l.one-of "\u007F"))) + (p.either (l.range (hex "0") (hex "1F")) + (l.one-of (//.from-code (hex "7F"))))) (def: punct^ (l.Lexer Text) @@ -144,7 +144,7 @@ (def: print^ (l.Lexer Text) (p.either graph^ - (l.one-of "\u0020"))) + (l.one-of (//.from-code (hex "20"))))) (def: re-system-class^ (l.Lexer Code) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 72a56b81d..7b3bc49a2 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -12,7 +12,7 @@ ["." maybe] [name ("name/." Codec)] ["e" error] - ["." number ("nat/." Codec)] + ["." number (#+ hex) ("nat/." Codec)] ["." text ("text/." Monoid) format] [collection @@ -131,7 +131,7 @@ (def: (label idx) (-> Nat Code) - (code.local-identifier (text/compose "label\u0000" (nat/encode idx)))) + (code.local-identifier ($_ text/compose "label" text.tab (nat/encode idx)))) (def: #export (with-extension type poly) (All [a] (-> Type (Poly a) (Poly [Code a]))) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 7a6e88d33..7c54d8385 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -5,6 +5,7 @@ pipe ["p" parser]] [data + [number (#+ hex)] ["." text ("text/." Equivalence) format ["." lexer (#+ Lexer)] @@ -121,9 +122,9 @@ (should-fail (&.regex "\\p{Blank}") ".")) (and (should-pass (&.regex "\\p{ASCII}") text.tab) - (should-fail (&.regex "\\p{ASCII}") "\u1234")) + (should-fail (&.regex "\\p{ASCII}") (text.from-code (hex "1234")))) - (and (should-pass (&.regex "\\p{Contrl}") "\u0012") + (and (should-pass (&.regex "\\p{Contrl}") (text.from-code (hex "12"))) (should-fail (&.regex "\\p{Contrl}") "a")) (and (should-pass (&.regex "\\p{Punct}") "@") @@ -132,8 +133,8 @@ (and (should-pass (&.regex "\\p{Graph}") "@") (should-fail (&.regex "\\p{Graph}") " ")) - (and (should-pass (&.regex "\\p{Print}") "\u0020") - (should-fail (&.regex "\\p{Print}") "\u1234")) + (and (should-pass (&.regex "\\p{Print}") (text.from-code (hex "20"))) + (should-fail (&.regex "\\p{Print}") (text.from-code (hex "1234")))) )) )) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index fe36a58c5..38f1cc75a 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -153,13 +153,13 @@ [#let [set-10 (set.from-list number.Hash (list.n/range 0 10))] sample (|> r.nat (:: @ map (n/% 20)))] ($_ seq - (test "Values that satisfy a predicate have membership = 1. - Values that don't have membership = 0." + (test (format "Values that satisfy a predicate have membership = 1." + "Values that don't have membership = 0.") (bit/= (r/= _.true (&.membership sample (&.from-predicate n/even?))) (n/even? sample))) - (test "Values that belong to a set have membership = 1. - Values that don't have membership = 0." + (test (format "Values that belong to a set have membership = 1." + "Values that don't have membership = 0.") (bit/= (r/= _.true (&.membership sample (&.from-set set-10))) (set.member? set-10 sample))) )))) -- cgit v1.3.1 From a89088576c4e586d3dad18f82eb451ff4eaa14fb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 00:03:26 -0400 Subject: No more escaping of double-quotes. --- luxc/src/lux/lexer.clj | 2 - stdlib/source/lux.lux | 127 ++++++++++++----------- stdlib/source/lux/cli.lux | 4 +- stdlib/source/lux/compiler/default/syntax.lux | 36 ++----- stdlib/source/lux/control/comonad.lux | 2 +- stdlib/source/lux/control/pipe.lux | 2 +- stdlib/source/lux/data/format/html.lux | 18 ++-- stdlib/source/lux/data/format/json.lux | 12 +-- stdlib/source/lux/data/format/xml.lux | 12 +-- stdlib/source/lux/data/number.lux | 2 +- stdlib/source/lux/data/text/regex.lux | 5 +- stdlib/source/lux/host.jvm.lux | 4 +- stdlib/source/lux/interpreter.lux | 2 +- stdlib/source/lux/io.lux | 2 +- stdlib/source/lux/macro.lux | 2 +- stdlib/source/lux/macro/syntax.lux | 2 +- stdlib/test/test/lux/compiler/default/syntax.lux | 45 +------- stdlib/test/test/lux/data/text/format.lux | 2 +- stdlib/test/test/lux/host.jvm.lux | 2 +- stdlib/test/test/lux/macro/code.lux | 4 +- 20 files changed, 120 insertions(+), 167 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 1b4722083..8f6d4e19c 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -39,8 +39,6 @@ (case (.charAt raw-line (+ 1 idx)) \n (do (.append buffer "\n") (recur (+ 2 idx))) - \" (do (.append buffer "\"") - (recur (+ 2 idx))) \\ (do (.append buffer "\\") (recur (+ 2 idx))) ;; else diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 5ffe8d939..5e14a9806 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,3 +1,8 @@ +("lux def" double-quote + ("lux check" (0 "#Text" (0)) + ("lux int char" +34)) + [["" 0 0] (10 (0))]) + ("lux def" dummy-cursor ("lux check" (2 (0 "#Text" (0)) (2 (0 "#I64" (1 (0 "#Nat" (0)) (0))) @@ -37,7 +42,7 @@ (1 [[dummy-cursor (7 ["lux" "doc"])] [dummy-cursor (5 ("lux text concat" "The type of things whose type is undefined.\n\n" - "Useful for expressions that cause errors or other \"extraordinary\" conditions."))]] + "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] (0)))))]) ## (type: (List a) @@ -1572,10 +1577,10 @@ (text$ ("lux text concat" "## Left-association for the application of binary functions over variadic arguments.\n\n" ("lux text concat" - "(_$ text/compose \"Hello, \" name \".\\nHow are you?\")\n\n" + "(_$ text/compose ''Hello, '' name ''.\\nHow are you?'')\n\n" ("lux text concat" "## =>\n\n" - "(text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")"))))] + "(text/compose (text/compose ''Hello, '' name) ''.\\nHow are you?'')"))))] #Nil) ({(#Cons op tokens') ({(#Cons first nexts) @@ -1594,10 +1599,10 @@ (text$ ("lux text concat" "## Right-association for the application of binary functions over variadic arguments.\n\n" ("lux text concat" - "($_ text/compose \"Hello, \" name \".\\nHow are you?\")\n\n" + "($_ text/compose ''Hello, '' name ''.\\nHow are you?'')\n\n" ("lux text concat" "## =>\n\n" - "(text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))"))))] + "(text/compose ''Hello, '' (text/compose name ''.\\nHow are you?''))"))))] #Nil) ({(#Cons op tokens') ({(#Cons last prevs) @@ -1727,8 +1732,8 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "Picks which expression to evaluate based on a bit test value." "\n\n" - "(if #1 \"Oh, yeah!\" \"Aw hell naw!\")" "\n\n" - "=> \"Oh, yeah!\""))]) + "(if #1 ''Oh, yeah!'' ''Aw hell naw!'')" "\n\n" + "=> ''Oh, yeah!''"))]) ({(#Cons test (#Cons then (#Cons else #Nil))) (return (list (form$ (list (record$ (list [(bit$ #1) then] [(bit$ #0) else])) @@ -1975,8 +1980,8 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Macro to treat define new primitive types." "\n\n" - "(primitive \"java.lang.Object\")" "\n\n" - "(primitive \"java.util.List\" [(primitive \"java.lang.Long\")])"))]) + "(primitive ''java.lang.Object'')" "\n\n" + "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) ({(#Cons [_ (#Text class-name)] #Nil) (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) @@ -2038,7 +2043,7 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Quotation as a macro." "\n\n" - "(' \"YOLO\")"))]) + "(' YOLO)"))]) ({(#Cons template #Nil) (do Monad [=template (untemplate #0 "" template)] @@ -2052,9 +2057,9 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Piping macro." "\n\n" - "(|> elems (list/map int/encode) (interpose \" \") (fold text/compose \"\"))" "\n\n" + "(|> elems (list/map int/encode) (interpose '' '') (fold text/compose ''''))" "\n\n" "## =>" "\n\n" - "(fold text/compose \"\" (interpose \" \" (list/map int/encode elems)))"))]) + "(fold text/compose '''' (interpose '' '' (list/map int/encode elems)))"))]) ({(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) (function' [app acc] @@ -2078,9 +2083,9 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Reverse piping macro." "\n\n" - "(<| (fold text/compose \"\") (interpose \" \") (list/map int/encode) elems)" "\n\n" + "(<| (fold text/compose '''') (interpose '' '') (list/map int/encode) elems)" "\n\n" "## =>" "\n\n" - "(fold text/compose \"\" (interpose \" \" (list/map int/encode elems)))"))]) + "(fold text/compose '''' (interpose '' '' (list/map int/encode elems)))"))]) ({(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) (function' [app acc] @@ -2961,10 +2966,10 @@ (text$ ($_ "lux text concat" "## Sequential execution of expressions (great for side-effects)." "\n\n" "(exec" "\n" - " " "(log! \"#1\")" "\n" - " " "(log! \"#2\")" "\n" - " " "(log! \"#3\")" "\n" - "\"YOLO\")"))]) + " " "(log! ''#1'')" "\n" + " " "(log! ''#2'')" "\n" + " " "(log! ''#3'')" "\n" + "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (identifier$ ["" ""])] (return (list (list/fold ("lux check" (-> Code Code Code) @@ -3046,7 +3051,7 @@ (frac/encode value) [_ (#Text value)] - ($_ text/compose "\"" value "\"") + ($_ text/compose ..double-quote value ..double-quote) [_ (#Identifier [prefix name])] (if (text/= "" prefix) @@ -3107,11 +3112,11 @@ (do Monad [] (wrap (list))) _ - (fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches - (list/map code-to-text) - (interpose " ") - list/reverse - (list/fold text/compose ""))))} + (fail ($_ text/compose "'lux.case' expects an even number of tokens: " (|> branches + (list/map code-to-text) + (interpose " ") + list/reverse + (list/fold text/compose ""))))} branches)) (macro:' #export (case tokens) @@ -3438,7 +3443,7 @@ " ([#Identifier] [#Tag])" "\n\n" " _" "\n" - " (fail \"Wrong syntax for name-of\")))"))]) + " (fail ''Wrong syntax for name-of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) Code Code]) (case tokens @@ -3568,8 +3573,8 @@ _ (fail )))] - [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting \"and\".\n(and #1 #0 #1) ## => #0"] - [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\".\n(or #1 #0 #1) ## => #1"]) + [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and'.\n(and #1 #0 #1) ## => #0"] + [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or'.\n(or #1 #0 #1) ## => #1"]) (def: (index-of part text) (-> Text Text (Maybe Nat)) @@ -3604,7 +3609,7 @@ (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" "## Causes an error, with the given error message." "\n" - "(error! \"OH NO!\")"))} + "(error! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) @@ -3851,7 +3856,7 @@ (#Left "Not expecting any type."))))) (macro: #export (structure tokens) - {#.doc "Not meant to be used directly. Prefer \"structure:\"."} + {#.doc "Not meant to be used directly. Prefer 'structure:'."} (do Monad [tokens' (monad/map Monad macro-expand tokens) struct-type get-expected-type @@ -3961,7 +3966,7 @@ (structure (~+ definitions))))))) #None - (fail "Cannot infer name, so struct must have a name other than \"_\"!")) + (fail "Cannot infer name, so struct must have a name other than '_'!")) #None (fail "Wrong syntax for structure:")))) @@ -4492,9 +4497,9 @@ (macro: #export (^open tokens) {#.doc (text$ ($_ "lux text concat" - "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings." "\n" - "## Takes an \"alias\" text for the generated local bindings." "\n" - "(def: #export (range (^open \".\") from to)" "\n" + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." "\n" + "## Takes an 'alias' text for the generated local bindings." "\n" + "(def: #export (range (^open ''.'') from to)" "\n" " (All [a] (-> (Enum a) a a (List a)))" "\n" " (range' <= succ from to))"))} (case tokens @@ -4509,7 +4514,7 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #None - (fail (text/compose "Can only \"open\" structs: " (type/encode init-type))) + (fail (text/compose "Can only 'open' structs: " (type/encode init-type))) (#Some tags&members) (do Monad @@ -4544,11 +4549,11 @@ (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" "## Branching structures with multiple test conditions." "\n" - "(cond (n/even? num) \"even\"" "\n" - " (n/odd? num) \"odd\"" + "(cond (n/even? num) ''even''" "\n" + " (n/odd? num) ''odd''" "\n\n" " ## else-branch" "\n" - " \"???\")"))} + " ''???'')"))} (if (n/= 0 (n/% 2 (list/size tokens))) (fail "cond requires an uneven number of arguments.") (case (list/reverse tokens) @@ -4649,7 +4654,7 @@ "## Opens a structure and generates a definition for each of its members (including nested members)." "\n\n" "## For example:" "\n" - "(open: \"i:.\" Number)" + "(open: ''i:.'' Number)" "\n\n" "## Will generate:" "\n" "(def: i:+ (:: Number +))" "\n" @@ -4674,7 +4679,7 @@ (return (list/join decls'))) _ - (fail (text/compose "Can only \"open:\" structs: " (type/encode struct-type))))) + (fail (text/compose "Can only 'open:' structs: " (type/encode struct-type))))) _ (do Monad @@ -4689,9 +4694,9 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." "\n" - "(|>> (list/map int/encode) (interpose \" \") (fold text/compose \"\"))" "\n" + "(|>> (list/map int/encode) (interpose '' '') (fold text/compose ''''))" "\n" "## =>" "\n" - "(function (_ ) (fold text/compose \"\" (interpose \" \" (list/map int/encode ))))"))} + "(function (_ ) (fold text/compose '''' (interpose '' '' (list/map int/encode ))))"))} (do Monad [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4700,9 +4705,9 @@ (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." "\n" - "(<<| (fold text/compose \"\") (interpose \" \") (list/map int/encode))" "\n" + "(<<| (fold text/compose '''') (interpose '' '') (list/map int/encode))" "\n" "## =>" "\n" - "(function (_ ) (fold text/compose \"\" (interpose \" \" (list/map int/encode ))))"))} + "(function (_ ) (fold text/compose '''' (interpose '' '' (list/map int/encode ))))"))} (do Monad [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4832,17 +4837,17 @@ "## Can take optional annotations and allows the specification of modules to import." "\n\n" "## Example" "\n" - "(.module: {#.doc \"Some documentation...\"}" "\n" + "(.module: {#.doc ''Some documentation...''}" "\n" " [lux #*" "\n" " [control" "\n" - " [\"M\" monad #*]]" "\n" + " [''M'' monad #*]]" "\n" " [data" "\n" " maybe" "\n" - " [\".\" name (\"name/.\" Codec)]]" "\n" + " [''.'' name (''name/.'' Codec)]]" "\n" " [macro" "\n" " code]]" "\n" " [//" "\n" - " [type (\".\" Equivalence)]])"))} + " [type (''.'' Equivalence)]])"))} (do Monad [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens @@ -4887,7 +4892,7 @@ (macro: #export (set@ tokens) {#.doc (text$ ($_ "lux text concat" "## Sets the value of a record at a given tag." "\n" - "(set@ #name \"Lux\" lang)" + "(set@ #name ''Lux'' lang)" "\n\n" "## Can also work with multiple levels of nesting:" "\n" "(set@ [#foo #bar #baz] value my-record)" @@ -5154,7 +5159,7 @@ (def: (text/encode original) (-> Text Text) - ($_ text/compose "\"" original "\"")) + ($_ text/compose ..double-quote original ..double-quote)) (do-template [ ] [(def: #export ( value) @@ -5272,8 +5277,8 @@ "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." "\n\n" "## For Example:" "\n" - "(doc \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop.\"" "\n" - " \"Can be used in monadic code to create monadic loops.\"" "\n" + "(doc ''Allows arbitrary looping, using the \\''recur\\'' form to re-start the loop.''" "\n" + " ''Can be used in monadic code to create monadic loops.''" "\n" " (loop [count +0" "\n" " x init]" "\n" " (if (< +10 count)" "\n" @@ -5337,7 +5342,7 @@ (identifier$ [module name]))) (macro: #export (loop tokens) - {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." + {#.doc (doc "Allows arbitrary looping, using the 'recur' form to re-start the loop." "Can be used in monadic code to create monadic loops." (loop [count +0 x init] @@ -5480,18 +5485,18 @@ (compare (:: Code/encode encode )) (compare #1 (:: Equivalence = ))] - [(bit #1) "#1" [_ (#.Bit #1)]] - [(bit #0) "#0" [_ (#.Bit #0)]] + [(bit #1) "#1" [_ (#.Bit #1)]] + [(bit #0) "#0" [_ (#.Bit #0)]] [(int +123) "+123" [_ (#.Int +123)]] [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "\n") "\"\\n\"" [_ (#.Text "\n")]] - [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] - [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] + [(text "\n") "'\\n'" [_ (#.Text "\n")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] - [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] - [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] + [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] )] (test-all ))))} (case tokens @@ -5597,7 +5602,7 @@ (wrap (list pattern'))) _ - (fail "Wrong syntax for \"static\"."))) + (fail "Wrong syntax for 'static'."))) (type: Multi-Level-Case [Code (List [Code Code])]) @@ -5750,7 +5755,7 @@ (fail "Wrong syntax for $"))) (def: #export (is? reference sample) - {#.doc (doc "Tests whether the 2 values are identical (not just \"equal\")." + {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." "This one should succeed:" (let [value +5] (is? value value)) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index abb1d0c38..07e79d86f 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -66,7 +66,7 @@ [[remaining raw] (any inputs)] (if (text/= reference raw) (wrap [remaining []]) - (E.fail (format "Missing token: \"" reference "\"")))))) + (E.fail (format "Missing token: '" reference "'")))))) (def: #export (somewhere cli) {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."} @@ -118,7 +118,7 @@ (syntax: #export (program: {args program-args^} body) - {#.doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)." + {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." (program: all-args (do Monad diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index dc22de5d0..faa072d88 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -62,25 +62,25 @@ (def: new-line "\n") ## (def: new-line^ (l.this new-line)) -(def: text-delimiter "\"") +(def: #export text-delimiter text.double-quote) ## (def: text-delimiter^ (l.this text-delimiter)) -(def: open-form "(") -(def: close-form ")") +(def: #export open-form "(") +(def: #export close-form ")") -(def: open-tuple "[") -(def: close-tuple "]") +(def: #export open-tuple "[") +(def: #export close-tuple "]") -(def: open-record "{") -(def: close-record "}") +(def: #export open-record "{") +(def: #export close-record "}") (def: escape "\\") -(def: sigil "#") +(def: #export sigil "#") -(def: digit-separator "_") +(def: #export digit-separator "_") -(def: single-line-comment-marker (format ..sigil ..sigil)) +## (def: comment-marker (format ..sigil ..sigil)) ## ## This is the parser for white-space. ## ## Whenever a new-line is encountered, the column gets reset to 0, and @@ -105,7 +105,7 @@ ## (def: (comment^ where) ## (-> Cursor (Lexer Cursor)) ## (do p.Monad -## [_ (l.this ..single-line-comment-marker) +## [_ (l.this ..comment-marker) ## _ (l.some! (l.none-of! new-line)) ## _ ..new-line^] ## (wrap (|> where @@ -138,7 +138,6 @@ (case code ## Handle special cases. "n" (wrap [2 ..new-line]) - (^ (static ..text-delimiter)) (wrap [2 ..text-delimiter]) (^ (static ..escape)) (wrap [2 ..escape]) _ @@ -608,19 +607,6 @@ (["n" (static ..new-line)] [(~~ (static ..escape)) (static ..escape)]) - (^ (char (~~ (static ..text-delimiter)))) - (case (!find-next-escape 2 next-escape end source-code total (static ..text-delimiter)) - (#error.Error error) - (#error.Error error) - - (#error.Success [next-escape' post-delimiter so-far]) - (case ("lux text index" source-code (static ..text-delimiter) post-delimiter) - (#.Some end') - (recur end' next-escape' so-far) - - _ - (ex.throw invalid-escape-syntax []))) - _ (ex.throw invalid-escape-syntax [])))))) diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index 76fe954e5..2d96364ad 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -28,7 +28,7 @@ (def: _cursor Cursor ["" 0 0]) (macro: #export (be tokens state) - {#.doc (doc "A co-monadic parallel to the \"do\" macro." + {#.doc (doc "A co-monadic parallel to the 'do' macro." (let [square (function (_ n) (i/* n n))] (be CoMonad [inputs (iterate inc +2)] diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 4895a4f66..a5f9eca95 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -128,7 +128,7 @@ (tuple> [(i/* +10)] [dec (i// +2)] [Int/encode])) - "Will become: [+50 +2 \"+5\"]")} + "Will become: [+50 +2 '+5']")} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] [(~+ (list/map (function (_ body) (` (|> (~ g!temp) (~+ body)))) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index cc5e6d0e9..45a7117ad 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -18,7 +18,7 @@ (text.replace-all "&" "&") (text.replace-all "<" "<") (text.replace-all ">" ">") - (text.replace-all "\"" """) + (text.replace-all text.double-quote """) (text.replace-all "'" "'") (text.replace-all "/" "/"))) @@ -28,7 +28,7 @@ (def: attrs-to-text (-> Attributes Text) - (|>> (list/map (function (_ [key val]) (format key "=" "\"" (text val) "\""))) + (|>> (list/map (function (_ [key val]) (format key "=" text.double-quote (text val) text.double-quote))) (text.join-with " "))) (def: #export (tag name attrs children) @@ -39,13 +39,15 @@ "")) (do-template [ ] - [(def: #export ( document) + [(def: #export (-> HTML HTML) - (format - document))] + (let [doc-type ] + (function (_ document) + (format doc-type + document))))] [html-5 ""] - [html-4_01 ""] - [xhtml-1_0 ""] - [xhtml-1_1 ""] + [html-4_01 (format "")] + [xhtml-1_0 (format "")] + [xhtml-1_1 (format "")] ) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 1d0837b90..9189b375f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -113,10 +113,10 @@ (#e.Success value) #.None - (#e.Error ($_ text/compose "Missing field \"" key "\" on object."))) + (#e.Error ($_ text/compose "Missing field '" key "' on object."))) _ - (#e.Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get field '" key "' of a non-object.")))) (def: #export (set key value json) {#.doc "A JSON object field setter."} @@ -126,7 +126,7 @@ (#e.Success (#Object (dict.put key value obj))) _ - (#e.Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot set field '" key "' of a non-object.")))) (do-template [ ] [(def: #export ( key json) @@ -352,7 +352,7 @@ (fail error)) _ - (fail ($_ text/compose "JSON object does not have field \"" field-name "\"."))) + (fail ($_ text/compose "JSON object does not have field '" field-name "'."))) _ (fail "JSON value is not an object.")))) @@ -469,10 +469,10 @@ (def: string~ (l.Lexer String) - (<| (l.enclosed ["\"" "\""]) + (<| (l.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do p.Monad - [chars (l.some (l.none-of "\\\"")) + [chars (l.some (l.none-of (text/compose "\\" text.double-quote))) stop l.peek]) (if (text/= "\\" stop) (do @ diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 61215813b..a5cb39ab5 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -33,7 +33,7 @@ (p.after (l.this ">") (parser/wrap ">")) (p.after (l.this "&") (parser/wrap "&")) (p.after (l.this "'") (parser/wrap "'")) - (p.after (l.this """) (parser/wrap "\"")))) + (p.after (l.this """) (parser/wrap text.double-quote)))) (def: xml-unicode-escape-char^ (l.Lexer Text) @@ -56,7 +56,7 @@ (def: xml-char^ (l.Lexer Text) - (p.either (l.none-of "<>&'\"") + (p.either (l.none-of ($_ text/compose "<>&'" text.double-quote)) xml-escape-char^)) (def: xml-identifier @@ -92,7 +92,7 @@ (def: attr-value^ (l.Lexer Text) (let [value^ (l.some xml-char^)] - (p.either (l.enclosed ["\"" "\""] value^) + (p.either (l.enclosed [text.double-quote text.double-quote] value^) (l.enclosed ["'" "'"] value^)))) (def: attrs^ @@ -181,7 +181,7 @@ (text.replace-all "<" "<") (text.replace-all ">" ">") (text.replace-all "'" "'") - (text.replace-all "\"" """))) + (text.replace-all text.double-quote """))) (def: (write-tag [namespace name]) (-> Tag Text) @@ -194,12 +194,12 @@ (|> attrs d.entries (list/map (function (_ [key value]) - ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) + ($_ text/compose (write-tag key) "=" text.double-quote (sanitize-value value) text.double-quote))) (text.join-with " "))) (def: xml-header Text - "") + ($_ text/compose "")) (def: #export (write input) (-> XML Text) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4b3b786b4..df3e2d353 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -682,7 +682,7 @@ (~ example-2))))])) _ - (#error.Error "Wrong syntax for \"encoding-doc\"."))) + (#error.Error "Wrong syntax for 'encoding-doc'."))) (def: (underscore-prefixed? number) (-> Text Bit) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index e491873dc..bb2c570e3 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -54,7 +54,7 @@ (def: name-char^ (l.Lexer Text) - (l.none-of "[]{}()s\"#.<>")) + (l.none-of (format "[]{}()s#.<>" //.double-quote))) (def: name-part^ (l.Lexer Text) @@ -135,7 +135,8 @@ (def: punct^ (l.Lexer Text) - (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) + (l.one-of (format "!#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" + //.double-quote))) (def: graph^ (l.Lexer Text) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 9bb839aec..b5a2454e1 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1319,10 +1319,10 @@ "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." "Fields and methods defined in the class can be used with special syntax." "For example:" - "::resolved, for accessing the \"resolved\" field." + "::resolved, for accessing the 'resolved' field." "(:= ::resolved #1) for modifying it." "(::new! []) for calling the class's constructor." - "(::resolve! container [value]) for calling the \"resolve\" method." + "(::resolve! container [value]) for calling the 'resolve' method." )} (do Monad [current-module macro.current-module-name diff --git a/stdlib/source/lux/interpreter.lux b/stdlib/source/lux/interpreter.lux index df475475a..6837f24d9 100644 --- a/stdlib/source/lux/interpreter.lux +++ b/stdlib/source/lux/interpreter.lux @@ -44,7 +44,7 @@ Text (format "\n" "Welcome to the interpreter!" "\n" - "Type \"exit\" to leave." "\n" + "Type 'exit' to leave." "\n" "\n")) (def: farewell-message diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 5ec03c749..96503f10e 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -16,7 +16,7 @@ (macro: #export (io tokens state) {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." - "Great for wrapping effectful computations (which will not be performed until the IO is \"run\")." + "Great for wrapping effectful computations (which will not be performed until the IO is 'run')." (io (exec (log! msg) "Some value...")))} diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 88299a812..10b5d3b41 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -365,7 +365,7 @@ (def: #export (gensym prefix) {#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)." - "A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes.")} + "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")} (-> Text (Meta Code)) (function (_ compiler) (#e.Success [(update@ #.seed inc compiler) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index db5e086b6..74901beb9 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -196,7 +196,7 @@ ## [Syntax] (macro: #export (syntax: tokens) - {#.doc (doc "A more advanced way to define macros than \"macro:\"." + {#.doc (doc "A more advanced way to define macros than 'macro:'." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Monad, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 5ac8e16da..e24779057 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -29,7 +29,7 @@ (r.Random Text) (do r.Monad [#let [digits "0123456789" - delimiters "()[]{}#.\"" + delimiters (format "()[]{}#." &.text-delimiter) space " \n" invalid-range (format digits delimiters space) char-gen (|> r.nat @@ -129,48 +129,9 @@ (<| (seed 12137892244981970631) ## (times 100) (do @ - [#let [char-gen (|> r.nat (r.filter (function (_ value) - (not (or (text.space? value) - (n/= (char "\"") value))))))] - x char-gen - y char-gen - z char-gen - offset-size (|> r.nat (r/map (|>> (n/% 10) (n/max 1)))) - #let [offset (text.join-with "" (list.repeat offset-size " "))] - sample code^ - comment comment^ - unbalanced-comment comment-text^] + [sample code^ + comment comment^] ($_ seq - (test "Will reject invalid multi-line text." - (let [bad-match (format (text.from-code x) "\n" - (text.from-code y) "\n" - (text.from-code z))] - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 - (format "\"" bad-match "\"")]) - (#e.Error error) - #1 - - (#e.Success [_ parsed]) - #0))) - (test "Will accept valid multi-line text" - (let [good-input (format (text.from-code x) "\n" - offset (text.from-code y) "\n" - offset (text.from-code z)) - good-output (format (text.from-code x) "\n" - (text.from-code y) "\n" - (text.from-code z))] - (case (&.read "" (dict.new text.Hash) - [(|> default-cursor (update@ #.column (n/+ (dec offset-size)))) - 0 - (format "\"" good-input "\"")]) - (#e.Error error) - #0 - - (#e.Success [_ parsed]) - (:: code.Equivalence = - parsed - (code.text good-output))))) (test "Can handle comments." (case (&.read "" (dict.new text.Hash) [default-cursor 0 diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index bd66712a8..48cf24306 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -16,6 +16,6 @@ (&/= "+123" (%i +123)) (&/= "+123.456" (%f +123.456)) (&/= ".5" (%r .5)) - (&/= "\"YOLO\"" (%t "YOLO")) + (&/= (format text.double-quote "YOLO" text.double-quote) (%t "YOLO")) (&/= "User-id: +123 -- Active: #1" (format "User-id: " (%i +123) " -- Active: " (%b #1))))) ))) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 8832bb3f6..835bdd719 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -88,7 +88,7 @@ (&.instance? Object "") (not (&.instance? Object (&.null))))) - (test "Can run code in a \"synchronized\" block." + (test "Can run code in a 'synchronized' block." (&.synchronized "" #1)) (test "Can access Class instances." diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index 1e0d4a606..be53adfad 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -5,7 +5,7 @@ [monad (#+ do Monad)]] [data [number] - [text ("text/." Equivalence) + ["." text ("text/." Equivalence) format]] [math ["r" random]] [macro ["&" code]]] @@ -22,7 +22,7 @@ [(&.bit #0) "#0"] [(&.int +123) "+123"] [(&.frac +123.0) "+123.0"] - [(&.text "\n") "\"\\n\""] + [(&.text "1234") (format text.double-quote "1234" text.double-quote)] [(&.tag ["yolo" "lol"]) "#yolo.lol"] [(&.identifier ["yolo" "lol"]) "yolo.lol"] [(&.form (list (&.bit #1) (&.int +123))) "(#1 +123)"] -- cgit v1.3.1 From bc251026c21590da76085bc0bc9abeaa5ec242b6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 00:56:59 -0400 Subject: No more escaping of new-line. --- luxc/src/lux/lexer.clj | 20 +- stdlib/source/lux.lux | 496 +++++++++++---------- .../source/lux/compiler/default/phase/analysis.lux | 2 +- .../compiler/default/phase/analysis/expression.lux | 4 +- .../compiler/default/phase/analysis/function.lux | 2 +- .../compiler/default/phase/analysis/inference.lux | 2 +- .../lux/compiler/default/phase/extension.lux | 2 +- .../default/phase/extension/analysis/host.jvm.lux | 40 +- stdlib/source/lux/compiler/default/syntax.lux | 19 +- stdlib/source/lux/control/concatenative.lux | 2 +- stdlib/source/lux/control/exception.lux | 8 +- stdlib/source/lux/control/region.lux | 12 +- stdlib/source/lux/data/format/css.lux | 2 +- stdlib/source/lux/data/format/xml.lux | 10 +- stdlib/source/lux/data/number.lux | 4 +- stdlib/source/lux/data/text.lux | 34 +- stdlib/source/lux/data/text/regex.lux | 2 +- stdlib/source/lux/interpreter.lux | 12 +- stdlib/source/lux/io.lux | 4 +- stdlib/source/lux/macro.lux | 10 +- stdlib/source/lux/macro/poly.lux | 2 +- stdlib/source/lux/macro/syntax.lux | 2 +- stdlib/source/lux/math/modular.lux | 10 +- stdlib/source/lux/test.lux | 16 +- stdlib/source/lux/type.lux | 4 +- stdlib/source/lux/type/check.lux | 6 +- stdlib/test/test/lux/compiler/default/syntax.lux | 6 +- stdlib/test/test/lux/macro/syntax.lux | 4 +- 28 files changed, 362 insertions(+), 375 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 8f6d4e19c..fc572790b 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -37,8 +37,6 @@ (if (= \\ current-char) (do (assert (< (+ 1 idx) line-length) (str "[Lexer Error] Text is too short for escaping: " raw-line " " idx)) (case (.charAt raw-line (+ 1 idx)) - \n (do (.append buffer "\n") - (recur (+ 2 idx))) \\ (do (.append buffer "\\") (recur (+ 2 idx))) ;; else @@ -47,26 +45,12 @@ (recur (+ 1 idx))))) (.toString buffer))))) -(defn- lex-text-body [_] - (|do [[_ _ ^String pre-quotes*] (&reader/read-regex #"^([^\"]*)") - [pre-quotes post-quotes] (if (.endsWith pre-quotes* "\\") - (if (if-let [^String back-slashes (re-find #"\\+$" pre-quotes*)] - (odd? (.length back-slashes))) - (|do [[_ _ _] (&reader/read-regex #"^([\"])") - next-part (lex-text-body nil)] - (return (&/T [(.substring pre-quotes* 0 (dec (.length pre-quotes*))) - (str "\"" next-part)]))) - (|do [post-quotes* (lex-text-body nil)] - (return (&/T [pre-quotes* post-quotes*])))) - (return (&/T [pre-quotes* ""])))] - (return (str (clean-line pre-quotes) post-quotes)))) - (def lex-text (|do [[meta _ _] (&reader/read-text "\"") :let [[_ _ _column] meta] - token (lex-text-body nil) + [_ _ ^String content] (&reader/read-regex #"^([^\"]*)") _ (&reader/read-text "\"")] - (return (&/T [meta ($Text token)])))) + (return (&/T [meta ($Text (clean-line content))])))) (def +ident-re+ #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 5e14a9806..0417c9a4d 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3,6 +3,16 @@ ("lux int char" +34)) [["" 0 0] (10 (0))]) +("lux def" new-line + ("lux check" (0 "#Text" (0)) + ("lux int char" +10)) + [["" 0 0] (10 (0))]) + +("lux def" __paragraph + ("lux check" (0 "#Text" (0)) + ("lux text concat" new-line new-line)) + [["" 0 0] (10 (0))]) + ("lux def" dummy-cursor ("lux check" (2 (0 "#Text" (0)) (2 (0 "#I64" (1 (0 "#Nat" (0)) (0))) @@ -25,7 +35,7 @@ [dummy-cursor (0 #1)]] (1 [[dummy-cursor (7 ["lux" "doc"])] [dummy-cursor (5 ("lux text concat" - "The type of things whose type is irrelevant.\n\n" + ("lux text concat" "The type of things whose type is irrelevant." __paragraph) "It can be used to write functions or data-structures that can take, or return, anything."))]] (0)))))]) @@ -41,7 +51,7 @@ [dummy-cursor (0 #1)]] (1 [[dummy-cursor (7 ["lux" "doc"])] [dummy-cursor (5 ("lux text concat" - "The type of things whose type is undefined.\n\n" + ("lux text concat" "The type of things whose type is undefined." __paragraph) "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] (0)))))]) @@ -104,7 +114,7 @@ [dummy-cursor (0 #1)]] (#Cons [[dummy-cursor (7 ["lux" "doc"])] [dummy-cursor (5 ("lux text concat" - "Natural numbers (unsigned integers).\n\n" + ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) "They start at zero (0) and extend in the positive direction."))]] #Nil))))]) @@ -130,7 +140,7 @@ [dummy-cursor (0 #1)]] (#Cons [[dummy-cursor (7 ["lux" "doc"])] [dummy-cursor (5 ("lux text concat" - "Fractional numbers that live in the interval [0,1).\n\n" + ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) "Useful for probability, and other domains that work within that interval."))]] #Nil))))]) @@ -167,9 +177,7 @@ (#Cons [[dummy-cursor (7 ["lux" "export?"])] [dummy-cursor (0 #1)]] (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 ("lux text concat" - "A name.\n\n" - "It is used as part of Lux syntax to represent identifiers and tags."))]] + [dummy-cursor (5 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] #Nil))))]) ## (type: (Maybe a) @@ -753,9 +761,9 @@ #Nil)))))))))))))] (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "Represents the state of the Lux compiler during a run.\n\n" + ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph) ("lux text concat" - "It is provided to macros during their invocation, so they can access compiler data.\n\n" + ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] default-def-meta-exported)))) @@ -769,7 +777,7 @@ (#Apply Text Either))))) (record$ (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "Computations that can have access to the state of the compiler.\n\n" + ("lux text concat" "Computations that can have access to the state of the compiler." __paragraph) "These computations may fail, or modify the state of the compiler."))] (#Cons [(tag$ ["lux" "type-args"]) (tuple$ (#Cons (text$ "a") #Nil))] @@ -1033,9 +1041,9 @@ (macro:' #export (comment tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Throws away any code given to it.\n\n" + ("lux text concat" "## Throws away any code given to it." __paragraph) ("lux text concat" - "## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor.\n\n" + ("lux text concat" "## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor." __paragraph) "(comment +1 +2 +3 +4)")))] #Nil) (return #Nil)) @@ -1227,11 +1235,11 @@ (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Universal quantification.\n\n" + ("lux text concat" "## Universal quantification." __paragraph) ("lux text concat" - "(All [a] (-> a a))\n\n" + ("lux text concat" "(All [a] (-> a a))" __paragraph) ("lux text concat" - "## A name can be provided, to specify a recursive type.\n\n" + ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) "(All List [a] (| Any [a (List a)]))"))))] #Nil) (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) @@ -1271,11 +1279,11 @@ (macro:' #export (Ex tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Existential quantification.\n\n" + ("lux text concat" "## Existential quantification." __paragraph) ("lux text concat" - "(Ex [a] [(Codec Text a) a])\n\n" + ("lux text concat" "(Ex [a] [(Codec Text a) a])" __paragraph) ("lux text concat" - "## A name can be provided, to specify a recursive type.\n\n" + ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) "(Ex Self [a] [(Codec Text a) a (List (Self a))])"))))] #Nil) (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) @@ -1323,9 +1331,9 @@ (macro:' #export (-> tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Function types:\n\n" + ("lux text concat" "## Function types:" __paragraph) ("lux text concat" - "(-> Int Int Int)\n\n" + ("lux text concat" "(-> Int Int Int)" __paragraph) "## This is the type of a function that takes 2 Ints and returns an Int.")))] #Nil) ({(#Cons output inputs) @@ -1342,7 +1350,7 @@ (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## List-construction macro.\n\n" + ("lux text concat" "## List-construction macro." __paragraph) "(list +1 +2 +3)"))] #Nil) (return (#Cons (list/fold (function'' [head tail] @@ -1356,9 +1364,9 @@ (macro:' #export (list& xs) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## List-construction macro, with the last element being a tail-list.\n\n" + ("lux text concat" "## List-construction macro, with the last element being a tail-list." __paragraph) ("lux text concat" - "## In other words, this macro prepends elements to another list.\n\n" + ("lux text concat" "## In other words, this macro prepends elements to another list." __paragraph) "(list& +1 +2 +3 (list +4 +5 +6))")))] #Nil) ({(#Cons last init) @@ -1375,11 +1383,11 @@ (macro:' #export (& tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Tuple types:\n\n" + ("lux text concat" "## Tuple types:" __paragraph) ("lux text concat" - "(& Text Int Bit)\n\n" + ("lux text concat" "(& Text Int Bit)" __paragraph) ("lux text concat" - "## Any.\n\n" + ("lux text concat" "## Any." __paragraph) "(&)"))))] #Nil) ({#Nil @@ -1394,11 +1402,11 @@ (macro:' #export (| tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Variant types:\n\n" + ("lux text concat" "## Variant types:" __paragraph) ("lux text concat" - "(| Text Int Bit)\n\n" + ("lux text concat" "(| Text Int Bit)" __paragraph) ("lux text concat" - "## Nothing.\n\n" + ("lux text concat" "## Nothing." __paragraph) "(|)"))))] #Nil) ({#Nil @@ -1575,12 +1583,12 @@ (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Left-association for the application of binary functions over variadic arguments.\n\n" + ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new-line) ("lux text concat" - "(_$ text/compose ''Hello, '' name ''.\\nHow are you?'')\n\n" + ("lux text concat" "(_$ text/compose ''Hello, '' name ''. How are you?'')" ..new-line) ("lux text concat" - "## =>\n\n" - "(text/compose (text/compose ''Hello, '' name) ''.\\nHow are you?'')"))))] + ("lux text concat" "## =>" ..new-line) + "(text/compose (text/compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') ({(#Cons first nexts) @@ -1597,12 +1605,12 @@ (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - "## Right-association for the application of binary functions over variadic arguments.\n\n" + ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new-line) ("lux text concat" - "($_ text/compose ''Hello, '' name ''.\\nHow are you?'')\n\n" + ("lux text concat" "($_ text/compose ''Hello, '' name ''. How are you?'')" ..new-line) ("lux text concat" - "## =>\n\n" - "(text/compose ''Hello, '' (text/compose name ''.\\nHow are you?''))"))))] + ("lux text concat" "## =>" ..new-line) + "(text/compose ''Hello, '' (text/compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') ({(#Cons last prevs) @@ -1731,8 +1739,8 @@ (macro:' #export (if tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "Picks which expression to evaluate based on a bit test value." "\n\n" - "(if #1 ''Oh, yeah!'' ''Aw hell naw!'')" "\n\n" + "Picks which expression to evaluate based on a bit test value." __paragraph + "(if #1 ''Oh, yeah!'' ''Aw hell naw!'')" __paragraph "=> ''Oh, yeah!''"))]) ({(#Cons test (#Cons then (#Cons else #Nil))) (return (list (form$ (list (record$ (list [(bit$ #1) then] @@ -1772,7 +1780,7 @@ (def:''' #export (log! message) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "Logs message to standard output." "\n\n" + "Logs message to standard output." __paragraph "Useful for debugging."))]) (-> Text Any) ("lux io log" message)) @@ -1979,8 +1987,8 @@ (macro:' #export (primitive tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro to treat define new primitive types." "\n\n" - "(primitive ''java.lang.Object'')" "\n\n" + "## Macro to treat define new primitive types." __paragraph + "(primitive ''java.lang.Object'')" __paragraph "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) ({(#Cons [_ (#Text class-name)] #Nil) (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) @@ -2010,8 +2018,8 @@ (macro:' #export (` tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." "\n\n" - "## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." "\n\n" + "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph + "## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." __paragraph "(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) (do Monad @@ -2028,7 +2036,7 @@ (macro:' #export (`' tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." "\n\n" + "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph "(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) (do Monad @@ -2042,7 +2050,7 @@ (macro:' #export (' tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Quotation as a macro." "\n\n" + "## Quotation as a macro." __paragraph "(' YOLO)"))]) ({(#Cons template #Nil) (do Monad @@ -2056,9 +2064,9 @@ (macro:' #export (|> tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Piping macro." "\n\n" - "(|> elems (list/map int/encode) (interpose '' '') (fold text/compose ''''))" "\n\n" - "## =>" "\n\n" + "## Piping macro." __paragraph + "(|> elems (list/map int/encode) (interpose '' '') (fold text/compose ''''))" __paragraph + "## =>" __paragraph "(fold text/compose '''' (interpose '' '' (list/map int/encode elems)))"))]) ({(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) @@ -2082,9 +2090,9 @@ (macro:' #export (<| tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Reverse piping macro." "\n\n" - "(<| (fold text/compose '''') (interpose '' '') (list/map int/encode) elems)" "\n\n" - "## =>" "\n\n" + "## Reverse piping macro." __paragraph + "(<| (fold text/compose '''') (interpose '' '') (list/map int/encode) elems)" __paragraph + "## =>" __paragraph "(fold text/compose '''' (interpose '' '' (list/map int/encode elems)))"))]) ({(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) @@ -2257,10 +2265,10 @@ (macro:' #export (do-template tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." "\n\n" - "(do-template [ ]" "\n" - " " "[(def: #export (-> Int Int) (i/+ ))]" "\n\n" - " " "[inc +1]" "\n" + "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." __paragraph + "(do-template [ ]" ..new-line + " " "[(def: #export (-> Int Int) (i/+ ))]" __paragraph + " " "[inc +1]" ..new-line " " "[dec -1]"))]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] @@ -2608,8 +2616,8 @@ (def:''' #export (not x) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Bit negation." "\n\n" - "(not #1) => #0" "\n\n" + "## Bit negation." __paragraph + "(not #1) => #0" __paragraph "(not #0) => #1"))]) (-> Bit Bit) (if x #0 #1)) @@ -2820,7 +2828,7 @@ (macro:' #export (type tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Takes a type expression and returns it's representation as data-structure." "\n\n" + "## Takes a type expression and returns it's representation as data-structure." __paragraph "(type (All [a] (Maybe (List a))))"))]) ({(#Cons type #Nil) (do Monad @@ -2839,7 +2847,7 @@ (macro:' #export (: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## The type-annotation macro." "\n\n" + "## The type-annotation macro." __paragraph "(: (List Int) (list +1 +2 +3))"))]) ({(#Cons type (#Cons value #Nil)) (return (list (` ("lux check" (type (~ type)) (~ value))))) @@ -2851,7 +2859,7 @@ (macro:' #export (:coerce tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## The type-coercion macro." "\n\n" + "## The type-coercion macro." __paragraph "(:coerce Dinosaur (list +1 +2 +3))"))]) ({(#Cons type (#Cons value #Nil)) (return (list (` ("lux coerce" (type (~ type)) (~ value))))) @@ -2949,8 +2957,8 @@ (macro:' #export (Rec tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Parameter-less recursive types." "\n\n" - "## A name has to be given to the whole type, to use it within its body." "\n\n" + "## Parameter-less recursive types." __paragraph + "## A name has to be given to the whole type, to use it within its body." __paragraph "(Rec Self [Int (List Self)])"))]) ({(#Cons [_ (#Identifier "" name)] (#Cons body #Nil)) (let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-parameter 1)) (~ (make-parameter 0))))]) @@ -2964,11 +2972,11 @@ (macro:' #export (exec tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Sequential execution of expressions (great for side-effects)." "\n\n" - "(exec" "\n" - " " "(log! ''#1'')" "\n" - " " "(log! ''#2'')" "\n" - " " "(log! ''#3'')" "\n" + "## Sequential execution of expressions (great for side-effects)." __paragraph + "(exec" ..new-line + " " "(log! ''#1'')" ..new-line + " " "(log! ''#2'')" ..new-line + " " "(log! ''#3'')" ..new-line "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (identifier$ ["" ""])] @@ -3122,12 +3130,12 @@ (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## The pattern-matching macro." "\n" - "## Allows the usage of macros within the patterns to provide custom syntax." "\n" - "(case (: (List Int) (list +1 +2 +3))" "\n" - " " "(#Cons x (#Cons y (#Cons z #Nil)))" "\n" - " " "(#Some ($_ i/* x y z))" "\n\n" - " " "_" "\n" + "## The pattern-matching macro." ..new-line + "## Allows the usage of macros within the patterns to provide custom syntax." ..new-line + "(case (: (List Int) (list +1 +2 +3))" ..new-line + " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new-line + " " "(#Some ($_ i/* x y z))" __paragraph + " " "_" ..new-line " " "#None)"))]) ({(#Cons value branches) (do Monad @@ -3141,13 +3149,13 @@ (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-expanding patterns." "\n" - "## It's a special macro meant to be used with 'case'." "\n" - "(case (: (List Int) (list +1 +2 +3))" "\n" - " (^ (list x y z))" "\n" + "## Macro-expanding patterns." ..new-line + "## It's a special macro meant to be used with 'case'." ..new-line + "(case (: (List Int) (list +1 +2 +3))" ..new-line + " (^ (list x y z))" ..new-line " (#Some ($_ i/* x y z))" - "\n\n" - " _" "\n" + __paragraph + " _" ..new-line " #None)"))]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) @@ -3166,17 +3174,17 @@ (macro:' #export (^or tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Or-patterns." "\n" - "## It's a special macro meant to be used with 'case'." "\n" + "## Or-patterns." ..new-line + "## It's a special macro meant to be used with 'case'." ..new-line "(type: Weekday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday)" - "\n\n" - "(def: (weekend? day)" "\n" - " (-> Weekday Bit)" "\n" - " (case day" "\n" - " (^or #Saturday #Sunday)" "\n" + __paragraph + "(def: (weekend? day)" ..new-line + " (-> Weekday Bit)" ..new-line + " (case day" ..new-line + " (^or #Saturday #Sunday)" ..new-line " #1" - "\n\n" - " _" "\n" + __paragraph + " _" ..new-line " #0))"))]) (case tokens (^ (list& [_ (#Form patterns)] body branches)) @@ -3204,10 +3212,10 @@ (macro:' #export (let tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Creates local bindings." "\n" - "## Can (optionally) use pattern-matching macros when binding." "\n" - "(let [x (foo bar)" "\n" - " y (baz quux)]" "\n" + "## Creates local bindings." ..new-line + "## Can (optionally) use pattern-matching macros when binding." ..new-line + "(let [x (foo bar)" ..new-line + " y (baz quux)]" ..new-line " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) @@ -3230,12 +3238,12 @@ (macro:' #export (function tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Syntax for creating functions." "\n" - "## Allows for giving the function itself a name, for the sake of recursion." "\n" - "(: (All [a b] (-> a b a))" "\n" + "## Syntax for creating functions." ..new-line + "## Allows for giving the function itself a name, for the sake of recursion." ..new-line + "(: (All [a b] (-> a b a))" ..new-line " (function (_ x y) x))" - "\n\n" - "(: (All [a b] (-> a b a))" "\n" + __paragraph + "(: (All [a b] (-> a b a))" ..new-line " (function (const x y) x))"))]) (case (: (Maybe [Text Code (List Code) Code]) (case tokens @@ -3349,14 +3357,14 @@ (macro:' #export (def: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Defines global constants/functions." "\n" - "(def: (rejoin-pair pair)" "\n" - " (-> [Code Code] (List Code))" "\n" - " (let [[left right] pair]" "\n" + "## Defines global constants/functions." ..new-line + "(def: (rejoin-pair pair)" ..new-line + " (-> [Code Code] (List Code))" ..new-line + " (let [[left right] pair]" ..new-line " (list left right)))" - "\n\n" - "(def: branching-exponent" "\n" - " Int" "\n" + __paragraph + "(def: branching-exponent" ..new-line + " Int" ..new-line " +5)"))]) (let [[export? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) @@ -3434,15 +3442,15 @@ (macro:' #export (macro: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-definition macro." "\n" - "(macro: #export (name-of tokens)" "\n" - " (case tokens" "\n" - " (^template []" "\n" - " (^ (list [_ ( [prefix name])]))" "\n" - " (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))" "\n" + "## Macro-definition macro." ..new-line + "(macro: #export (name-of tokens)" ..new-line + " (case tokens" ..new-line + " (^template []" ..new-line + " (^ (list [_ ( [prefix name])]))" ..new-line + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))" ..new-line " ([#Identifier] [#Tag])" - "\n\n" - " _" "\n" + __paragraph + " _" ..new-line " (fail ''Wrong syntax for name-of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) Code Code]) @@ -3481,17 +3489,17 @@ (macro: #export (signature: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of signatures ala ML." "\n" - "(signature: #export (Ord a)" "\n" - " (: (Equivalence a)" "\n" - " eq)" "\n" - " (: (-> a a Bit)" "\n" - " <)" "\n" - " (: (-> a a Bit)" "\n" - " <=)" "\n" - " (: (-> a a Bit)" "\n" - " >)" "\n" - " (: (-> a a Bit)" "\n" + "## Definition of signatures ala ML." ..new-line + "(signature: #export (Ord a)" ..new-line + " (: (Equivalence a)" ..new-line + " eq)" ..new-line + " (: (-> a a Bit)" ..new-line + " <)" ..new-line + " (: (-> a a Bit)" ..new-line + " <=)" ..new-line + " (: (-> a a Bit)" ..new-line + " >)" ..new-line + " (: (-> a a Bit)" ..new-line " >=))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Name (List Code) Code (List Code)]) @@ -3573,8 +3581,8 @@ _ (fail )))] - [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and'.\n(and #1 #0 #1) ## => #0"] - [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or'.\n(or #1 #0 #1) ## => #1"]) + [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] + [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) (def: (index-of part text) (-> Text Text (Maybe Nat)) @@ -3608,18 +3616,18 @@ (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" - "## Causes an error, with the given error message." "\n" + "## Causes an error, with the given error message." ..new-line "(error! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) (macro: (default tokens state) {#.doc (text$ ($_ "lux text concat" - "## Allows you to provide a default value that will be used" "\n" + "## Allows you to provide a default value that will be used" ..new-line "## if a (Maybe x) value turns out to be #.None." - "\n\n" + __paragraph "(default +20 (#.Some +10)) ## => +10" - "\n\n" + __paragraph "(default +20 #.None) ## => +20"))} (case tokens (^ (list else maybe)) @@ -3894,18 +3902,18 @@ (macro: #export (structure: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of structures ala ML." "\n" - "(structure: #export Ord (Ord Int)" "\n" - " (def: eq Equivalence)" "\n" - " (def: (< test subject)" "\n" - " (lux.i/< test subject))" "\n" - " (def: (<= test subject)" "\n" - " (or (lux.i/< test subject)" "\n" - " (lux.i/= test subject)))" "\n" - " (def: (> test subject)" "\n" - " (lux.i/> test subject))" "\n" - " (def: (>= test subject)" "\n" - " (or (lux.i/> test subject)" "\n" + "## Definition of structures ala ML." ..new-line + "(structure: #export Ord (Ord Int)" ..new-line + " (def: eq Equivalence)" ..new-line + " (def: (< test subject)" ..new-line + " (lux.i/< test subject))" ..new-line + " (def: (<= test subject)" ..new-line + " (or (lux.i/< test subject)" ..new-line + " (lux.i/= test subject)))" ..new-line + " (def: (> test subject)" ..new-line + " (lux.i/> test subject))" ..new-line + " (def: (>= test subject)" ..new-line + " (or (lux.i/> test subject)" ..new-line " (lux.i/= test subject))))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) @@ -3978,7 +3986,7 @@ (macro: #export (type: tokens) {#.doc (text$ ($_ "lux text concat" - "## The type-definition macro." "\n" + "## The type-definition macro." ..new-line "(type: (List a) #Nil (#Cons a (List a)))"))} (let [[exported? tokens'] (export^ tokens) [rec? tokens'] (case tokens' @@ -4211,9 +4219,9 @@ _ ($_ text/compose prefix "/" clean))] (return output)) (fail ($_ "lux text concat" - "Cannot climb the module hierarchy...\n" - "Importing module: " module "\n" - " Relative Root: " relative-root "\n")))))) + "Cannot climb the module hierarchy..." ..new-line + "Importing module: " module ..new-line + " Relative Root: " relative-root ..new-line)))))) (def: (parse-imports nested? relative-root imports) (-> Bit Text (List Code) (Meta (List Importation))) @@ -4497,10 +4505,10 @@ (macro: #export (^open tokens) {#.doc (text$ ($_ "lux text concat" - "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." "\n" - "## Takes an 'alias' text for the generated local bindings." "\n" - "(def: #export (range (^open ''.'') from to)" "\n" - " (All [a] (-> (Enum a) a a (List a)))" "\n" + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new-line + "## Takes an 'alias' text for the generated local bindings." ..new-line + "(def: #export (range (^open ''.'') from to)" ..new-line + " (All [a] (-> (Enum a) a a (List a)))" ..new-line " (range' <= succ from to))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) @@ -4548,11 +4556,11 @@ (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" - "## Branching structures with multiple test conditions." "\n" - "(cond (n/even? num) ''even''" "\n" + "## Branching structures with multiple test conditions." ..new-line + "(cond (n/even? num) ''even''" ..new-line " (n/odd? num) ''odd''" - "\n\n" - " ## else-branch" "\n" + __paragraph + " ## else-branch" ..new-line " ''???'')"))} (if (n/= 0 (n/% 2 (list/size tokens))) (fail "cond requires an uneven number of arguments.") @@ -4583,14 +4591,14 @@ (macro: #export (get@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Accesses the value of a record at a given tag." "\n" + "## Accesses the value of a record at a given tag." ..new-line "(get@ #field my-record)" - "\n\n" - "## Can also work with multiple levels of nesting:" "\n" + __paragraph + "## Can also work with multiple levels of nesting:" ..new-line "(get@ [#foo #bar #baz] my-record)" - "\n\n" - "## And, if only the slot/path is given, generates an accessor function:" "\n" - "(let [getter (get@ [#foo #bar #baz])]" "\n" + __paragraph + "## And, if only the slot/path is given, generates an accessor function:" ..new-line + "(let [getter (get@ [#foo #bar #baz])]" ..new-line " (getter my-record))"))} (case tokens (^ (list [_ (#Tag slot')] record)) @@ -4652,14 +4660,14 @@ (macro: #export (open: tokens) {#.doc (text$ ($_ "lux text concat" "## Opens a structure and generates a definition for each of its members (including nested members)." - "\n\n" - "## For example:" "\n" + __paragraph + "## For example:" ..new-line "(open: ''i:.'' Number)" - "\n\n" - "## Will generate:" "\n" - "(def: i:+ (:: Number +))" "\n" - "(def: i:- (:: Number -))" "\n" - "(def: i:* (:: Number *))" "\n" + __paragraph + "## Will generate:" ..new-line + "(def: i:+ (:: Number +))" ..new-line + "(def: i:- (:: Number -))" ..new-line + "(def: i:* (:: Number *))" ..new-line "..."))} (case tokens (^ (list [_ (#Text alias)] struct)) @@ -4693,9 +4701,9 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." "\n" - "(|>> (list/map int/encode) (interpose '' '') (fold text/compose ''''))" "\n" - "## =>" "\n" + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line + "(|>> (list/map int/encode) (interpose '' '') (fold text/compose ''''))" ..new-line + "## =>" ..new-line "(function (_ ) (fold text/compose '''' (interpose '' '' (list/map int/encode ))))"))} (do Monad [g!_ (gensym "_") @@ -4704,9 +4712,9 @@ (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." "\n" - "(<<| (fold text/compose '''') (interpose '' '') (list/map int/encode))" "\n" - "## =>" "\n" + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line + "(<<| (fold text/compose '''') (interpose '' '') (list/map int/encode))" ..new-line + "## =>" ..new-line "(function (_ ) (fold text/compose '''' (interpose '' '' (list/map int/encode ))))"))} (do Monad [g!_ (gensym "_") @@ -4744,10 +4752,10 @@ _ (fail ($_ text/compose "Wrong syntax for refer @ " current-module - "\n" (|> options - (list/map code-to-text) - (interpose " ") - (list/fold text/compose ""))))))) + ..new-line (|> options + (list/map code-to-text) + (interpose " ") + (list/fold text/compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) (-> Text Refer (Meta (List Code))) @@ -4833,20 +4841,20 @@ (macro: #export (module: tokens) {#.doc (text$ ($_ "lux text concat" "## Module-definition macro." - "\n\n" + __paragraph "## Can take optional annotations and allows the specification of modules to import." - "\n\n" - "## Example" "\n" - "(.module: {#.doc ''Some documentation...''}" "\n" - " [lux #*" "\n" - " [control" "\n" - " [''M'' monad #*]]" "\n" - " [data" "\n" - " maybe" "\n" - " [''.'' name (''name/.'' Codec)]]" "\n" - " [macro" "\n" - " code]]" "\n" - " [//" "\n" + __paragraph + "## Example" ..new-line + "(.module: {#.doc ''Some documentation...''}" ..new-line + " [lux #*" ..new-line + " [control" ..new-line + " [''M'' monad #*]]" ..new-line + " [data" ..new-line + " maybe" ..new-line + " [''.'' name (''name/.'' Codec)]]" ..new-line + " [macro" ..new-line + " code]]" ..new-line + " [//" ..new-line " [type (''.'' Equivalence)]])"))} (do Monad [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] @@ -4874,10 +4882,10 @@ (macro: #export (:: tokens) {#.doc (text$ ($_ "lux text concat" - "## Allows accessing the value of a structure's member." "\n" + "## Allows accessing the value of a structure's member." ..new-line "(:: Codec encode)" - "\n\n" - "## Also allows using that value as a function." "\n" + __paragraph + "## Also allows using that value as a function." ..new-line "(:: Codec encode +123)"))} (case tokens (^ (list struct [_ (#Identifier member)])) @@ -4891,14 +4899,14 @@ (macro: #export (set@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Sets the value of a record at a given tag." "\n" + "## Sets the value of a record at a given tag." ..new-line "(set@ #name ''Lux'' lang)" - "\n\n" - "## Can also work with multiple levels of nesting:" "\n" + __paragraph + "## Can also work with multiple levels of nesting:" ..new-line "(set@ [#foo #bar #baz] value my-record)" - "\n\n" - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" "\n" - "(let [setter (set@ [#foo #bar #baz] value)] (setter my-record))" "\n" + __paragraph + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line + "(let [setter (set@ [#foo #bar #baz] value)] (setter my-record))" ..new-line "(let [setter (set@ [#foo #bar #baz])] (setter value my-record))"))} (case tokens (^ (list [_ (#Tag slot')] value record)) @@ -4978,14 +4986,14 @@ (macro: #export (update@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Modifies the value of a record at a given tag, based on some function." "\n" + "## Modifies the value of a record at a given tag, based on some function." ..new-line "(update@ #age inc person)" - "\n\n" - "## Can also work with multiple levels of nesting:" "\n" + __paragraph + "## Can also work with multiple levels of nesting:" ..new-line "(update@ [#foo #bar #baz] func my-record)" - "\n\n" - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" "\n" - "(let [updater (update@ [#foo #bar #baz] func)] (updater my-record))" "\n" + __paragraph + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line + "(let [updater (update@ [#foo #bar #baz] func)] (updater my-record))" ..new-line "(let [updater (update@ [#foo #bar #baz])] (updater func my-record))"))} (case tokens (^ (list [_ (#Tag slot')] fun record)) @@ -5051,38 +5059,38 @@ (macro: #export (^template tokens) {#.doc (text$ ($_ "lux text concat" - "## It's similar to do-template, but meant to be used during pattern-matching." "\n" - "(def: (beta-reduce env type)" "\n" - " (-> (List Type) Type Type)" "\n" - " (case type" "\n" - " (#.Primitive name params)" "\n" + "## It's similar to do-template, but meant to be used during pattern-matching." ..new-line + "(def: (beta-reduce env type)" ..new-line + " (-> (List Type) Type Type)" ..new-line + " (case type" ..new-line + " (#.Primitive name params)" ..new-line " (#.Primitive name (list/map (beta-reduce env) params))" - "\n\n" - " (^template []" "\n" - " ( left right)" "\n" - " ( (beta-reduce env left) (beta-reduce env right)))" "\n" + __paragraph + " (^template []" ..new-line + " ( left right)" ..new-line + " ( (beta-reduce env left) (beta-reduce env right)))" ..new-line " ([#.Sum] [#.Product])" - "\n\n" - " (^template []" "\n" - " ( left right)" "\n" - " ( (beta-reduce env left) (beta-reduce env right)))" "\n" + __paragraph + " (^template []" ..new-line + " ( left right)" ..new-line + " ( (beta-reduce env left) (beta-reduce env right)))" ..new-line " ([#.Function] [#.Apply])" - "\n\n" - " (^template []" "\n" - " ( old-env def)" "\n" - " (case old-env" "\n" - " #.Nil" "\n" + __paragraph + " (^template []" ..new-line + " ( old-env def)" ..new-line + " (case old-env" ..new-line + " #.Nil" ..new-line " ( env def)" - "\n\n" - " _" "\n" - " type))" "\n" + __paragraph + " _" ..new-line + " type))" ..new-line " ([#.UnivQ] [#.ExQ])" - "\n\n" - " (#.Parameter idx)" "\n" + __paragraph + " (#.Parameter idx)" ..new-line " (default type (list.nth idx env))" - "\n\n" - " _" "\n" - " type" "\n" + __paragraph + " _" ..new-line + " type" ..new-line " ))"))} (case tokens (^ (list& [_ (#Form (list& [_ (#Tuple bindings)] templates))] @@ -5196,7 +5204,7 @@ (-> Nat Cursor Cursor Text) (if (n/= old-line new-line) (text/join (repeat (.int (n/- old-column new-column)) " ")) - (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) "\n")) + (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) ..new-line)) space-padding (text/join (repeat (.int (n/- baseline new-column)) " "))] (text/compose extra-lines space-padding)))) @@ -5262,27 +5270,27 @@ (case fragment (#Doc-Comment comment) (|> comment - (text/split "\n") - (list/map (function (_ line) ($_ text/compose "## " line "\n"))) + (text/split ..new-line) + (list/map (function (_ line) ($_ text/compose "## " line ..new-line))) text/join) (#Doc-Example example) (let [baseline (find-baseline-column example) [cursor _] example [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] - (text/compose text "\n\n")))) + (text/compose text __paragraph)))) (macro: #export (doc tokens) {#.doc (text$ ($_ "lux text concat" "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." - "\n\n" - "## For Example:" "\n" - "(doc ''Allows arbitrary looping, using the \\''recur\\'' form to re-start the loop.''" "\n" - " ''Can be used in monadic code to create monadic loops.''" "\n" - " (loop [count +0" "\n" - " x init]" "\n" - " (if (< +10 count)" "\n" - " (recur (inc count) (f x))" "\n" + __paragraph + "## For Example:" ..new-line + "(doc ''Allows arbitrary looping, using the \\''recur\\'' form to re-start the loop.''" ..new-line + " ''Can be used in monadic code to create monadic loops.''" ..new-line + " (loop [count +0" ..new-line + " x init]" ..new-line + " (if (< +10 count)" ..new-line + " (recur (inc count) (f x))" ..new-line " x)))"))} (return (list (` [(~ cursor-code) (#.Text (~ (|> tokens @@ -5489,7 +5497,7 @@ [(bit #0) "#0" [_ (#.Bit #0)]] [(int +123) "+123" [_ (#.Int +123)]] [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "\n") "'\\n'" [_ (#.Text "\n")]] + [(text "123") "'123'" [_ (#.Text "123")]] [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index e26cd3516..615075800 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -236,7 +236,7 @@ output]) (#error.Error error) - (#error.Error (format "@ " (%cursor cursor) "\n" + (#error.Error (format "@ " (%cursor cursor) text.new-line error))))))) (do-template [ ] diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux index 073cc9950..317f86a6f 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux @@ -26,14 +26,14 @@ (exception: #export (macro-expansion-failed {macro Name} {inputs (List Code)} {error Text}) (ex.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format "\n" text.tab))) + (list/map (|>> %code (format text.new-line text.tab))) (text.join-with ""))] ["Error" error])) (exception: #export (macro-call-must-have-single-expansion {macro Name} {inputs (List Code)}) (ex.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format "\n" text.tab))) + (list/map (|>> %code (format text.new-line text.tab))) (text.join-with ""))])) (exception: #export (unrecognized-syntax {code Code}) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/function.lux b/stdlib/source/lux/compiler/default/phase/analysis/function.lux index 1f0e4c8f9..a996457d9 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/function.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/function.lux @@ -30,7 +30,7 @@ ["Arguments" (|> arguments list.enumerate (list/map (.function (_ [idx argC]) - (format "\n " (%n idx) " " (%code argC)))) + (format text.new-line " " (%n idx) " " (%code argC)))) (text.join-with ""))])) (def: #export (function analyse function-name arg-name body) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/inference.lux b/stdlib/source/lux/compiler/default/phase/analysis/inference.lux index c96d0457c..010bdc437 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/inference.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/inference.lux @@ -27,7 +27,7 @@ ["Arguments" (|> args list.enumerate (list/map (function (_ [idx argC]) - (format "\n " (%n idx) " " (%code argC)))) + (format text.new-line " " (%n idx) " " (%code argC)))) (text.join-with ""))])) (exception: #export (cannot-infer-argument {inferred Type} {argument Code}) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index c7a2048a8..c87d8d54c 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -49,7 +49,7 @@ ["Available" (|> bundle dictionary.keys (list.sort text/<) - (list/map (|>> %t (format "\n" text.tab))) + (list/map (|>> %t (format text.new-line text.tab))) (text.join-with ""))])) (exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 31f4b33ff..64edb791b 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -95,7 +95,7 @@ (ex.report ["Class" class] ["Method" method] ["Hints" (|> hints - (list/map (|>> product.left %type (format "\n" text.tab))) + (list/map (|>> product.left %type (format text.new-line text.tab))) (text.join-with ""))]))] [no-candidates] @@ -643,14 +643,14 @@ num-type-params (list.size params)] (cond (not (text/= class-name name)) (////.throw cannot-correspond-type-with-a-class - (format "Class = " class-name "\n" + (format "Class = " class-name text.new-line "Type = " (%type type))) (not (n/= num-class-params num-type-params)) (////.throw type-parameter-mismatch - (format "Expected: " (%i (.int num-class-params)) "\n" - " Actual: " (%i (.int num-type-params)) "\n" - " Class: " class-name "\n" + (format "Expected: " (%i (.int num-class-params)) text.new-line + " Actual: " (%i (.int num-type-params)) text.new-line + " Class: " class-name text.new-line " Type: " (%type type))) ## else @@ -704,9 +704,9 @@ (wrap #1)) (do @ [current-class (load-class current-name) - _ (////.assert cannot-cast (format "From class/primitive: " current-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n") + _ (////.assert cannot-cast (format "From class/primitive: " current-name text.new-line + " To class/primitive: " to-name text.new-line + " For value: " (%code valueC) text.new-line) (Class::isAssignableFrom [current-class] to-class)) candiate-parents (monad.map @ (function (_ java-type) @@ -726,17 +726,17 @@ (recur [next-name nextT])) #.Nil - (////.throw cannot-cast (format "From class/primitive: " from-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n"))) + (////.throw cannot-cast (format "From class/primitive: " from-name text.new-line + " To class/primitive: " to-name text.new-line + " For value: " (%code valueC) text.new-line))) ))))))] (if can-cast? (wrap (#analysis.Extension extension-name (list (analysis.text from-name) (analysis.text to-name) valueA))) - (////.throw cannot-cast (format "From class/primitive: " from-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n")))) + (////.throw cannot-cast (format "From class/primitive: " from-name text.new-line + " To class/primitive: " to-name text.new-line + " For value: " (%code valueC) text.new-line)))) _ (////.throw ///.invalid-syntax extension-name)))) @@ -764,9 +764,9 @@ (if (is? owner class) (wrap [class field]) (////.throw mistaken-field-owner - (format " Field: " field-name "\n" - " Owner Class: " (Class::getName [] owner) "\n" - "Target Class: " class-name "\n")))) + (format " Field: " field-name text.new-line + " Owner Class: " (Class::getName [] owner) text.new-line + "Target Class: " class-name text.new-line)))) (#e.Error _) (////.throw unknown-field (format class-name "#" field-name))))) @@ -802,9 +802,9 @@ [#let [num-params (list.size _class-params) num-vars (list.size var-names)] _ (////.assert type-parameter-mismatch - (format "Expected: " (%i (.int num-params)) "\n" - " Actual: " (%i (.int num-vars)) "\n" - " Class: " _class-name "\n" + (format "Expected: " (%i (.int num-params)) text.new-line + " Actual: " (%i (.int num-vars)) text.new-line + " Class: " _class-name text.new-line " Type: " (%type objectT)) (n/= num-params num-vars))] (wrap (|> (list.zip2 var-names _class-params) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index faa072d88..92f223940 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -59,7 +59,6 @@ (def: digits+ (format "_" ..digits)) (def: white-space " ") -(def: new-line "\n") ## (def: new-line^ (l.this new-line)) (def: #export text-delimiter text.double-quote) @@ -128,7 +127,7 @@ ## (:: p.Monad wrap where))) ## Escaped character sequences follow the usual syntax of -## back-slash followed by a letter (e.g. \n). +## back-slash followed by a letter. ## Escaped characters may show up in Char and Text literals. (def: escaped-char^ (Lexer [Nat Text]) @@ -137,7 +136,6 @@ [code l.any] (case code ## Handle special cases. - "n" (wrap [2 ..new-line]) (^ (static ..escape)) (wrap [2 ..escape]) _ @@ -255,7 +253,7 @@ ## ($_ p.either ## ## Normal text characters. ## (do @ -## [normal (l.slice (l.many! (l.none-of! (format ..escape ..text-delimiter ..new-line))))] +## [normal (l.slice (l.many! (l.none-of! (format ..escape ..text-delimiter text.new-line))))] ## (recur (format text-read normal) ## (update@ #.column (n/+ (text.size normal)) where) ## #0)) @@ -373,7 +371,7 @@ ## ..sigil ## ..text-delimiter ## ..name-separator) -## space (format ..white-space ..new-line) +## space (format ..white-space text.new-line) ## head (l.none-of! (format ..digits delimiters space)) ## tail (l.some! (l.none-of! (format delimiters space)))] ## (l.slice (l.and! head tail)))) @@ -585,7 +583,7 @@ (#error.Success [("lux text size" source-code) (!inc end) ]))))) (template: (!guarantee-no-new-lines content body) - (case ("lux text index" content (static ..new-line) 0) + (case ("lux text index" content (static text.new-line) 0) (#.Some g!_) (ex.throw ..text-cannot-contain-new-lines content) @@ -604,8 +602,7 @@ (^template [ ] (^ (char )) (!find-next-escape 2 next-escape end source-code total )) - (["n" (static ..new-line)] - [(~~ (static ..escape)) (static ..escape)]) + ([(~~ (static ..escape)) (static ..escape)]) _ (ex.throw invalid-escape-syntax [])))))) @@ -666,7 +663,7 @@ (`` (template: (!strict-name-char? char) (not (or ("lux i64 =" (.char (~~ (static ..white-space))) char) - ("lux i64 =" (.char (~~ (static ..new-line))) char) + ("lux i64 =" (.char (~~ (static text.new-line))) char) ("lux i64 =" (.char (~~ (static ..name-separator))) char) @@ -836,7 +833,7 @@ ([(~~ (static ..white-space)) #.column] [(~~ (static text.carriage-return)) #.column]) - (^ (char (~~ (static ..new-line)))) + (^ (char (~~ (static text.new-line)))) (recur tracker [(!new-line where) (!inc offset) source-code]) ## Form @@ -868,7 +865,7 @@ ## Single-line comment (^ (char (~~ (static ..sigil)))) - (case ("lux text index" source-code (static ..new-line) offset') + (case ("lux text index" source-code (static text.new-line) offset') (#.Some end) (recur tracker [(!new-line where) (!inc end) source-code]) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 0011c8956..80fa1b40e 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -63,7 +63,7 @@ (wrap singleton) _ - (macro.fail (format "Cannot expand to more than a single AST/Code node:\n" + (macro.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line (|> expansion (list/map %code) (text.join-with " "))))))) (syntax: #export (=> {aliases aliases^} diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 085269e54..a906c97aa 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -98,7 +98,7 @@ (macro.with-gensyms [g!descriptor] (do @ [current-module macro.current-module-name - #let [descriptor ($_ text/compose "{" current-module "." name "}" "\n") + #let [descriptor ($_ text/compose "{" current-module "." name "}" text.new-line) g!self (code.local-identifier name)]] (wrap (list (` (def: (~+ (csw.export export)) (~ g!self) @@ -122,7 +122,7 @@ (list.repeat (n/- (text.size header) largest-header-size)) (text.join-with ""))] - ($_ text/compose padding header ": " message "\n")))) + ($_ text/compose padding header ": " message text.new-line)))) (text.join-with "")))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) @@ -132,9 +132,9 @@ (def: separator ($_ "lux text concat" - "\n\n" + text.new-line text.new-line "-----------------------------------------" - "\n\n")) + text.new-line text.new-line)) (def: #export (with-stack exception message computation) (All [e a] (-> (Exception e) e (Error a) (Error a))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 7bd43bd09..cfd074f6b 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -7,7 +7,7 @@ ["ex" exception (#+ Exception exception:)]] [data ["e" error (#+ Error)] - [text + ["." text format] [collection [list ("list/." Fold)]]]]) @@ -22,11 +22,11 @@ (def: separator Text - (format "\n" - "-----------------------------------------\n" - "-----------------------------------------\n" - "-----------------------------------------\n" - "\n")) + (format text.new-line + "-----------------------------------------" text.new-line + "-----------------------------------------" text.new-line + "-----------------------------------------" text.new-line + text.new-line)) (exception: #export [a] (clean-up-error {error Text} {output (Error a)}) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 083195972..fbdad1885 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -37,7 +37,7 @@ (if (list.empty? style) "" (format selector "{" (inline style) "}")))) - (text.join-with "\n"))) + (text.join-with text.new-line))) (def: #export (rgb color) (-> Color Value) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index a5cb39ab5..0ed744b46 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -110,9 +110,9 @@ spaced^ (p.after (l.this "/")) (l.enclosed ["<" ">"]))] - (p.assert ($_ text/compose "Close tag does not match open tag.\n" - "Expected: " (name/encode expected) "\n" - " Actual: " (name/encode actual) "\n") + (p.assert ($_ text/compose "Close tag does not match open tag." text.new-line + "Expected: " (name/encode expected) text.new-line + " Actual: " (name/encode actual) text.new-line) (name/= expected actual)))) (def: comment^ @@ -254,10 +254,12 @@ (exception: #export (wrong-tag {tag Name}) (name/encode tag)) +(def: blank-line ($_ text/compose text.new-line text.new-line)) + (exception: #export (unconsumed-inputs {inputs (List XML)}) (|> inputs (list/map (:: Codec encode)) - (text.join-with "\n\n"))) + (text.join-with blank-line))) (def: #export text (Reader Text) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index df3e2d353..e45c4ff1c 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -674,9 +674,7 @@ encoding " number, generates a Nat, an Int, a Rev or a Frac.") underscore "Allows for the presence of underscore in the numbers." - description [cursor (#.Text ($_ "lux text concat" - encoding "\n" - underscore))]] + description [cursor (#.Text ($_ "lux text concat" encoding " " underscore))]] (#error.Success [state (list (` (doc (~ description) (~ example-1) (~ example-2))))])) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 0c6a5ea45..3807275c1 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -16,6 +16,22 @@ [compiler ["." host]]]) +(def: #export from-code + (-> Nat Text) + (|>> (:coerce Int) "lux int char")) + +(do-template [ ] + [(def: #export (from-code ))] + + [back-space 8] + [tab 9] + [new-line 10] + [vertical-tab 11] + [form-feed 12] + [carriage-return 13] + [double-quote 34] + ) + (def: #export (size x) (-> Text Nat) ("lux text size" x)) @@ -122,7 +138,7 @@ (#.Cons sample #.Nil))) (def: #export split-lines - (..split-all-with "\n")) + (..split-all-with ..new-line)) (def: #export (replace-once pattern value template) (-> Text Text Text Text) @@ -216,22 +232,6 @@ (-> Text Text Text) (enclose [boundary boundary] content)) -(def: #export from-code - (-> Nat Text) - (|>> (:coerce Int) "lux int char")) - -(do-template [ ] - [(def: #export (from-code ))] - - [back-space 8] - [tab 9] - [new-line 10] - [vertical-tab 11] - [form-feed 12] - [carriage-return 13] - [double-quote 34] - ) - (def: #export encode (-> Text Text) (..enclose' ..double-quote)) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index bb2c570e3..ec11c9259 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -465,7 +465,7 @@ (p.before l.end) (l.run pattern)) (#e.Error error) - (macro.fail (format "Error while parsing regular-expression:\n" + (macro.fail (format "Error while parsing regular-expression:" //.new-line error)) (#e.Success regex) diff --git a/stdlib/source/lux/interpreter.lux b/stdlib/source/lux/interpreter.lux index 6837f24d9..75389db21 100644 --- a/stdlib/source/lux/interpreter.lux +++ b/stdlib/source/lux/interpreter.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - [text ("text/." Equivalence) + ["." text ("text/." Equivalence) format]] [type (#+ :share) ["." check]] @@ -36,16 +36,16 @@ (def: (add-line line [where offset input]) (-> Text Source Source) - [where offset (format input "\n" line)]) + [where offset (format input text.new-line line)]) (def: exit-command Text "exit") (def: welcome-message Text - (format "\n" - "Welcome to the interpreter!" "\n" - "Type 'exit' to leave." "\n" - "\n")) + (format text.new-line + "Welcome to the interpreter!" text.new-line + "Type 'exit' to leave." text.new-line + text.new-line)) (def: farewell-message Text diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 96503f10e..c054c5347 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -6,9 +6,7 @@ [monad (#+ do Monad)] ["ex" exception (#+ Exception)]] [data - ["." error (#+ Error)] - [collection - [list]]]]) + ["." error (#+ Error)]]]) (type: #export (IO a) {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."} diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 10b5d3b41..5d5c8f0cf 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -507,17 +507,17 @@ _ (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))] (#e.Error ($_ text/compose - "Unknown definition: " (name/encode name) "\n" - " Current module: " current-module "\n" + "Unknown definition: " (name/encode name) text.new-line + " Current module: " current-module text.new-line (case (get current-module (get@ #.modules compiler)) (#.Some this-module) ($_ text/compose - " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) "\n" - " Aliases: " (|> this-module (get@ #.module-aliases) (list/map (function (_ [alias real]) ($_ text/compose alias " => " real))) (text.join-with ", ")) "\n") + " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) text.new-line + " Aliases: " (|> this-module (get@ #.module-aliases) (list/map (function (_ [alias real]) ($_ text/compose alias " => " real))) (text.join-with ", ")) text.new-line) _ "") - " All Known modules: " (|> compiler (get@ #.modules) (list/map product.left) (text.join-with ", ")) "\n"))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list/map product.left) (text.join-with ", ")) text.new-line))))))) (def: #export (find-def-type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 7b3bc49a2..51f7a4885 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -56,7 +56,7 @@ (exception: #export (unconsumed {remaining (List Type)}) (ex.report ["Types" (|> remaining - (list/map (|>> %type (format "\n* "))) + (list/map (|>> %type (format text.new-line "* "))) (text.join-with ""))])) (type: #export Env (Dictionary Nat [Type Code])) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 74901beb9..83137cef0 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -31,7 +31,7 @@ ## [Utils] (def: (remaining-inputs asts) (-> (List Code) Text) - ($_ text/compose "\nRemaining input: " + ($_ text/compose text.new-line "Remaining input: " (|> asts (list/map code.to-text) (list.interpose " ") (text.join-with "")))) ## [Syntaxs] diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index 883febecb..ac141a3c9 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -37,15 +37,13 @@ (exception: #export [m] (incorrect-modulus {modulus (Modulus m)} {parsed Int}) - ($_ text/compose - "Expected: " (int/encode (to-int modulus)) "\n" - " Actual: " (int/encode parsed) "\n")) + (ex.report ["Expected" (int/encode (to-int modulus))] + ["Actual" (int/encode parsed)])) (exception: #export [rm sm] (cannot-equalize-moduli {reference (Modulus rm)} {sample (Modulus sm)}) - ($_ text/compose - "Reference: " (int/encode (to-int reference)) "\n" - " Sample: " (int/encode (to-int sample)) "\n")) + (ex.report ["Reference" (int/encode (to-int reference))] + ["Sample" (int/encode (to-int sample))])) (def: #export (congruent? modulus reference sample) (All [m] (-> (Modulus m) Int Int Bit)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 5b214579d..b928b1860 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -79,9 +79,9 @@ #let [post (io.run instant.now) _ (log! (format "@ " module " " "(" (%duration (instant.span pre post)) ")" - "\n" - description "\n" - "\n" documentation "\n"))]] + text.new-line + description text.new-line + text.new-line documentation text.new-line))]] (wrap counters))))) (monad.seq @))] (wrap (list/fold add-counters start test-runs)))) @@ -99,7 +99,7 @@ (def: (times-failure seed documentation) (-> (I64 Any) Text Text) - (format "Failed with this seed: " (%n (.nat seed)) "\n" + (format "Failed with this seed: " (%n (.nat seed)) text.new-line documentation)) (def: #export (times amount test) @@ -217,9 +217,9 @@ (def: (success-message successes failures) (-> Nat Nat Text) - (format "Test-suite finished." "\n" - (%n successes) " out of " (%n (n/+ failures successes)) " tests passed." "\n" - (%n failures) " tests failed." "\n")) + (format "Test-suite finished." text.new-line + (%n successes) " out of " (%n (n/+ failures successes)) " tests passed." text.new-line + (%n failures) " tests failed." text.new-line)) (syntax: #export (run) {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules." @@ -264,4 +264,4 @@ [[l-counter l-documentation] left [r-counter r-documentation] right] (wrap [(add-counters l-counter r-counter) - (format l-documentation "\n" r-documentation)]))))) + (format l-documentation text.new-line r-documentation)]))))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index be3b54eed..ff614a328 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -345,8 +345,8 @@ [cursor macro.cursor valueT (macro.find-type valueN) #let [_ (log! ($_ text/compose - ":log!" " @ " (.cursor-description cursor) "\n" - (name/encode valueN) " : " (..to-text valueT) "\n"))]] + ":log!" " @ " (.cursor-description cursor) text.new-line + (name/encode valueN) " : " (..to-text valueT) text.new-line))]] (wrap (list (' [])))) (#.Right valueC) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index ce5ce652a..97ccc0626 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -10,7 +10,7 @@ ["." product] ["." error (#+ Error)] ["." number ("nat/." Codec)] - [text ("text/." Monoid Equivalence)] + ["." text ("text/." Monoid Equivalence)] [collection ["." list] ["." set (#+ Set)]]]] @@ -460,7 +460,9 @@ _ ($_ text/compose (on-error []) - "\n\n-----------------------------------------\n\n" + text.new-line text.new-line + "-----------------------------------------" + text.new-line text.new-line error))) output diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index e24779057..829199aa8 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (do r.Monad [#let [digits "0123456789" delimiters (format "()[]{}#." &.text-delimiter) - space " \n" + space (format " " text.new-line) invalid-range (format digits delimiters space) char-gen (|> r.nat (:: @ map (|>> (n/% 256) (n/max 1))) @@ -114,7 +114,7 @@ (def: comment-text^ (r.Random Text) - (let [char-gen (|> r.nat (r.filter (|>> (n/= (char "\n")) not)))] + (let [char-gen (|> r.nat (r.filter (|>> (n/= (`` (char (~~ (static text.new-line))))) not)))] (do r.Monad [size (|> r.nat (r/map (n/% 20)))] (r.text char-gen size)))) @@ -123,7 +123,7 @@ (r.Random Text) (do r.Monad [comment comment-text^] - (wrap (format "## " comment "\n")))) + (wrap (format "## " comment text.new-line)))) (context: "Multi-line text & comments." (<| (seed 12137892244981970631) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index b1e2f445b..0bf7b8804 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -75,9 +75,9 @@ ["Can parse Bit syntax." #1 code.bit bit.Equivalence s.bit] ["Can parse Nat syntax." 123 code.nat number.Equivalence s.nat] ["Can parse Int syntax." +123 code.int number.Equivalence s.int] - ["Can parse Rev syntax." .123 code.rev number.Equivalence s.rev] + ["Can parse Rev syntax." .123 code.rev number.Equivalence s.rev] ["Can parse Frac syntax." +123.0 code.frac number.Equivalence s.frac] - ["Can parse Text syntax." "\n" code.text text.Equivalence s.text] + ["Can parse Text syntax." text.new-line code.text text.Equivalence s.text] ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.Equivalence s.identifier] ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.Equivalence s.tag] )] -- cgit v1.3.1 From 7e312258b13c5fc9c80079fede0e41d479a8a327 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 01:24:29 -0400 Subject: No more escaping of back-slash. --- lux-mode/lux-mode.el | 3 +- luxc/src/lux/lexer.clj | 21 +----- stdlib/source/lux.lux | 2 +- stdlib/source/lux/compiler/default/name.lux | 2 +- stdlib/source/lux/compiler/default/syntax.lux | 2 +- stdlib/source/lux/data/format/json.lux | 20 ++--- stdlib/source/lux/data/text/regex.lux | 74 +++++++++---------- stdlib/test/test/lux/data/text/regex.lux | 102 +++++++++++++------------- 8 files changed, 103 insertions(+), 123 deletions(-) (limited to 'stdlib/test') diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index c48d41ae6..b3f5d2260 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -93,7 +93,6 @@ Otherwise check `define-lux-indent' and `put-lux-indent'." (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) (modify-syntax-entry ?\" "\"\"" table) - (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?# "w 124b" table) (modify-syntax-entry ?\n "> b" table) (modify-syntax-entry '(?a . ?z) "w" table) @@ -122,7 +121,7 @@ Otherwise check `define-lux-indent' and `put-lux-indent'." (modify-syntax-entry ?< "w" table) (modify-syntax-entry ?> "w" table) (modify-syntax-entry ?\; "w" table) - ;; (modify-syntax-entry ?\\ "w" table) + (modify-syntax-entry ?\\ "w" table) (modify-syntax-entry ?\s "-" table) (modify-syntax-entry ?\t "-" table) (modify-syntax-entry ?\r "-" table) diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index fc572790b..8ed75b940 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -26,31 +26,12 @@ ) ;; [Utils] -(defn- clean-line - "(-> Text Text)" - [^String raw-line] - (let [line-length (.length raw-line) - buffer (new StringBuffer line-length)] - (loop [idx 0] - (if (< idx line-length) - (let [current-char (.charAt raw-line idx)] - (if (= \\ current-char) - (do (assert (< (+ 1 idx) line-length) (str "[Lexer Error] Text is too short for escaping: " raw-line " " idx)) - (case (.charAt raw-line (+ 1 idx)) - \\ (do (.append buffer "\\") - (recur (+ 2 idx))) - ;; else - (assert false (str "[Lexer Error] Invalid escaping syntax: " raw-line " " idx)))) - (do (.append buffer current-char) - (recur (+ 1 idx))))) - (.toString buffer))))) - (def lex-text (|do [[meta _ _] (&reader/read-text "\"") :let [[_ _ _column] meta] [_ _ ^String content] (&reader/read-regex #"^([^\"]*)") _ (&reader/read-text "\"")] - (return (&/T [meta ($Text (clean-line content))])))) + (return (&/T [meta ($Text content)])))) (def +ident-re+ #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 0417c9a4d..bfbfe0678 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5285,7 +5285,7 @@ "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." __paragraph "## For Example:" ..new-line - "(doc ''Allows arbitrary looping, using the \\''recur\\'' form to re-start the loop.''" ..new-line + "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new-line " ''Can be used in monadic code to create monadic loops.''" ..new-line " (loop [count +0" ..new-line " x init]" ..new-line diff --git a/stdlib/source/lux/compiler/default/name.lux b/stdlib/source/lux/compiler/default/name.lux index ddbf9ee8f..925b0585d 100644 --- a/stdlib/source/lux/compiler/default/name.lux +++ b/stdlib/source/lux/compiler/default/name.lux @@ -12,7 +12,7 @@ (^ (char "+")) "_PLUS_" (^ (char "-")) "_DASH_" (^ (char "/")) "_SLASH_" - (^ (char "\\")) "_BSLASH_" + (^ (char "\")) "_BSLASH_" (^ (char "_")) "_UNDERS_" (^ (char "%")) "_PERCENT_" (^ (char "$")) "_DOLLAR_" diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 92f223940..778588959 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -73,7 +73,7 @@ (def: #export open-record "{") (def: #export close-record "}") -(def: escape "\\") +(def: escape "\") (def: #export sigil "#") diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 9189b375f..20f059503 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -452,29 +452,29 @@ (def: escaped~ (l.Lexer Text) ($_ p.either - (p.after (l.this "\\t") + (p.after (l.this "\t") (parser/wrap text.tab)) - (p.after (l.this "\\b") + (p.after (l.this "\b") (parser/wrap text.back-space)) - (p.after (l.this "\\n") + (p.after (l.this "\n") (parser/wrap text.new-line)) - (p.after (l.this "\\r") + (p.after (l.this "\r") (parser/wrap text.carriage-return)) - (p.after (l.this "\\f") + (p.after (l.this "\f") (parser/wrap text.form-feed)) - (p.after (l.this (text/compose "\\" text.double-quote)) + (p.after (l.this (text/compose "\" text.double-quote)) (parser/wrap text.double-quote)) - (p.after (l.this "\\\\") - (parser/wrap "\\")))) + (p.after (l.this "\\") + (parser/wrap "\")))) (def: string~ (l.Lexer String) (<| (l.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do p.Monad - [chars (l.some (l.none-of (text/compose "\\" text.double-quote))) + [chars (l.some (l.none-of (text/compose "\" text.double-quote))) stop l.peek]) - (if (text/= "\\" stop) + (if (text/= "\" stop) (do @ [escaped escaped~ next-chars (recur [])] diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index ec11c9259..ba0128b7b 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -20,12 +20,12 @@ ## [Utils] (def: regex-char^ (l.Lexer Text) - (l.none-of "\\.|&()[]{}")) + (l.none-of "\.|&()[]{}")) (def: escaped-char^ (l.Lexer Text) (do p.Monad - [? (l.this? "\\")] + [? (l.this? "\")] (if ? l.any regex-char^))) @@ -75,7 +75,7 @@ (def: (re-var^ current-module) (-> Text (l.Lexer Code)) (do p.Monad - [name (l.enclosed ["\\@<" ">"] (name^ current-module))] + [name (l.enclosed ["\@<" ">"] (name^ current-module))] (wrap (` (: (l.Lexer Text) (~ (code.identifier name))))))) (def: re-range^ @@ -135,7 +135,7 @@ (def: punct^ (l.Lexer Text) - (l.one-of (format "!#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" + (l.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" //.double-quote))) (def: graph^ @@ -153,27 +153,27 @@ [] ($_ p.either (p.after (l.this ".") (wrap (` l.any))) - (p.after (l.this "\\d") (wrap (` l.decimal))) - (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) - (p.after (l.this "\\s") (wrap (` l.space))) - (p.after (l.this "\\S") (wrap (` (l.not l.space)))) - (p.after (l.this "\\w") (wrap (` (~! word^)))) - (p.after (l.this "\\W") (wrap (` (l.not (~! word^))))) - - (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) - (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) - (p.after (l.this "\\p{Alpha}") (wrap (` l.alpha))) - (p.after (l.this "\\p{Digit}") (wrap (` l.decimal))) - (p.after (l.this "\\p{Alnum}") (wrap (` l.alpha-num))) - (p.after (l.this "\\p{Space}") (wrap (` l.space))) - (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) - (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) - (p.after (l.this "\\p{Blank}") (wrap (` (~! blank^)))) - (p.after (l.this "\\p{ASCII}") (wrap (` (~! ascii^)))) - (p.after (l.this "\\p{Contrl}") (wrap (` (~! control^)))) - (p.after (l.this "\\p{Punct}") (wrap (` (~! punct^)))) - (p.after (l.this "\\p{Graph}") (wrap (` (~! graph^)))) - (p.after (l.this "\\p{Print}") (wrap (` (~! print^)))) + (p.after (l.this "\d") (wrap (` l.decimal))) + (p.after (l.this "\D") (wrap (` (l.not l.decimal)))) + (p.after (l.this "\s") (wrap (` l.space))) + (p.after (l.this "\S") (wrap (` (l.not l.space)))) + (p.after (l.this "\w") (wrap (` (~! word^)))) + (p.after (l.this "\W") (wrap (` (l.not (~! word^))))) + + (p.after (l.this "\p{Lower}") (wrap (` l.lower))) + (p.after (l.this "\p{Upper}") (wrap (` l.upper))) + (p.after (l.this "\p{Alpha}") (wrap (` l.alpha))) + (p.after (l.this "\p{Digit}") (wrap (` l.decimal))) + (p.after (l.this "\p{Alnum}") (wrap (` l.alpha-num))) + (p.after (l.this "\p{Space}") (wrap (` l.space))) + (p.after (l.this "\p{HexDigit}") (wrap (` l.hexadecimal))) + (p.after (l.this "\p{OctDigit}") (wrap (` l.octal))) + (p.after (l.this "\p{Blank}") (wrap (` (~! blank^)))) + (p.after (l.this "\p{ASCII}") (wrap (` (~! ascii^)))) + (p.after (l.this "\p{Contrl}") (wrap (` (~! control^)))) + (p.after (l.this "\p{Punct}") (wrap (` (~! punct^)))) + (p.after (l.this "\p{Graph}") (wrap (` (~! graph^)))) + (p.after (l.this "\p{Print}") (wrap (` (~! print^)))) ))) (def: re-class^ @@ -189,11 +189,11 @@ (def: re-back-reference^ (l.Lexer Code) (p.either (do p.Monad - [_ (l.this "\\") + [_ (l.this "\") id number^] (wrap (` ((~! ..copy) (~ (code.identifier ["" (int/encode (.int id))])))))) (do p.Monad - [_ (l.this "\\k<") + [_ (l.this "\k<") captured-name name-part^ _ (l.this ">")] (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name])))))))) @@ -411,11 +411,11 @@ (regex ".") "Escaping" - (regex "\\.") + (regex "\.") "Character classes" - (regex "\\d") - (regex "\\p{Lower}") + (regex "\d") + (regex "\p{Lower}") (regex "[abc]") (regex "[a-z]") (regex "[a-zA-Z]") @@ -449,11 +449,11 @@ "Groups" (regex "a(.)c") (regex "a(b+)c") - (regex "(\\d{3})-(\\d{3})-(\\d{4})") - (regex "(\\d{3})-(?:\\d{3})-(\\d{4})") - (regex "(?\\d{3})-\\k-(\\d{4})") - (regex "(?\\d{3})-\\k-(\\d{4})-\\0") - (regex "(\\d{3})-((\\d{3})-(\\d{4}))") + (regex "(\d{3})-(\d{3})-(\d{4})") + (regex "(\d{3})-(?:\d{3})-(\d{4})") + (regex "(?\d{3})-\k-(\d{4})") + (regex "(?\d{3})-\k-(\d{4})-\0") + (regex "(\d{3})-((\d{3})-(\d{4}))") "Alternation" (regex "a|b") @@ -477,11 +477,11 @@ {branches (p.many s.any)}) {#.doc (doc "Allows you to test text against regular expressions." (case some-text - (^regex "(\\d{3})-(\\d{3})-(\\d{4})" + (^regex "(\d{3})-(\d{3})-(\d{4})" [_ country-code area-code place-code]) do-some-thing-when-number - (^regex "\\w+") + (^regex "\w+") do-some-thing-when-word _ diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 7c54d8385..3398f4685 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -53,8 +53,8 @@ (test "Can parse character literals." (and (should-pass (&.regex "a") "a") (should-fail (&.regex "a") ".") - (should-pass (&.regex "\\.") ".") - (should-fail (&.regex "\\.") "a")))) + (should-pass (&.regex "\.") ".") + (should-fail (&.regex "\.") "a")))) (context: "Regular Expressions [System character classes]" ($_ seq @@ -62,79 +62,79 @@ (should-pass (&.regex ".") "a")) (test "Can parse digits." - (and (should-pass (&.regex "\\d") "0") - (should-fail (&.regex "\\d") "m"))) + (and (should-pass (&.regex "\d") "0") + (should-fail (&.regex "\d") "m"))) (test "Can parse non digits." - (and (should-pass (&.regex "\\D") "m") - (should-fail (&.regex "\\D") "0"))) + (and (should-pass (&.regex "\D") "m") + (should-fail (&.regex "\D") "0"))) (test "Can parse white-space." - (and (should-pass (&.regex "\\s") " ") - (should-fail (&.regex "\\s") "m"))) + (and (should-pass (&.regex "\s") " ") + (should-fail (&.regex "\s") "m"))) (test "Can parse non white-space." - (and (should-pass (&.regex "\\S") "m") - (should-fail (&.regex "\\S") " "))) + (and (should-pass (&.regex "\S") "m") + (should-fail (&.regex "\S") " "))) (test "Can parse word characters." - (and (should-pass (&.regex "\\w") "_") - (should-fail (&.regex "\\w") "^"))) + (and (should-pass (&.regex "\w") "_") + (should-fail (&.regex "\w") "^"))) (test "Can parse non word characters." - (and (should-pass (&.regex "\\W") ".") - (should-fail (&.regex "\\W") "a"))) + (and (should-pass (&.regex "\W") ".") + (should-fail (&.regex "\W") "a"))) )) (context: "Regular Expressions [Special system character classes : Part 1]" ($_ seq (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\\p{Lower}") "m") - (should-fail (&.regex "\\p{Lower}") "M")) + (and (and (should-pass (&.regex "\p{Lower}") "m") + (should-fail (&.regex "\p{Lower}") "M")) - (and (should-pass (&.regex "\\p{Upper}") "M") - (should-fail (&.regex "\\p{Upper}") "m")) + (and (should-pass (&.regex "\p{Upper}") "M") + (should-fail (&.regex "\p{Upper}") "m")) - (and (should-pass (&.regex "\\p{Alpha}") "M") - (should-fail (&.regex "\\p{Alpha}") "0")) + (and (should-pass (&.regex "\p{Alpha}") "M") + (should-fail (&.regex "\p{Alpha}") "0")) - (and (should-pass (&.regex "\\p{Digit}") "1") - (should-fail (&.regex "\\p{Digit}") "n")) + (and (should-pass (&.regex "\p{Digit}") "1") + (should-fail (&.regex "\p{Digit}") "n")) - (and (should-pass (&.regex "\\p{Alnum}") "1") - (should-fail (&.regex "\\p{Alnum}") ".")) + (and (should-pass (&.regex "\p{Alnum}") "1") + (should-fail (&.regex "\p{Alnum}") ".")) - (and (should-pass (&.regex "\\p{Space}") " ") - (should-fail (&.regex "\\p{Space}") ".")) + (and (should-pass (&.regex "\p{Space}") " ") + (should-fail (&.regex "\p{Space}") ".")) )) )) (context: "Regular Expressions [Special system character classes : Part 2]" ($_ seq (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\\p{HexDigit}") "a") - (should-fail (&.regex "\\p{HexDigit}") ".")) + (and (and (should-pass (&.regex "\p{HexDigit}") "a") + (should-fail (&.regex "\p{HexDigit}") ".")) - (and (should-pass (&.regex "\\p{OctDigit}") "6") - (should-fail (&.regex "\\p{OctDigit}") ".")) + (and (should-pass (&.regex "\p{OctDigit}") "6") + (should-fail (&.regex "\p{OctDigit}") ".")) - (and (should-pass (&.regex "\\p{Blank}") text.tab) - (should-fail (&.regex "\\p{Blank}") ".")) + (and (should-pass (&.regex "\p{Blank}") text.tab) + (should-fail (&.regex "\p{Blank}") ".")) - (and (should-pass (&.regex "\\p{ASCII}") text.tab) - (should-fail (&.regex "\\p{ASCII}") (text.from-code (hex "1234")))) + (and (should-pass (&.regex "\p{ASCII}") text.tab) + (should-fail (&.regex "\p{ASCII}") (text.from-code (hex "1234")))) - (and (should-pass (&.regex "\\p{Contrl}") (text.from-code (hex "12"))) - (should-fail (&.regex "\\p{Contrl}") "a")) + (and (should-pass (&.regex "\p{Contrl}") (text.from-code (hex "12"))) + (should-fail (&.regex "\p{Contrl}") "a")) - (and (should-pass (&.regex "\\p{Punct}") "@") - (should-fail (&.regex "\\p{Punct}") "a")) + (and (should-pass (&.regex "\p{Punct}") "@") + (should-fail (&.regex "\p{Punct}") "a")) - (and (should-pass (&.regex "\\p{Graph}") "@") - (should-fail (&.regex "\\p{Graph}") " ")) + (and (should-pass (&.regex "\p{Graph}") "@") + (should-fail (&.regex "\p{Graph}") " ")) - (and (should-pass (&.regex "\\p{Print}") (text.from-code (hex "20"))) - (should-fail (&.regex "\\p{Print}") (text.from-code (hex "1234")))) + (and (should-pass (&.regex "\p{Print}") (text.from-code (hex "20"))) + (should-fail (&.regex "\p{Print}") (text.from-code (hex "1234")))) )) )) @@ -191,9 +191,9 @@ )) (context: "Regular Expressions [Reference]" - (let [number (&.regex "\\d+")] + (let [number (&.regex "\d+")] (test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\\@)-(\\@)-(\\@)") "809-345-6789")))) + (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\@)-(\@)-(\@)") "809-345-6789")))) (context: "Regular Expressions [Fuzzy Quantifiers]" ($_ seq @@ -240,14 +240,14 @@ (test "Can extract groups of sub-matches specified in a pattern." (and (should-check ["abc" "b"] (&.regex "a(.)c") "abc") (should-check ["abbbbbc" "bbbbb"] (&.regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (&.regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (&.regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (&.regex "(?\\d{3})-\\k-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?\\d{3})-\\k-(\\d{4})-\\0") "809-809-6789-6789"))) + (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") + (should-check ["809-345-6789" "809" "6789"] (&.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") + (should-check ["809-809-6789" "809" "6789"] (&.regex "(\d{3})-\0-(\d{4})") "809-809-6789") + (should-check ["809-809-6789" "809" "6789"] (&.regex "(?\d{3})-\k-(\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?\d{3})-\k-(\d{4})-\0") "809-809-6789-6789"))) (test "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) + (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) )) (context: "Regular Expressions [Alternation]" @@ -263,7 +263,7 @@ (should-fail (&.regex "a(.)(.)|b(.)(.)") "cde") (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])] - (&.regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") + (&.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") "809-345-6789"))) )) -- cgit v1.3.1 From d9965e587905cd715ecd4c7150236d660321a02c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 17:18:30 -0400 Subject: Optimized text clipping. --- luxc/src/lux/analyser/proc/common.clj | 2 +- luxc/src/lux/compiler/jvm/proc/common.clj | 2 +- luxc/src/lux/compiler/jvm/rt.clj | 64 ++++++----------- .../lang/translation/jvm/procedure/common.jvm.lux | 9 ++- .../luxc/lang/translation/jvm/runtime.jvm.lux | 10 +-- stdlib/source/lux.lux | 36 +++++----- .../default/phase/extension/analysis/common.lux | 2 +- stdlib/source/lux/compiler/default/syntax.lux | 56 +++++++-------- stdlib/source/lux/data/number.lux | 84 ++++++++++------------ stdlib/source/lux/data/text.lux | 10 ++- .../default/phase/analysis/procedure/common.lux | 2 +- stdlib/test/test/lux/compiler/default/syntax.lux | 20 +++--- 12 files changed, 130 insertions(+), 167 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 8c6bd9d88..b52589460 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -65,7 +65,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"]) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 36f23263d..90f7b6bcf 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -263,7 +263,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/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;"))]] (return nil))) (defn ^:private compile-text-index [compile ?values special-args] diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 6b9aeb680..97b767863 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -340,49 +340,27 @@ 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))) - (let [$from (new Label) - $to (new Label) - $handler (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;" nil nil) - (.visitCode) - (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") - (.visitLabel $from) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "codePointAt" "(I)I") - (.visitInsn Opcodes/I2L) - &&/wrap-long - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd))) + (let [$from (new Label) + $to (new Label) + $handler (new Label)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;" nil nil) + (.visitCode) + (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") + (.visitLabel $from) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") + (.visitInsn Opcodes/I2L) + &&/wrap-long + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitLabel $to) + (.visitLabel $handler) + (.visitInsn Opcodes/POP) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)) nil)) (def compile-LuxRT-class 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 1b784ee76..a0a34d9ad 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 @@ -223,7 +223,7 @@ paramI ))] - [text::= id id + [text::= (<|) (<|) (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) (_.wrap #$.Boolean)] [text::< ..check-stringI ..check-stringI @@ -231,10 +231,10 @@ (predicateI _.IFLT)] [text::concat ..check-stringI ..check-stringI (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0) - id] + (<|)] [text::char ..check-stringI jvm-intI (_.INVOKESTATIC ///.runtime-class "text_char" (_t.method (list $String _t.int) (#.Some ///.$Variant) (list)) #0) - id] + (<|)] ) (do-template [ ] @@ -246,8 +246,7 @@ ))] [text::clip ..check-stringI jvm-intI jvm-intI - (_.INVOKESTATIC ///.runtime-class "text_clip" - (_t.method (list $String _t.int _t.int) (#.Some ///.$Variant) (list)) #0)] + (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)] ) (def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 20c31bd5d..3c8563d75 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -133,17 +133,11 @@ (def: text-methods Def - (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) + (|>> ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) (try-methodI (|>> (_.ALOAD 0) (_.ILOAD 1) - (_.ILOAD 2) - (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) - ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) - (try-methodI - (|>> (_.ALOAD 0) - (_.ILOAD 1) - (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.String" "charAt" ($t.method (list $t.int) (#.Some $t.char) (list)) #0) _.I2L (_.wrap #$.Long)))) )) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index bfbfe0678..5abcab3dc 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,23 +1,17 @@ ("lux def" double-quote - ("lux check" (0 "#Text" (0)) - ("lux int char" +34)) + ("lux int char" +34) [["" 0 0] (10 (0))]) ("lux def" new-line - ("lux check" (0 "#Text" (0)) - ("lux int char" +10)) + ("lux int char" +10) [["" 0 0] (10 (0))]) ("lux def" __paragraph - ("lux check" (0 "#Text" (0)) - ("lux text concat" new-line new-line)) + ("lux text concat" new-line new-line) [["" 0 0] (10 (0))]) ("lux def" dummy-cursor - ("lux check" (2 (0 "#Text" (0)) - (2 (0 "#I64" (1 (0 "#Nat" (0)) (0))) - (0 "#I64" (1 (0 "#Nat" (0)) (0))))) - ["" 0 0]) + ["" 0 0] [["" 0 0] (10 (1 [[["" 0 0] (7 ["lux" "export?"])] [["" 0 0] (0 #1)]] @@ -3606,13 +3600,19 @@ #None #None)) -(def: (clip1 from text) +(def: (clip/1 from text) (-> Nat Text (Maybe Text)) - ("lux text clip" text from ("lux text size" text))) + (let [size ("lux text size" text)] + (if (n/<= size from) + (#.Some ("lux text clip" text from size)) + #.None))) -(def: (clip2 from to text) +(def: (clip/2 from to text) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" text from to)) + (if (and (n/<= to from) + (n/<= ("lux text size" text) to)) + (#.Some ("lux text clip" text from to)) + #.None)) (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" @@ -3651,10 +3651,10 @@ (#Some idx) (list& (default (error! "UNDEFINED") - (clip2 0 idx input)) + (clip/2 0 idx input)) (text/split splitter (default (error! "UNDEFINED") - (clip1 (n/+ 1 idx) input)))))) + (clip/1 (n/+ 1 idx) input)))))) (def: (nth idx xs) (All [a] @@ -4146,7 +4146,7 @@ (def: (split at x) (-> Nat Text (Maybe [Text Text])) - (case [(..clip2 0 at x) (..clip1 at x)] + (case [(..clip/2 0 at x) (..clip/1 at x)] [(#.Some pre) (#.Some post)] (#.Some [pre post]) @@ -4213,7 +4213,7 @@ list/reverse (interpose "/") text/join) - clean (|> module (clip1 ups) (default (error! "UNDEFINED"))) + clean ("lux text clip" module ups ("lux text size" module)) output (case ("lux text size" clean) 0 prefix _ ($_ text/compose prefix "/" clean))] diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 690a4accb..c654d9a00 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -202,7 +202,7 @@ (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat)))) (bundle.install "size" (unary Text Nat)) (bundle.install "char" (binary Text Nat (type (Maybe Nat)))) - (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) + (bundle.install "clip" (trinary Text Nat Nat Text)) ))) (def: #export (bundle eval) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 7dc992471..69d214371 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -33,7 +33,6 @@ [data ["." error (#+ Error)] ["." number] - ["." maybe] ["." text ["l" lexer (#+ Offset Lexer)] format] @@ -135,11 +134,8 @@ (..frac where) ))) -(type: (Simple a) - (-> Source (Error [Source a]))) - -(type: (Parser a) - (-> Text Aliases (Simple a))) +(type: Parser + (-> Source (Error [Source Code]))) (do-template [ ] [(template: ( value) @@ -152,7 +148,7 @@ (do-template [ ] [(def: ( parse source) - (-> (Simple Code) (Simple Code)) + (-> Parser Parser) (loop [source source stack (: (List Code) #.Nil)] (case (parse source) @@ -184,7 +180,7 @@ ) (def: (parse-record parse source) - (-> (Simple Code) (Simple Code)) + (-> Parser Parser) (loop [source source stack (: (List [Code Code]) #.Nil)] (case (parse source) @@ -214,8 +210,7 @@ (#error.Error error)))) (template: (!clip from to text) - ## TODO: Optimize-away "maybe.assume" - (maybe.assume ("lux text clip" text from to))) + ("lux text clip" text from to)) (template: (!i/< reference subject) ("lux int <" subject reference)) @@ -237,7 +232,7 @@ body)) (def: (read-text [where offset source-code]) - (Simple Code) + Parser (case ("lux text index" source-code (static ..text-delimiter) offset) (#.Some end) (let [content (!clip offset end source-code)] @@ -300,7 +295,7 @@ (#error.Error error))) (def: (parse-nat start [where offset source-code]) - (-> Offset (Simple Code)) + (-> Offset Parser) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -312,7 +307,7 @@ (!discrete-output number.Codec #.Nat)))) (def: (parse-int start [where offset source-code]) - (-> Offset (Simple Code)) + (-> Offset Parser) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -324,7 +319,7 @@ (!discrete-output number.Codec #.Int)))) (def: (parse-rev start [where offset source-code]) - (-> Offset (Simple Code)) + (-> Offset Parser) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -360,17 +355,14 @@ _ )))) -(template: (!leap-bit value) - ("lux i64 +" value 2)) - (template: (!new-line where) (let [[where::file where::line where::column] where] [where::file (!inc where::line) 0])) (with-expansions [ (ex.throw end-of-file current-module) (ex.throw unrecognized-input where) - (as-is [where (!inc offset) source-code]) - (as-is [where (!inc/2 offset) source-code])] + (as-is [where (!inc offset/0) source-code]) + (as-is [where (!inc/2 offset/0) source-code])] (template: (!with-char @source-code @offset @char @body) (case ("lux text char" @source-code @offset) @@ -451,20 +443,20 @@ (def: #export (parse current-module aliases source) (-> Text Aliases Source (Error [Source Code])) (let [parse' (parse current-module aliases)] - (loop [[where offset source-code] source] - (<| (!with-char source-code offset char/0) + (loop [[where offset/0 source-code] source] + (<| (!with-char source-code offset/0 char/0) (`` (case char/0 ## White-space (^template [ ] (^ (char )) (recur [(update@ inc where) - (!inc offset) + (!inc offset/0) source-code])) ([(~~ (static ..space)) #.column] [(~~ (static text.carriage-return)) #.column]) (^ (char (~~ (static text.new-line)))) - (recur [(!new-line where) (!inc offset) source-code]) + (recur [(!new-line where) (!inc offset/0) source-code]) ## Form (^ (char (~~ (static ..open-form)))) @@ -484,13 +476,13 @@ ## Special code (^ (char (~~ (static ..sigil)))) - (let [offset/1 (!inc offset)] + (let [offset/1 (!inc offset/0)] (<| (!with-char source-code offset/1 char/1) (case char/1 (^template [ ] (^ (char )) - (#error.Success [[(update@ #.column (|>> !leap-bit) where) - (!leap-bit offset) + (#error.Success [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) source-code] [where (#.Bit )]])) (["0" #0] @@ -510,31 +502,31 @@ _ (cond (!name-char?|head char/1) ## Tag - (!parse-full-name offset where #.Tag) + (!parse-full-name offset/1 where #.Tag) ## else )))) (^ (char (~~ (static ..name-separator)))) - (let [offset/1 (!inc offset)] + (let [offset/1 (!inc offset/0)] (<| (!with-char source-code offset/1 char/1) (if (!digit? char/1) - (parse-rev offset [where (!inc offset/1) source-code]) + (parse-rev offset/0 [where (!inc offset/1) source-code]) (!parse-short-name current-module where #.Identifier)))) (^template [] (^ (char )) - (!parse-int offset where source-code)) + (!parse-int offset/0 where source-code)) ([(~~ (static ..positive-sign))] [(~~ (static ..negative-sign))]) _ (cond (!digit? char/0) ## Natural number - (parse-nat offset ) + (parse-nat offset/0 ) ## Identifier (!name-char?|head char/0) - (!parse-full-name offset where #.Identifier) + (!parse-full-name offset/0 where #.Identifier) ## else )))))))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index e45c4ff1c..f2845f48c 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,9 +178,9 @@ ) ## [Values & Syntax] -(def: (get-char full idx) - (-> Text Nat (Maybe Text)) - ("lux text clip" full idx (inc idx))) +(def: (get-char! full idx) + (-> Text Nat Text) + ("lux text clip" full idx ("lux i64 +" 1 idx))) (def: (binary-character value) (-> Nat (Maybe Text)) @@ -312,14 +312,13 @@ (loop [idx 0 output 0] (if (n/< input-size idx) - (let [digit (maybe.assume (get-char repr idx))] - (case ( digit) - #.None - (#error.Error ("lux text concat" repr)) - - (#.Some digit-value) - (recur (inc idx) - (|> output (n/* ) (n/+ digit-value))))) + (case ( (get-char! repr idx)) + #.None + (#error.Error ("lux text concat" repr)) + + (#.Some digit-value) + (recur (inc idx) + (|> output (n/* ) (n/+ digit-value)))) (#error.Success output))) (#error.Error ("lux text concat" repr))))))] @@ -337,11 +336,11 @@ (def: (int/sign?? representation) (-> Text (Maybe Int)) - (case (get-char representation 0) - (^ (#.Some "-")) + (case (get-char! representation 0) + "-" (#.Some -1) - (^ (#.Some "+")) + "+" (#.Some +1) _ @@ -352,14 +351,13 @@ (loop [idx 1 output +0] (if (n/< input-size idx) - (let [digit (maybe.assume (get-char repr idx))] - (case ( digit) - #.None - (#error.Error ) + (case ( (get-char! repr idx)) + #.None + (#error.Error ) - (#.Some digit-value) - (recur (inc idx) - (|> output (i/* ) (i/+ (.int digit-value)))))) + (#.Some digit-value) + (recur (inc idx) + (|> output (i/* ) (i/+ (.int digit-value))))) (#error.Success (i/* sign output))))) (do-template [ ] @@ -396,7 +394,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 [ ] [(structure: #export (Codec Text Rev) @@ -444,8 +442,7 @@ (if (f/= +0.0 dec-left) ("lux text concat" "." output) (let [shifted (f/* dec-left) - digit (|> shifted (f/% ) frac-to-int .nat - (get-char ) maybe.assume)] + digit (|> shifted (f/% ) frac-to-int .nat (get-char! ))] (recur (f/% +1.0 shifted) ("lux text concat" output digit))))))] ("lux text concat" whole-part decimal-part))) @@ -453,8 +450,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 (inc split-index) ("lux text size" repr)))] + (let [whole-part ("lux text clip" repr 0 split-index) + decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))] (case [(:: decode whole-part) (:: decode decimal-part)] (^multi [(#error.Success whole) (#error.Success decimal)] @@ -498,8 +495,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) @@ -627,10 +624,10 @@ (let [sign (:: Number signum value) raw-bin (:: Binary@Codec 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 (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 (inc dot-idx) ("lux text size" raw-bin)) hex-output (|> ( #0 decimal-part) ("lux text concat" ".") ("lux text concat" ( #1 whole-part)) @@ -646,8 +643,8 @@ +1.0)] (case ("lux text index" repr "." 0) (#.Some split-index) - (let [whole-part (maybe.assume ("lux text clip" repr 1 split-index)) - decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr))) + (let [whole-part ("lux text clip" repr 1 split-index) + decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr)) as-binary (|> ( decimal-part) ("lux text concat" ".") ("lux text concat" ( whole-part)) @@ -829,14 +826,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 (inc idx) - (digits-put idx digit output)))) + (case ("lux text index" "+0123456789" (get-char! input idx) 0) + #.None + #.None + + (#.Some digit) + (recur (inc idx) + (digits-put idx digit output))) (#.Some output))) #.None))) @@ -900,9 +896,7 @@ #0)] (if (and dotted? (n/<= (inc i64.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/text.lux b/stdlib/source/lux/data/text.lux index 3807275c1..c33ab03a3 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -105,11 +105,17 @@ (def: #export (clip from to input) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" input from to)) + (if (and (n/<= to from) + (n/<= ("lux text size" input) to)) + (#.Some ("lux text clip" input from to)) + #.None)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) - ("lux text clip" input from (size input))) + (let [size ("lux text size" input)] + (if (n/<= size from) + (#.Some ("lux text clip" input from size)) + #.None))) (def: #export (split at x) (-> Nat Text (Maybe [Text Text])) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index fc082155a..cfc164df9 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -167,7 +167,7 @@ (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." - (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text)))) + (check-success+ "lux text clip" (list subjectC fromC toC) Text)) )))) (context: "IO procedures" diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 829199aa8..887765cbd 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -87,23 +87,23 @@ other code^] ($_ seq (test "Can parse Lux code." - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 (code.to-text sample)]) + (case (&.parse "" (dict.new text.Hash) + [default-cursor 0 (code.to-text sample)]) (#e.Error error) #0 (#e.Success [_ parsed]) (:: code.Equivalence = parsed sample))) (test "Can parse Lux multiple code nodes." - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 (format (code.to-text sample) " " - (code.to-text other))]) + (case (&.parse "" (dict.new text.Hash) + [default-cursor 0 (format (code.to-text sample) " " + (code.to-text other))]) (#e.Error error) #0 (#e.Success [remaining =sample]) - (case (&.read "" (dict.new text.Hash) - remaining) + (case (&.parse "" (dict.new text.Hash) + remaining) (#e.Error error) #0 @@ -133,9 +133,9 @@ comment comment^] ($_ seq (test "Can handle comments." - (case (&.read "" (dict.new text.Hash) - [default-cursor 0 - (format comment (code.to-text sample))]) + (case (&.parse "" (dict.new text.Hash) + [default-cursor 0 + (format comment (code.to-text sample))]) (#e.Error error) #0 -- cgit v1.3.1 From 312cc7dc5f0be0ef0a48ea8470d8ee64b929bc7b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 19:02:47 -0400 Subject: "lux text char" is now unsafe/optimized. --- luxc/src/lux/analyser/proc/common.clj | 2 +- luxc/src/lux/compiler/jvm/proc/common.clj | 4 +- luxc/src/lux/compiler/jvm/rt.clj | 27 +-- .../lang/translation/jvm/procedure/common.jvm.lux | 4 +- .../luxc/lang/translation/jvm/runtime.jvm.lux | 14 -- stdlib/source/lux.lux | 25 +-- stdlib/source/lux/compiler/default/syntax.lux | 197 +++++++++------------ stdlib/source/lux/data/number.lux | 154 ++++++++-------- stdlib/source/lux/data/text.lux | 15 +- .../default/phase/analysis/procedure/common.lux | 2 +- 10 files changed, 184 insertions(+), 260 deletions(-) (limited to 'stdlib/test') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index b52589460..90db8a2cd 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -90,7 +90,7 @@ (|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values] =text (&&/analyse-1 analyse &type/Text text) =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type (&/$Apply &type/Nat &type/Maybe)) + _ (&type/check exo-type &type/Nat) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "char"]) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 90f7b6bcf..b5d0ea475 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -322,7 +322,9 @@ :let [_ (doto *writer* &&/unwrap-long (.visitInsn Opcodes/L2I) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;"))]] + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") + (.visitInsn Opcodes/I2L) + &&/wrap-long)]] (return nil))) (defn ^:private compile-io-log [compile ?values special-args] diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 97b767863..948f08805 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -339,30 +339,6 @@ (.visitEnd))] nil)) -(defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] - (let [$from (new Label) - $to (new Label) - $handler (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;" nil nil) - (.visitCode) - (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") - (.visitLabel $from) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") - (.visitInsn Opcodes/I2L) - &&/wrap-long - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd)) - nil)) - (def compile-LuxRT-class (|do [_ (return nil) :let [full-name &&/lux-utils-class @@ -467,7 +443,6 @@ (compile-LuxRT-pm-methods) (compile-LuxRT-adt-methods) (compile-LuxRT-int-methods) - (compile-LuxRT-frac-methods) - (compile-LuxRT-text-methods))]] + (compile-LuxRT-frac-methods))]] (&&/save-class! (second (string/split &&/lux-utils-class #"/")) (.toByteArray (doto =class .visitEnd))))) 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 a0a34d9ad..e45a6f8cf 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 @@ -233,8 +233,8 @@ (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0) (<|)] [text::char ..check-stringI jvm-intI - (_.INVOKESTATIC ///.runtime-class "text_char" (_t.method (list $String _t.int) (#.Some ///.$Variant) (list)) #0) - (<|)] + (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0) + lux-intI] ) (do-template [ ] diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 3c8563d75..05641fe22 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -129,19 +129,6 @@ (_.wrap #$.Double)))) )) -(def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list))) - -(def: text-methods - Def - (|>> ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) - (try-methodI - (|>> (_.ALOAD 0) - (_.ILOAD 1) - (_.INVOKEVIRTUAL "java.lang.String" "charAt" ($t.method (list $t.int) (#.Some $t.char) (list)) #0) - _.I2L - (_.wrap #$.Long)))) - )) - (def: pm-methods Def (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) @@ -320,7 +307,6 @@ (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list) (|>> adt-methods frac-methods - text-methods pm-methods io-methods))] (do phase.Monad diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 5abcab3dc..916b77797 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3650,11 +3650,9 @@ (list input) (#Some idx) - (list& (default (error! "UNDEFINED") - (clip/2 0 idx input)) + (list& ("lux text clip" input 0 idx) (text/split splitter - (default (error! "UNDEFINED") - (clip/1 (n/+ 1 idx) input)))))) + ("lux text clip" input (n/+ 1 idx) ("lux text size" input)))))) (def: (nth idx xs) (All [a] @@ -4144,23 +4142,17 @@ _ (return [#.Nil parts]))) -(def: (split at x) - (-> Nat Text (Maybe [Text Text])) - (case [(..clip/2 0 at x) (..clip/1 at x)] - [(#.Some pre) (#.Some post)] - (#.Some [pre post]) - - _ - #.None)) +(def: (split! at x) + (-> Nat Text [Text Text]) + [("lux text clip" x 0 at) + ("lux text clip" x at ("lux text size" x))]) (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]] + #let [[pre post'] (split! index sample) + [_ post] (split! ("lux text size" token) post')]] (wrap [pre post]))) (def: (replace-all pattern value template) @@ -5961,7 +5953,6 @@ (^multi (^ (list [_ (#Text input)])) (n/= 1 ("lux text size" input))) (|> ("lux text char" input 0) - (default (undefined)) nat$ list [compiler] #Right) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 69d214371..af7c7ae90 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -146,6 +146,29 @@ [!dec "lux i64 -" 1] ) +(template: (!clip from to text) + ("lux text clip" text from to)) + +(template: (!i/< reference subject) + ("lux int <" subject reference)) + +(do-template [ ] + [(template: ( param subject) + ( subject param))] + + [!n/+ "lux i64 +"] + [!n/- "lux i64 -"] + ) + +(template: (!with-char @source-code @offset @char @else @body) + (if (!i/< (:coerce Int ("lux text size" @source-code)) + ## TODO: Get rid of the above "lux text size" call. + ## The size should be calculated only once and re-used constantly. + (:coerce Int @offset)) + (let [@char ("lux text char" @source-code @offset)] + @body) + @else)) + (do-template [ ] [(def: ( parse source) (-> Parser Parser) @@ -157,20 +180,16 @@ (#error.Error error) (let [[where offset source-code] source] - (case ("lux text char" source-code offset) - (#.Some char) - (`` (case char - (^ (char (~~ (static )))) - (#error.Success [[(update@ #.column inc where) - (!inc offset) - source-code] - [where ( (list.reverse stack))]]) - - _ - (ex.throw unrecognized-input where))) - - _ - (#error.Error error))))))] + (<| (!with-char source-code offset char (#error.Error error)) + (`` (case char + (^ (char (~~ (static )))) + (#error.Success [[(update@ #.column inc where) + (!inc offset) + source-code] + [where ( (list.reverse stack))]]) + + _ + (ex.throw unrecognized-input where))))))))] ## Form and tuple syntax is mostly the same, differing only in the ## delimiters involved. @@ -191,38 +210,20 @@ (#error.Error error) (let [[where offset source-code] source] - (case ("lux text char" source-code offset) - (#.Some char) - (`` (case char - (^ (char (~~ (static ..close-record)))) - (#error.Success [[(update@ #.column inc where) - (!inc offset) - source-code] - [where (#.Record (list.reverse stack))]]) + (<| (!with-char source-code offset char (#error.Error error)) + (`` (case char + (^ (char (~~ (static ..close-record)))) + (#error.Success [[(update@ #.column inc where) + (!inc offset) + source-code] + [where (#.Record (list.reverse stack))]]) - _ - (ex.throw unrecognized-input where))) - - _ - (#error.Error error)))) + _ + (ex.throw unrecognized-input where)))))) (#error.Error error) (#error.Error error)))) -(template: (!clip from to text) - ("lux text clip" text from to)) - -(template: (!i/< reference subject) - ("lux int <" subject reference)) - -(do-template [ ] - [(template: ( param subject) - ( subject param))] - - [!n/+ "lux i64 +"] - [!n/- "lux i64 -"] - ) - (template: (!guarantee-no-new-lines content body) (case ("lux text index" content (static text.new-line) 0) (#.Some g!_) @@ -294,45 +295,23 @@ (#error.Error error) (#error.Error error))) -(def: (parse-nat start [where offset source-code]) - (-> Offset Parser) - (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (if (!digit?+ char) - (recur (!inc end)) - (!discrete-output number.Codec #.Nat)) - - _ - (!discrete-output number.Codec #.Nat)))) - -(def: (parse-int start [where offset source-code]) - (-> Offset Parser) - (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (if (!digit?+ char) - (recur (!inc end)) - (!discrete-output number.Codec #.Int)) - - _ - (!discrete-output number.Codec #.Int)))) - -(def: (parse-rev start [where offset source-code]) - (-> Offset Parser) - (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (if (!digit?+ char) - (recur (!inc end)) - (!discrete-output number.Codec #.Rev)) - - _ - (!discrete-output number.Codec #.Rev)))) +(do-template [ ] + [(def: ( start [where offset source-code]) + (-> Offset Parser) + (loop [end offset] + (<| (!with-char source-code end char (!discrete-output )) + (if (!digit?+ char) + (recur (!inc end)) + (!discrete-output )))))] + + [parse-nat number.Codec #.Nat] + [parse-int number.Codec #.Int] + [parse-rev number.Codec #.Rev] + ) -(template: (!parse-int offset where source-code) +(template: (!parse-int offset where source-code @end) (let [g!offset/1 (!inc offset)] - (<| (!with-char source-code g!offset/1 g!char/1) + (<| (!with-char source-code g!offset/1 g!char/1 @end) (if (!digit? g!char/1) (parse-int offset [where (!inc/2 offset) source-code]) (!parse-full-name offset [where (!inc offset) source-code] where #.Identifier))))) @@ -344,16 +323,12 @@ (def: (parse-name-part start [where offset source-code]) (-> Offset Source (Error [Source Text])) (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (cond (!name-char? char) - (recur (!inc end)) + (<| (!with-char source-code end char ) + (cond (!name-char? char) + (recur (!inc end)) - ## else - ) - - _ - )))) + ## else + ))))) (template: (!new-line where) (let [[where::file where::line where::column] where] @@ -364,14 +339,6 @@ (as-is [where (!inc offset/0) source-code]) (as-is [where (!inc/2 offset/0) source-code])] - (template: (!with-char @source-code @offset @char @body) - (case ("lux text char" @source-code @offset) - (#.Some @char) - @body - - _ - )) - (template: (!parse-half-name @offset//pre @offset//post @char @module) (let [@offset//post (!inc @offset//pre)] (cond (!name-char?|head @char) @@ -387,11 +354,11 @@ (`` (def: (parse-short-name current-module [where offset/0 source-code]) (-> Text Source (Error [Source Name])) - (<| (!with-char source-code offset/0 char/0) + (<| (!with-char source-code offset/0 char/0 ) (case char/0 (^ (char (~~ (static ..name-separator)))) (let [offset/1 (!inc offset/0)] - (<| (!with-char source-code offset/1 char/1) + (<| (!with-char source-code offset/1 char/1 ) (!parse-half-name offset/1 offset/2 char/1 current-module))) _ @@ -411,23 +378,19 @@ (case (..parse-name-part start source) (#error.Success [source' simple]) (let [[where' offset' source-code'] source'] - (case ("lux text char" source-code' offset') - (#.Some char/separator) - (case char/separator - (^ (char (~~ (static ..name-separator)))) - (let [offset'' (!inc offset')] - (case (..parse-name-part offset'' [where' offset'' source-code']) - (#error.Success [source'' complex]) - (#error.Success [source'' [simple complex]]) - - (#error.Error error) - (#error.Error error))) + (<| (!with-char source-code' offset' char/separator ) + (case char/separator + (^ (char (~~ (static ..name-separator)))) + (let [offset'' (!inc offset')] + (case (..parse-name-part offset'' [where' offset'' source-code']) + (#error.Success [source'' complex]) + (#error.Success [source'' [simple complex]]) + + (#error.Error error) + (#error.Error error))) - _ - ) - - _ - )) + _ + ))) (#error.Error error) (#error.Error error))))) @@ -444,7 +407,7 @@ (-> Text Aliases Source (Error [Source Code])) (let [parse' (parse current-module aliases)] (loop [[where offset/0 source-code] source] - (<| (!with-char source-code offset/0 char/0) + (<| (!with-char source-code offset/0 char/0 ) (`` (case char/0 ## White-space (^template [ ] @@ -477,7 +440,7 @@ ## Special code (^ (char (~~ (static ..sigil)))) (let [offset/1 (!inc offset/0)] - (<| (!with-char source-code offset/1 char/1) + (<| (!with-char source-code offset/1 char/1 ) (case char/1 (^template [ ] (^ (char )) @@ -509,14 +472,14 @@ (^ (char (~~ (static ..name-separator)))) (let [offset/1 (!inc offset/0)] - (<| (!with-char source-code offset/1 char/1) + (<| (!with-char source-code offset/1 char/1 ) (if (!digit? char/1) (parse-rev offset/0 [where (!inc offset/1) source-code]) (!parse-short-name current-module where #.Identifier)))) (^template [] (^ (char )) - (!parse-int offset/0 where source-code)) + (!parse-int offset/0 where source-code )) ([(~~ (static ..positive-sign))] [(~~ (static ..negative-sign))]) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index f2845f48c..efd965d1b 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,9 +178,11 @@ ) ## [Values & Syntax] +(type: Char Nat) + (def: (get-char! full idx) - (-> Text Nat Text) - ("lux text clip" full idx ("lux i64 +" 1 idx))) + (-> Text Nat Char) + ("lux text char" full idx)) (def: (binary-character value) (-> Nat (Maybe Text)) @@ -190,10 +192,10 @@ _ #.None)) (def: (binary-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) _ #.None)) (def: (octal-character value) @@ -210,16 +212,16 @@ _ #.None)) (def: (octal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) _ #.None)) (def: (decimal-character value) @@ -238,18 +240,18 @@ _ #.None)) (def: (decimal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) - "8" (#.Some 8) - "9" (#.Some 9) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) + (^ (char "8")) (#.Some 8) + (^ (char "9")) (#.Some 9) _ #.None)) (def: (hexadecimal-character value) @@ -274,24 +276,24 @@ _ #.None)) (def: (hexadecimal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) - "8" (#.Some 8) - "9" (#.Some 9) - (^or "a" "A") (#.Some 10) - (^or "b" "B") (#.Some 11) - (^or "c" "C") (#.Some 12) - (^or "d" "D") (#.Some 13) - (^or "e" "E") (#.Some 14) - (^or "f" "F") (#.Some 15) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) + (^ (char "8")) (#.Some 8) + (^ (char "9")) (#.Some 9) + (^or (^ (char "a")) (^ (char "A"))) (#.Some 10) + (^or (^ (char "b")) (^ (char "B"))) (#.Some 11) + (^or (^ (char "c")) (^ (char "C"))) (#.Some 12) + (^or (^ (char "d")) (^ (char "D"))) (#.Some 13) + (^or (^ (char "e")) (^ (char "E"))) (#.Some 14) + (^or (^ (char "f")) (^ (char "F"))) (#.Some 15) _ #.None)) (do-template [ ] @@ -337,17 +339,17 @@ (def: (int/sign?? representation) (-> Text (Maybe Int)) (case (get-char! representation 0) - "-" + (^ (char "-")) (#.Some -1) - "+" + (^ (char "+")) (#.Some +1) _ #.None)) (def: (int-decode-loop input-size repr sign ) - (-> Nat Text Int Int (-> Text (Maybe Nat)) Text (Error Int)) + (-> Nat Text Int Int (-> Char (Maybe Nat)) Text (Error Int)) (loop [idx 1 output +0] (if (n/< input-size idx) @@ -397,32 +399,36 @@ ("lux text clip" input 1 ("lux text size" input))) (do-template [ ] - [(structure: #export (Codec Text Rev) - (def: (encode value) - (let [raw-output (de-prefix (:: encode (:coerce Nat value))) - max-num-chars (n// 64) - raw-size ("lux text size" raw-output) - zero-padding (loop [zeroes-left (n/- raw-size max-num-chars) - output ""] - (if (n/= 0 zeroes-left) - output - (recur (dec zeroes-left) - ("lux text concat" "0" output)))) - padded-output ("lux text concat" zero-padding raw-output)] - ("lux text concat" "." padded-output))) - - (def: (decode repr) - (let [repr-size ("lux text size" repr)] - (if (n/>= 2 repr-size) - (case ("lux text char" repr 0) - (^multi (^ (#.Some (char "."))) - [(:: decode (de-prefix repr)) - (#error.Success output)]) - (#error.Success (:coerce Rev output)) - - _ - (#error.Error ("lux text concat" repr))) - (#error.Error ("lux text concat" repr))))))] + [(with-expansions [ (as-is (#error.Error ("lux text concat" repr)))] + (structure: #export (Codec Text Rev) + (def: (encode value) + (let [raw-output (de-prefix (:: encode (:coerce Nat value))) + max-num-chars (n// 64) + raw-size ("lux text size" raw-output) + zero-padding (loop [zeroes-left (n/- raw-size max-num-chars) + output ""] + (if (n/= 0 zeroes-left) + output + (recur (dec zeroes-left) + ("lux text concat" "0" output)))) + padded-output ("lux text concat" zero-padding raw-output)] + ("lux text concat" "." padded-output))) + + (def: (decode repr) + (let [repr-size ("lux text size" repr)] + (if (n/>= 2 repr-size) + (case ("lux text char" repr 0) + (^ (char ".")) + (case (:: decode (de-prefix repr)) + (#error.Success output) + (#error.Success (:coerce Rev output)) + + _ + ) + + _ + ) + )))))] [Binary@Codec Binary@Codec 1 "Invalid binary syntax: "] [Octal@Codec Octal@Codec 3 "Invalid octal syntax: "] @@ -442,9 +448,9 @@ (if (f/= +0.0 dec-left) ("lux text concat" "." output) (let [shifted (f/* dec-left) - digit (|> shifted (f/% ) frac-to-int .nat (get-char! ))] + digit-idx (|> shifted (f/% ) frac-to-int .nat)] (recur (f/% +1.0 shifted) - ("lux text concat" output digit))))))] + ("lux text concat" output ("lux text clip" digit-idx (inc digit-idx))))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) @@ -826,7 +832,7 @@ (loop [idx 0 output (make-digits [])] (if (n/< length idx) - (case ("lux text index" "+0123456789" (get-char! input idx) 0) + (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0) #.None #.None diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index c33ab03a3..18ad49032 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -38,7 +38,9 @@ (def: #export (nth idx input) (-> Nat Text (Maybe Nat)) - ("lux text char" input idx)) + (if (n/< ("lux text size" input) idx) + (#.Some ("lux text char" input idx)) + #.None)) (def: #export (index-of' pattern from input) (-> Text Nat Text (Maybe Nat)) @@ -204,12 +206,11 @@ (loop [idx 0 hash 0] (if (n/< length idx) - (let [char (|> idx ("lux text char" input) (maybe.default 0))] - (recur (inc idx) - (|> hash - (i64.left-shift 5) - (n/- hash) - (n/+ char)))) + (recur (inc idx) + (|> hash + (i64.left-shift 5) + (n/- hash) + (n/+ ("lux text char" input idx)))) hash))))))) (def: #export concat diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index cfc164df9..108b350d0 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -165,7 +165,7 @@ (test "Can query the size/length of a text." (check-success+ "lux text size" (list subjectC) Nat)) (test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat)))) + (check-success+ "lux text char" (list subjectC fromC) Nat)) (test "Can clip a piece of text between 2 indices." (check-success+ "lux text clip" (list subjectC fromC toC) Text)) )))) -- cgit v1.3.1