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. --- 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 +- 15 files changed, 113 insertions(+), 119 deletions(-) (limited to 'stdlib/source') 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." -- cgit v1.2.3