From 38d5f05977c54770195129df5ede2c91be4a32af Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 2 Jul 2017 12:29:36 -0400 Subject: - Lux no longer has a Char primitive data-type. --- stdlib/source/lux.lux | 206 +++++++++++--------------- stdlib/source/lux/data/char.lux | 102 ------------- stdlib/source/lux/data/format/json.lux | 57 +------ stdlib/source/lux/data/format/xml.lux | 3 +- stdlib/source/lux/data/number.lux | 54 +++---- stdlib/source/lux/data/text.lux | 18 ++- stdlib/source/lux/data/text/format.lux | 2 - stdlib/source/lux/data/text/lexer.lux | 43 +++--- stdlib/source/lux/data/text/regex.lux | 9 +- stdlib/source/lux/host.jvm.lux | 1 - stdlib/source/lux/macro.lux | 1 - stdlib/source/lux/macro/code.lux | 5 - stdlib/source/lux/macro/poly.lux | 3 - stdlib/source/lux/macro/poly/eq.lux | 2 - stdlib/source/lux/macro/poly/functor.lux | 1 - stdlib/source/lux/macro/poly/text-encoder.lux | 2 - stdlib/source/lux/macro/syntax.lux | 2 - stdlib/source/lux/math.lux | 1 - stdlib/source/lux/math/random.lux | 13 +- stdlib/source/lux/paradigm/concatenative.lux | 2 +- 20 files changed, 154 insertions(+), 373 deletions(-) delete mode 100644 stdlib/source/lux/data/char.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index c108428d8..76db92f2f 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -4,7 +4,7 @@ (+0 "#Bool" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill boolean values.")] + (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill boolean values.")] (+0))))) (_lux_def Nat @@ -12,7 +12,7 @@ (+0 "#Nat" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Natural numbers (unsigned integers). + (+1 [["lux" "doc"] (+5 "Natural numbers (unsigned integers). They start at zero (+0) and extend in the positive direction.")] (+0))))) @@ -22,7 +22,7 @@ (+0 "#Int" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill integer numbers.")] + (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill integer numbers.")] (+0))))) (_lux_def Real @@ -30,7 +30,7 @@ (+0 "#Real" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill floating-point numbers.")] + (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill floating-point numbers.")] (+0))))) (_lux_def Deg @@ -38,25 +38,17 @@ (+0 "#Deg" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Fractional numbers that live in the interval [0,1). + (+1 [["lux" "doc"] (+5 "Fractional numbers that live in the interval [0,1). Useful for probability, and other domains that work within that interval.")] (+0))))) -(_lux_def Char - (+12 ["lux" "Char"] - (+0 "#Char" (+0))) - (+1 [["lux" "type?"] (+0 true)] - (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill character values.")] - (+0))))) - (_lux_def Text (+12 ["lux" "Text"] (+0 "#Text" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "Your standard, run-of-the-mill string values.")] + (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill string values.")] (+0))))) (_lux_def Void @@ -64,7 +56,7 @@ (+1)) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "An unusual type that possesses no value, and thus cannot be instantiated.")] + (+1 [["lux" "doc"] (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")] (+0))))) (_lux_def Unit @@ -72,7 +64,7 @@ (+2)) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "An unusual type that only possesses a single value: []")] + (+1 [["lux" "doc"] (+5 "An unusual type that only possesses a single value: []")] (+0))))) (_lux_def Ident @@ -80,7 +72,7 @@ (+4 Text Text)) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "doc"] (+6 "An identifier. + (+1 [["lux" "doc"] (+5 "An identifier. It is used as part of Lux syntax to represent symbols and tags.")] (+0))))) @@ -98,9 +90,9 @@ (+11 (+6 +1) (+6 +0)))))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] - (+1 [["lux" "tags"] (+8 (+1 (+6 "Nil") (+1 (+6 "Cons") (+0))))] - (+1 [["lux" "type-args"] (+8 (+1 (+6 "a") (+0)))] - (+1 [["lux" "doc"] (+6 "A potentially empty list of values.")] + (+1 [["lux" "tags"] (+7 (+1 (+5 "Nil") (+1 (+5 "Cons") (+0))))] + (+1 [["lux" "type-args"] (+7 (+1 (+5 "a") (+0)))] + (+1 [["lux" "doc"] (+5 "A potentially empty list of values.")] (+0))))))) ## (type: (Maybe a) @@ -115,9 +107,9 @@ (+6 +1)))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+8 (#Cons (+6 "None") (#Cons (+6 "Some") #Nil)))] - (#Cons [["lux" "type-args"] (+8 (#Cons (+6 "a") #Nil))] - (#Cons [["lux" "doc"] (+6 "A potentially missing value.")] + (#Cons [["lux" "tags"] (+7 (#Cons (+5 "None") (#Cons (+5 "Some") #Nil)))] + (#Cons [["lux" "type-args"] (+7 (#Cons (+5 "a") #Nil))] + (#Cons [["lux" "doc"] (+5 "A potentially missing value.")] #Nil)))))) ## (type: #rec Type @@ -173,21 +165,21 @@ (+4 Ident Type))))))))))))))))))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+8 (#Cons (+6 "Host") - (#Cons (+6 "Void") - (#Cons (+6 "Unit") - (#Cons (+6 "Sum") - (#Cons (+6 "Product") - (#Cons (+6 "Function") - (#Cons (+6 "Bound") - (#Cons (+6 "Var") - (#Cons (+6 "Ex") - (#Cons (+6 "UnivQ") - (#Cons (+6 "ExQ") - (#Cons (+6 "Apply") - (#Cons (+6 "Named") + (#Cons [["lux" "tags"] (+7 (#Cons (+5 "Host") + (#Cons (+5 "Void") + (#Cons (+5 "Unit") + (#Cons (+5 "Sum") + (#Cons (+5 "Product") + (#Cons (+5 "Function") + (#Cons (+5 "Bound") + (#Cons (+5 "Var") + (#Cons (+5 "Ex") + (#Cons (+5 "UnivQ") + (#Cons (+5 "ExQ") + (#Cons (+5 "Apply") + (#Cons (+5 "Named") #Nil))))))))))))))] - (#Cons [["lux" "doc"] (+6 "This type represents the data-structures that are used to specify types themselves.")] + (#Cons [["lux" "doc"] (+5 "This type represents the data-structures that are used to specify types themselves.")] (#Cons [["lux" "type-rec?"] (+0 true)] #Nil)))))) @@ -198,7 +190,7 @@ (#ExQ #Nil (#Bound +1))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "doc"] (+6 "The type of things whose type does not matter. + (#Cons [["lux" "doc"] (+5 "The type of things whose type does not matter. It can be used to write functions or data-structures that can take, or return, anything.")] #Nil)))) @@ -210,7 +202,7 @@ (#UnivQ #Nil (#Bound +1))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "doc"] (+6 "The type of things whose type is unknown or undefined. + (#Cons [["lux" "doc"] (+5 "The type of things whose type is unknown or undefined. Useful for expressions that cause errors or other \"extraordinary\" conditions.")] #Nil)))) @@ -221,7 +213,6 @@ ## (#IntA Int) ## (#DegA Deg) ## (#RealA Real) -## (#CharA Char) ## (#TextA Text) ## (#IdentA Ident) ## (#ListA (List Ann-Value)) @@ -242,33 +233,30 @@ Deg (#Sum ## #RealA Real - (#Sum ## #CharA - Char - (#Sum ## #TextA - Text - (#Sum ## #IdentA - Ident - (#Sum ## #ListA - (#Apply Ann-Value List) - ## #DictA - (#Apply (#Product Text Ann-Value) List)))))))))) + (#Sum ## #TextA + Text + (#Sum ## #IdentA + Ident + (#Sum ## #ListA + (#Apply Ann-Value List) + ## #DictA + (#Apply (#Product Text Ann-Value) List))))))))) )) )) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+8 (#Cons (+6 "BoolA") - (#Cons (+6 "NatA") - (#Cons (+6 "IntA") - (#Cons (+6 "DegA") - (#Cons (+6 "RealA") - (#Cons (+6 "CharA") - (#Cons (+6 "TextA") - (#Cons (+6 "IdentA") - (#Cons (+6 "ListA") - (#Cons (+6 "DictA") - #Nil)))))))))))] + (#Cons [["lux" "tags"] (+7 (#Cons (+5 "BoolA") + (#Cons (+5 "NatA") + (#Cons (+5 "IntA") + (#Cons (+5 "DegA") + (#Cons (+5 "RealA") + (#Cons (+5 "TextA") + (#Cons (+5 "IdentA") + (#Cons (+5 "ListA") + (#Cons (+5 "DictA") + #Nil))))))))))] (#Cons [["lux" "type-rec?"] (+0 true)] - (#Cons [["lux" "doc"] (+6 "The value of an individual annotation.")] + (#Cons [["lux" "doc"] (+5 "The value of an individual annotation.")] #Nil)))))) ## (type: Anns @@ -393,7 +381,6 @@ ## (#Int Int) ## (#Deg Deg) ## (#Real Real) -## (#Char Char) ## (#Text Text) ## (#Symbol Text Text) ## (#Tag Text Text) @@ -419,35 +406,32 @@ Deg (#Sum ## "lux;Real" Real - (#Sum ## "lux;Char" - Char - (#Sum ## "lux;Text" - Text - (#Sum ## "lux;Symbol" + (#Sum ## "lux;Text" + Text + (#Sum ## "lux;Symbol" + Ident + (#Sum ## "lux;Tag" Ident - (#Sum ## "lux;Tag" - Ident - (#Sum ## "lux;Form" + (#Sum ## "lux;Form" + Code-List + (#Sum ## "lux;Tuple" Code-List - (#Sum ## "lux;Tuple" - Code-List - ## "lux;Record" - (#Apply (#Product Code Code) List) - ))))))))))) + ## "lux;Record" + (#Apply (#Product Code Code) List) + )))))))))) )))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Bool") (#Cons (#TextA "Nat") (#Cons (#TextA "Int") (#Cons (#TextA "Deg") (#Cons (#TextA "Real") - (#Cons (#TextA "Char") - (#Cons (#TextA "Text") - (#Cons (#TextA "Symbol") - (#Cons (#TextA "Tag") - (#Cons (#TextA "Form") - (#Cons (#TextA "Tuple") - (#Cons (#TextA "Record") - #Nil)))))))))))))] + (#Cons (#TextA "Text") + (#Cons (#TextA "Symbol") + (#Cons (#TextA "Tag") + (#Cons (#TextA "Form") + (#Cons (#TextA "Tuple") + (#Cons (#TextA "Record") + #Nil))))))))))))] (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "w") #;Nil))] default-def-meta-exported))) @@ -753,11 +737,6 @@ (_lux_function _ value (_meta (#Real value)))) #Nil) -(_lux_def char$ - (_lux_: (#Function Char Code) - (_lux_function _ value (_meta (#Char value)))) - #Nil) - (_lux_def text$ (_lux_: (#Function Text Code) (_lux_function _ text (_meta (#Text text)))) @@ -1802,9 +1781,6 @@ [_ [_ (#Real value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Real"]) (real$ value))))) - [_ [_ (#Char value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Char"]) (char$ value))))) - [_ [_ (#Text value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) @@ -2281,21 +2257,6 @@ (-> Real Text) (_lux_proc ["real" "encode"] [x])) -(def:''' (Char/encode x) - #Nil - (-> Char Text) - (let' [as-text (_lux_case x - #"\t" "\\t" - #"\v" "\\v" - #"\b" "\\b" - #"\n" "\\n" - #"\r" "\\r" - #"\f" "\\f" - #"\"" "\\\"" - #"\\" "\\\\" - _ (_lux_proc ["char" "to-text"] [x]))] - ($_ Text/append "#\"" as-text "\""))) - (def:''' (multiple? div n) #Nil (-> Int Int Bool) @@ -2728,9 +2689,6 @@ [_ (#Real value)] (Real/encode value) - [_ (#Char value)] - ($_ Text/append "#" "\"" (Char/encode value) "\"") - [_ (#Text value)] ($_ Text/append "\"" value "\"") @@ -2961,9 +2919,6 @@ [_ (#Real value)] (return (form$ (list (tag$ ["lux" "RealA"]) (real$ value)))) - [_ (#Char value)] - (return (form$ (list (tag$ ["lux" "CharA"]) (char$ value)))) - [_ (#Text value)] (return (form$ (list (tag$ ["lux" "TextA"]) (text$ value)))) @@ -4937,7 +4892,6 @@ [#Int] [#Deg] [#Real] - [#Char] [#Text] [#Symbol] [#Tag]) @@ -5055,7 +5009,6 @@ [#Nat Nat/encode] [#Int Int/encode] [#Real Real/encode] - [#Char Char/encode] [#Text Text/encode] [#Symbol Ident/encode] [#Tag Tag/encode]) @@ -5255,7 +5208,7 @@ (def: (place-tokens label tokens target) (-> Text (List Code) Code (Maybe (List Code))) (case target - (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Deg _)] [_ (#Real _)] [_ (#Char _)] [_ (#Text _)] [_ (#Tag _)]) + (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Deg _)] [_ (#Real _)] [_ (#Text _)] [_ (#Tag _)]) (#Some (list target)) [_ (#Symbol [prefix name])] @@ -5305,7 +5258,6 @@ [(bool false) "false" [_ (#;Bool false)]] [(int 123) "123" [_ (#;Int 123)]] [(real 123.0) "123.0" [_ (#;Real 123.0)]] - [(char #"\n") "#\"\\n\"" [_ (#;Char #"\n")]] [(text "\n") "\"\\n\"" [_ (#;Text "\n")]] [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]] [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]] @@ -5351,7 +5303,6 @@ ["Int"] ["Deg"] ["Real"] - ["Char"] ["Text"]) (#Named _ type') @@ -5374,7 +5325,6 @@ ["Int" Int int$] ["Deg" Deg deg$] ["Real" Real real$] - ["Char" Char char$] ["Text" Text text$]) _ @@ -5412,7 +5362,7 @@ )) (macro: #export (^~ tokens) - {#;doc (doc "Use global defs with simple values, such as text, int, real, bool and char, in place of literals in patterns." + {#;doc (doc "Use global defs with simple values, such as text, int, real and bool in place of literals in patterns." "The definitions must be properly-qualified (though you may use one of the short-cuts Lux provides)." (def: (empty?' node) (All [K V] (-> (Node K V) Bool)) @@ -5791,5 +5741,17 @@ (All [a] (-> (Maybe a) a)) (|>. (default (undefined)))) -(macro: #export (as-is tokens state) - (#;Right [state tokens])) +(macro: #export (as-is tokens compiler) + (#;Right [compiler tokens])) + +(macro: #export (char tokens compiler) + (case tokens + (^multi (^ (list [_ (#Text input)])) + (n.= +1 (_lux_proc ["text" "size"] [input]))) + (|> (_lux_proc ["text" "char"] [input +0]) + assume + nat$ list + [compiler] #;Right) + + _ + (#;Left "Wrong syntax for char"))) diff --git a/stdlib/source/lux/data/char.lux b/stdlib/source/lux/data/char.lux deleted file mode 100644 index 06efa3f64..000000000 --- a/stdlib/source/lux/data/char.lux +++ /dev/null @@ -1,102 +0,0 @@ -(;module: - lux - (lux/control eq - [order] - codec - hash) - (.. [text "Text/" Monoid])) - -## [Structures] -(struct: #export _ (Eq Char) - (def: (= x y) - (_lux_proc ["char" "="] [x y]))) - -(struct: #export _ (Hash Char) - (def: eq Eq) - (def: (hash input) - (_lux_proc ["char" "to-nat"] [input]))) - -(struct: #export _ (order;Order Char) - (def: eq Eq) - - (def: (< test subject) - (_lux_proc ["char" "<"] [subject test])) - - (def: (<= test subject) - (or (_lux_proc ["char" "="] [subject test]) - (_lux_proc ["char" "<"] [subject test]))) - - (def: (> test subject) - (_lux_proc ["char" "<"] [test subject])) - - (def: (>= test subject) - (or (_lux_proc ["char" "="] [test subject]) - (_lux_proc ["char" "<"] [test subject]))) - ) - -(struct: #export _ (Codec Text Char) - (def: (encode x) - (let [as-text (case x - #"\t" "\\t" - #"\v" "\\v" - #"\b" "\\b" - #"\n" "\\n" - #"\r" "\\r" - #"\f" "\\f" - #"\"" "\\\"" - #"\\" "\\\\" - _ (_lux_proc ["char" "to-text"] [x]))] - ($_ Text/append "#\"" as-text "\""))) - - (def: (decode y) - (let [size (text;size y)] - (if (and (text;starts-with? "#\"" y) - (text;ends-with? "\"" y) - (or (n.= +4 size) - (n.= +5 size))) - (if (n.= +4 size) - (case (text;nth +2 y) - #;None - (#;Left (Text/append "Wrong syntax for Char: " y)) - - (#;Some char) - (#;Right char)) - (case [(text;nth +2 y) (text;nth +3 y)] - [(#;Some #"\\") (#;Some char)] - (case char - #"t" (#;Right #"\t") - #"v" (#;Right #"\v") - #"b" (#;Right #"\b") - #"n" (#;Right #"\n") - #"r" (#;Right #"\r") - #"f" (#;Right #"\f") - #"\"" (#;Right #"\"") - #"\\" (#;Right #"\\") - _ (#;Left (Text/append "Wrong syntax for Char: " y))) - - _ - (#;Left (Text/append "Wrong syntax for Char: " y)))) - (#;Left (Text/append "Wrong syntax for Char: " y)))))) - -## [Values] -(def: #export (space? char) - {#;doc "Checks whether the character is white-space."} - (-> Char Bool) - (case char - (^or #"\t" #"\v" #" " #"\n" #"\r" #"\f") - true - - _ - false)) - -(def: #export (as-text x) - (-> Char Text) - (_lux_proc ["char" "to-text"] [x])) - -(def: #export (char x) - (-> Nat Char) - (_lux_proc ["nat" "to-char"] [x])) - -(def: #export (code x) - (-> Char Nat) - (_lux_proc ["char" "to-nat"] [x])) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index d7469e24b..2e31a3924 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -14,7 +14,6 @@ (text ["l" lexer]) [number "Real/" Codec] maybe - [char "Char/" Codec] ["R" result] [sum] [product] @@ -426,57 +425,6 @@ [text? text! Text text;Eq text;encode #String "string" id] ) -(def: #export (char json) - {#;doc "Reads a JSON value as a single-character string."} - (Parser Char) - (case json - (#String input) - (case (Char/decode (format "#\"" input "\"")) - (#R;Success value) - (#R;Success value) - - (#R;Error _) - (#R;Error (format "Invalid format for char: " input))) - - _ - (#R;Error (format "JSON value is not a " "string" ": " (show-json json))))) - -(def: #export (char? test json) - {#;doc "Asks whether a JSON value is a single-character string with the specified character."} - (-> Char (Parser Bool)) - (case json - (#String input) - (case (Char/decode (format "#\"" input "\"")) - (#R;Success value) - (if (:: char;Eq = test value) - (#R;Success true) - (#R;Error (format "Value mismatch: " - (:: char;Codec encode test) "=/=" (:: char;Codec encode value)))) - - (#R;Error _) - (#R;Error (format "Invalid format for char: " input))) - - _ - (#R;Error (format "JSON value is not a " "string" ": " (show-json json))))) - -(def: #export (char! test json) - {#;doc "Ensures a JSON value is a single-character string with the specified character."} - (-> Char (Parser Unit)) - (case json - (#String input) - (case (Char/decode (format "#\"" input "\"")) - (#R;Success value) - (if (:: char;Eq = test value) - (#R;Success []) - (#R;Error (format "Value mismatch: " - (:: char;Codec encode test) "=/=" (:: char;Codec encode value)))) - - (#R;Error _) - (#R;Error (format "Invalid format for char: " input))) - - _ - (#R;Error (format "JSON value is not a " "string" ": " (show-json json))))) - (def: #export (nullable parser) {#;doc "A parser that can handle the presence of null values."} (All [a] (-> (Parser a) (Parser (Maybe a)))) @@ -767,7 +715,6 @@ [Bool poly;bool ;;gen-boolean] [Int poly;int (|>. ;int-to-real ;;gen-number)] [Real poly;real ;;gen-number] - [Char poly;char (|>. char;as-text ;;gen-string)] [Text poly;text ;;gen-string])] ($_ macro;either @@ -902,7 +849,6 @@ [Bool poly;bool ;;bool] [Int poly;int ;;int] [Real poly;real ;;real] - [Char poly;char ;;char] [Text poly;text ;;text]) (do-template [ ] [(do @ @@ -1055,12 +1001,11 @@ #bool Bool #int Int #real Real - #char Char #text Text #maybe (Maybe Int) #list (List Int) #variant Variant - #tuple [Int Real Char] + #tuple [Int Real Text] #dict (Dict Text Int)}) (derived: (Codec Record)))} diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index c87502e30..b95c60ed4 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -9,7 +9,6 @@ (text ["l" lexer]) [number] ["R" result] - [char "c/" Eq] [product] [maybe "m/" Monad] [ident "Ident/" Eq] @@ -55,7 +54,7 @@ (#;Some _) (l;codec number;Hex@Codec (l;many l;hexadecimal)))] - (wrap (|> code int-to-nat char;char char;as-text))) + (wrap (|> code int-to-nat text;from-code))) (p;before (l;this ";")) (p;after (l;this "&#")))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index e287f4e10..238cc139a 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -171,14 +171,17 @@ ) ## [Values & Syntax] +(def: (get-char full idx) + (-> Text Nat (Maybe Text)) + (_lux_proc ["text" "clip"] [full idx (n.inc idx)])) + (do-template [ ] [(struct: #export (Codec Text Nat) (def: (encode value) (loop [input value output ""] - (let [digit (assume (_lux_proc ["text" "char"] [ (n.% input)])) - output' (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit]) - output]) + (let [digit (assume (get-char (n.% input))) + output' (_lux_proc ["text" "append"] [digit output]) input' (n./ input)] (if (n.= +0 input') (_lux_proc ["text" "append"] ["+" output']) @@ -188,16 +191,13 @@ (let [input-size (_lux_proc ["text" "size"] [repr])] (if (n.>= +2 input-size) (case (_lux_proc ["text" "char"] [repr +0]) - (#;Some #"+") + (^ (#;Some (char "+"))) (let [input (_lux_proc ["text" "upper-case"] [repr])] (loop [idx +1 output +0] (if (n.< input-size idx) - (let [digit (assume (_lux_proc ["text" "char"] [input idx]))] - (case (_lux_proc ["text" "index"] - [ - (_lux_proc ["char" "to-text"] [digit]) - +0]) + (let [digit (assume (get-char input idx))] + (case (_lux_proc ["text" "index"] [ digit +0]) #;None (#R;Error (_lux_proc ["text" "append"] [ repr])) @@ -225,23 +225,20 @@ "-" "")] (loop [input (|> value (i./ ) (:: Number abs)) - output (|> value (i.% ) (:: Number abs) - int-to-nat [] (_lux_proc ["text" "char"]) - assume - [] - (_lux_proc ["char" "to-text"]))] + output (|> value (i.% ) (:: Number abs) int-to-nat + (get-char ) + assume)] (if (i.= 0 input) (_lux_proc ["text" "append"] [sign output]) - (let [digit (assume (_lux_proc ["text" "char"] [ (int-to-nat (i.% input))]))] + (let [digit (assume (get-char (int-to-nat (i.% input))))] (recur (i./ input) - (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit]) - output])))))))) + (_lux_proc ["text" "append"] [digit output])))))))) (def: (decode repr) (let [input-size (_lux_proc ["text" "size"] [repr])] (if (n.>= +1 input-size) - (let [sign (case (_lux_proc ["text" "char"] [repr +0]) - (#;Some #"-") + (let [sign (case (get-char repr +0) + (^ (#;Some "-")) -1 _ @@ -250,11 +247,8 @@ (loop [idx (if (i.= -1 sign) +1 +0) output 0] (if (n.< input-size idx) - (let [digit (assume (_lux_proc ["text" "char"] [input idx]))] - (case (_lux_proc ["text" "index"] - [ - (_lux_proc ["char" "to-text"] [digit]) - +0]) + (let [digit (assume (get-char input idx))] + (case (_lux_proc ["text" "index"] [ digit +0]) #;None (#R;Error ) @@ -293,7 +287,7 @@ (let [repr-size (_lux_proc ["text" "size"] [repr])] (if (n.>= +2 repr-size) (case (_lux_proc ["text" "char"] [repr +0]) - (^multi (#;Some #".") + (^multi (^ (#;Some (char "."))) [(:: decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)])) (#;Some output)]) (#R;Success (:! Deg output)) @@ -321,8 +315,7 @@ (_lux_proc ["text" "append"] ["." output]) (let [shifted (r.* dec-left) digit (|> shifted (r.% ) real-to-int int-to-nat - [] (_lux_proc ["text" "char"]) assume - [] (_lux_proc ["char" "to-text"]))] + (get-char ) assume)] (recur (r.% 1.0 shifted) (_lux_proc ["text" "append"] [output digit]))))))] (_lux_proc ["text" "append"] [whole-part decimal-part]))) @@ -684,11 +677,8 @@ (loop [idx +0 output (make-digits [])] (if (n.< length idx) - (let [char (assume (_lux_proc ["text" "char"] [input idx]))] - (case (_lux_proc ["text" "index"] - ["0123456789" - (_lux_proc ["char" "to-text"] [char]) - +0]) + (let [char (assume (get-char input idx))] + (case (_lux_proc ["text" "index"] ["0123456789" char +0]) #;None #;None diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index dca74423c..ac1994130 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -15,7 +15,7 @@ [(_lux_proc ["text" "size"] [x])]) (def: #export (nth idx input) - (-> Nat Text (Maybe Char)) + (-> Nat Text (Maybe Nat)) (_lux_proc ["text" "char"] [input idx])) (def: #export (contains? sub text) @@ -188,3 +188,19 @@ {#;doc "Surrounds the given content text with the same boundary text."} (-> Text Text Text) (enclose [boundary boundary] content)) + +(def: #export (from-code code) + (-> Nat Text) + (_lux_proc ["nat" "to-char"] [code])) + +(def: #export (space? char) + {#;doc "Checks whether the character is white-space."} + (-> Nat Bool) + (case char + (^or (^ (char "\t")) (^ (char "\v")) + (^ (char " ")) (^ (char "\n")) + (^ (char "\r")) (^ (char "\f"))) + true + + _ + false)) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 639a2f39b..2dcd3f37f 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -3,7 +3,6 @@ (lux (control monad ["p" parser]) (data [bool] - [char] [number] [text] [ident] @@ -38,7 +37,6 @@ [%i Int (:: number;Codec encode)] [%d Deg (:: number;Codec encode)] [%r Real (:: number;Codec encode)] - [%c Char (:: char;Codec encode)] [%t Text text;encode] [%ident Ident (:: ident;Codec encode)] [%code Code code;to-text] diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index c57382134..52c59d862 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -5,10 +5,9 @@ monad codec ["p" parser]) - (data [text "T/" Eq] + (data [text "T/" Order] text/format [product] - [char "C/" Order Codec] maybe ["R" result] (coll [list "L/" Functor])))) @@ -48,7 +47,7 @@ (function [[offset tape]] (case (text;nth offset tape) (#;Some output) - (#R;Success [[(n.inc offset) tape] (char;as-text output)]) + (#R;Success [[(n.inc offset) tape] (text;from-code output)]) _ (#R;Error cannot-lex-error)) @@ -107,7 +106,7 @@ (function [(^@ input [offset tape])] (case (text;nth offset tape) (#;Some output) - (#R;Success [input (char;as-text output)]) + (#R;Success [input (text;from-code output)]) _ (#R;Error cannot-lex-error)) @@ -121,25 +120,25 @@ (def: #export (range bottom top) {#;doc "Only lex characters within a range."} - (-> Char Char (Lexer Text)) + (-> Nat Nat (Lexer Text)) (do p;Monad [char any - #let [char' (|> char (text;nth +0) assume)] - _ (p;assert (format "Character is not within range: " (C/encode bottom) "-" (C/encode top)) - (and (C/>= bottom char') - (C/<= top char')))] + #let [char' (assume (text;nth +0 char))] + _ (p;assert (format "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) + (and (n.>= bottom char') + (n.<= top char')))] (wrap char))) (do-template [ ] [(def: #export {#;doc (#;TextA (format "Only lex " " characters."))} (Lexer Text) - (range ))] + (range (char ) (char )))] - [upper #"A" #"Z" "uppercase"] - [lower #"a" #"z" "lowercase"] - [decimal #"0" #"9" "decimal"] - [octal #"0" #"7" "octal"] + [upper "A" "Z" "uppercase"] + [lower "a" "z" "lowercase"] + [decimal "0" "9" "decimal"] + [octal "0" "7" "octal"] ) (def: #export alpha @@ -157,8 +156,8 @@ (Lexer Text) ($_ p;either decimal - (range #"a" #"f") - (range #"A" #"F"))) + (range (char "a") (char "f")) + (range (char "A") (char "F")))) (def: #export (one-of options) {#;doc "Only lex characters that are part of a piece of text."} @@ -166,7 +165,7 @@ (function [[offset tape]] (case (text;nth offset tape) (#;Some output) - (let [output (char;as-text output)] + (let [output (text;from-code output)] (if (text;contains? output options) (#R;Success [[(n.inc offset) tape] output]) (#R;Error (format "Character (" output ") is not one of: " options)))) @@ -180,7 +179,7 @@ (function [[offset tape]] (case (text;nth offset tape) (#;Some output) - (let [output (char;as-text output)] + (let [output (text;from-code output)] (if (;not (text;contains? output options)) (#R;Success [[(n.inc offset) tape] output]) (#R;Error (format "Character (" output ") is one of: " options)))) @@ -190,13 +189,13 @@ (def: #export (satisfies p) {#;doc "Only lex characters that satisfy a predicate."} - (-> (-> Char Bool) (Lexer Text)) + (-> (-> Nat Bool) (Lexer Text)) (function [[offset tape]] (case (text;nth offset tape) (#;Some output) (if (p output) - (#R;Success [[(n.inc offset) tape] (char;as-text output)]) - (#R;Error (format "Character does not satisfy predicate: " (char;as-text output)))) + (#R;Success [[(n.inc offset) tape] (text;from-code output)]) + (#R;Error (format "Character does not satisfy predicate: " (text;from-code output)))) _ (#R;Error cannot-lex-error)))) @@ -204,7 +203,7 @@ (def: #export space {#;doc "Only lex white-space."} (Lexer Text) - (satisfies char;space?)) + (satisfies text;space?)) (def: #export (seq left right) (-> (Lexer Text) (Lexer Text) (Lexer Text)) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 86f215497..0b4df9faf 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -2,8 +2,7 @@ lux (lux (control monad ["p" parser "p/" Monad]) - (data [char] - [text] + (data [text] ["l" text/lexer] text/format [number "Int/" Codec] @@ -81,7 +80,7 @@ [from (|> regex-char^ (:: @ map (|>. (text;nth +0) assume))) _ (l;this "-") to (|> regex-char^ (:: @ map (|>. (text;nth +0) assume)))] - (wrap (` (l;range (~ (code;char from)) (~ (code;char to))))))) + (wrap (` (l;range (~ (code;nat from)) (~ (code;nat to))))))) (def: re-char^ (l;Lexer Code) @@ -123,11 +122,11 @@ (def: #hidden ascii^ (l;Lexer Text) - (l;range #"\u0000" #"\u007F")) + (l;range (char "\u0000") (char "\u007F"))) (def: #hidden control^ (l;Lexer Text) - (p;either (l;range #"\u0000" #"\u001F") + (p;either (l;range (char "\u0000") (char "\u001F")) (l;one-of "\u007F"))) (def: #hidden punct^ diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 22245f302..50bd66a6d 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -278,7 +278,6 @@ ["long" ;Int] ["float" ;Real] ["double" ;Real] - ["char" ;Char] ["void" ;Unit]) _ diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 49a119388..a888e6fe8 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -168,7 +168,6 @@ [get-bool-ann #;BoolA Bool] [get-int-ann #;IntA Int] [get-real-ann #;RealA Real] - [get-char-ann #;CharA Char] [get-text-ann #;TextA Text] [get-ident-ann #;IdentA Ident] [get-list-ann #;ListA (List Ann-Value)] diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index caa846e61..efd28d052 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -3,7 +3,6 @@ (lux (control eq) (data bool number - [char] [text #+ Eq "Text/" Monoid] ident (coll [list #* "" Functor Fold]) @@ -15,7 +14,6 @@ ## (#;Nat Nat) ## (#;Int Int) ## (#;Real Real) -## (#;Char Char) ## (#;Text Text) ## (#;Symbol Text Text) ## (#;Tag Text Text) @@ -40,7 +38,6 @@ [int Int #;Int] [deg Deg #;Deg] [real Real #;Real] - [char Char #;Char] [text Text #;Text] [symbol Ident #;Symbol] [tag Ident #;Tag] @@ -70,7 +67,6 @@ [#;Int Eq] [#;Deg Eq] [#;Real Eq] - [#;Char char;Eq] [#;Text Eq] [#;Symbol Eq] [#;Tag Eq]) @@ -107,7 +103,6 @@ [#;Int Codec] [#;Deg Codec] [#;Real Codec] - [#;Char char;Codec] [#;Symbol Codec]) [_ (#;Text value)] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 22812023a..fe49553a5 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -10,7 +10,6 @@ [number] [product] [bool] - [char] [maybe] [ident "Ident/" Eq]) [macro #+ Monad with-gensyms] @@ -60,7 +59,6 @@ [int "Int"] [deg "Deg"] [real "Real"] - [char "Char"] [text "Text"] ) @@ -80,7 +78,6 @@ [int Int] [deg Deg] [real Real] - [char Char] [text Text])] ($_ macro;either )))) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 953891e1c..31359a6c3 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -15,7 +15,6 @@ [number] [product] [bool] - [char] [maybe]) [macro #+ Monad with-gensyms] (macro [code] @@ -54,7 +53,6 @@ [Int poly;int number;Eq] [Deg poly;deg number;Eq] [Real poly;real number;Eq] - [Char poly;char char;Eq] [Text poly;text text;Eq]) (do-template [ ] [(do @ diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index 136080fa7..39a557bfe 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -9,7 +9,6 @@ [number] [product] [bool] - [char] [maybe] [ident "Ident/" Codec]) [macro #+ Monad with-gensyms] diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux index af0cff4f8..d1bef1952 100644 --- a/stdlib/source/lux/macro/poly/text-encoder.lux +++ b/stdlib/source/lux/macro/poly/text-encoder.lux @@ -9,7 +9,6 @@ [number] [product] [bool] - [char] [maybe] [ident "Ident/" Codec]) [macro #+ Monad with-gensyms] @@ -48,7 +47,6 @@ [Int poly;int (:: number;Codec encode)] [Deg poly;deg (:: number;Codec encode)] [Real poly;real (:: number;Codec encode)] - [Char poly;char (:: char;Codec encode)] [Text poly;text text;encode])] ($_ macro;either ## Primitives diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index d9eb96731..a1b84cdec 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -7,7 +7,6 @@ eq ["p" parser]) (data [bool] - [char] [number] [text "Text/" Monoid] [ident] @@ -60,7 +59,6 @@ [ int Int #;Int number;Eq "int"] [ deg Deg #;Deg number;Eq "deg"] [ real Real #;Real number;Eq "real"] - [ char Char #;Char char;Eq "char"] [ text Text #;Text text;Eq "text"] [symbol Ident #;Symbol ident;Eq "symbol"] [ tag Ident #;Tag ident;Eq "tag"] diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 874c600f0..e5e06bd16 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -110,7 +110,6 @@ (p/map code;int s;int) (p/map code;deg s;deg) (p/map code;real s;real) - (p/map code;char s;char) (p/map code;text s;text) (p/map code;symbol s;symbol) (p/map code;tag s;tag)) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 91ef541c7..bde9d39c5 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -5,7 +5,6 @@ monad hash) (data [bit] - [char] [text "Text/" Monoid] text/format [product] @@ -100,24 +99,18 @@ (Random Deg) (:: Monad map real-to-deg real)) -(def: #export char - (Random Char) - (do Monad - [base nat] - (wrap (char;char base)))) - (def: #export (text' char-gen size) - (-> (Random Char) Nat (Random Text)) + (-> (Random Nat) Nat (Random Text)) (if (n.= +0 size) (:: Monad wrap "") (do Monad [x char-gen xs (text' char-gen (n.dec size))] - (wrap (Text/append (char;as-text x) xs))))) + (wrap (Text/append (text;from-code x) xs))))) (def: #export (text size) (-> Nat (Random Text)) - (text' char size)) + (text' nat size)) (do-template [ ] [(def: #export diff --git a/stdlib/source/lux/paradigm/concatenative.lux b/stdlib/source/lux/paradigm/concatenative.lux index 0a149ec3b..1c78d7be1 100644 --- a/stdlib/source/lux/paradigm/concatenative.lux +++ b/stdlib/source/lux/paradigm/concatenative.lux @@ -99,7 +99,7 @@ (^or [_ (#;Bool _)] [_ (#;Nat _)] [_ (#;Int _)] [_ (#;Deg _)] [_ (#;Real _)] - [_ (#;Char _)] [_ (#;Text _)] + [_ (#;Text _)] [_ (#;Tag _)] (^ [_ (#;Form (list [_ (#;Tag _)]))])) (` (;;push (~ command))) -- cgit v1.2.3