diff options
55 files changed, 274 insertions, 792 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 4c4aff505..9fd8a5d03 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -224,6 +224,7 @@ Called by `imenu--generic-function'." "word:" "function" "case" ":" ":!" ":!!" "undefined" "ident-for" "and" "or" + "char" "exec" "let" "with-expansions" "if" "cond" "do" "be" "open" "loop" "recur" "comment" "list" "list&" "io" "vector" "tree" "get@" "set@" "update@" "|>" "|>." "<|" "<|." "_$" "$_" "~" "~@" "~'" "::" ":::" "default" "|" "&" "->" "All" "Ex" "Rec" "host" "$" "type" @@ -236,7 +237,7 @@ Called by `imenu--generic-function'." "`" "`'" "'" "do-template" "object" "jvm-import" "do-to" "with-open" "synchronized" "class-for" "doc" - "|E" "|F" "|H" "effect:" "handler:" "with-handler" "doE" "lift" + "|E" "|F" "|H" "effect:" "handler:" "with-handler" "doE" "regex" "seq" ) t) "\\>") diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 1c854acb9..5ea8cf64b 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -86,10 +86,6 @@ (|do [_ (&type/check exo-type &type/Real)] (return (&/|list (&&/|meta exo-type cursor (&&/$real ?value))))) - (&/$Char ?value) - (|do [_ (&type/check exo-type &type/Char)] - (return (&/|list (&&/|meta exo-type cursor (&&/$char ?value))))) - (&/$Text ?value) (|do [_ (&type/check exo-type &type/Text)] (return (&/|list (&&/|meta exo-type cursor (&&/$text ?value))))) diff --git a/luxc/src/lux/analyser/base.clj b/luxc/src/lux/analyser/base.clj index b71df2b1f..bfe931546 100644 --- a/luxc/src/lux/analyser/base.clj +++ b/luxc/src/lux/analyser/base.clj @@ -11,7 +11,6 @@ ("int" 1) ("deg" 1) ("real" 1) - ("char" 1) ("text" 1) ("variant" 3) ("tuple" 1) diff --git a/luxc/src/lux/analyser/case.clj b/luxc/src/lux/analyser/case.clj index c60059540..fa9d568d0 100644 --- a/luxc/src/lux/analyser/case.clj +++ b/luxc/src/lux/analyser/case.clj @@ -17,7 +17,6 @@ ("IntTotal" 2) ("DegTotal" 2) ("RealTotal" 2) - ("CharTotal" 2) ("TextTotal" 2) ("TupleTotal" 2) ("VariantTotal" 2)) @@ -30,7 +29,6 @@ ("IntTestAC" 1) ("DegTestAC" 1) ("RealTestAC" 1) - ("CharTestAC" 1) ("TextTestAC" 1) ("TupleTestAC" 1) ("VariantTestAC" 1)) @@ -296,11 +294,6 @@ =kont kont] (return (&/T [($RealTestAC ?value) =kont]))) - (&/$Char ?value) - (|do [_ (&type/check value-type &type/Char) - =kont kont] - (return (&/T [($CharTestAC ?value) =kont]))) - (&/$Text ?value) (|do [_ (&type/check value-type &type/Text) =kont kont] @@ -428,9 +421,6 @@ [($RealTotal total? ?values) ($NoTestAC)] (return ($RealTotal true ?values)) - [($CharTotal total? ?values) ($NoTestAC)] - (return ($CharTotal true ?values)) - [($TextTotal total? ?values) ($NoTestAC)] (return ($TextTotal true ?values)) @@ -458,9 +448,6 @@ [($RealTotal total? ?values) ($StoreTestAC ?idx)] (return ($RealTotal true ?values)) - [($CharTotal total? ?values) ($StoreTestAC ?idx)] - (return ($CharTotal true ?values)) - [($TextTotal total? ?values) ($StoreTestAC ?idx)] (return ($TextTotal true ?values)) @@ -500,12 +487,6 @@ [($RealTotal total? ?values) ($RealTestAC ?value)] (return ($RealTotal total? (&/$Cons ?value ?values))) - [($DefaultTotal total?) ($CharTestAC ?value)] - (return ($CharTotal total? (&/|list ?value))) - - [($CharTotal total? ?values) ($CharTestAC ?value)] - (return ($CharTotal total? (&/$Cons ?value ?values))) - [($DefaultTotal total?) ($TextTestAC ?value)] (return ($TextTotal total? (&/|list ?value))) @@ -591,10 +572,6 @@ (|do [_ (&type/check value-type &type/Real)] (return ?total)) - ($CharTotal ?total _) - (|do [_ (&type/check value-type &type/Char)] - (return ?total)) - ($TextTotal ?total _) (|do [_ (&type/check value-type &type/Text)] (return ?total)) diff --git a/luxc/src/lux/analyser/parser.clj b/luxc/src/lux/analyser/parser.clj index 873f0db91..731b5bace 100644 --- a/luxc/src/lux/analyser/parser.clj +++ b/luxc/src/lux/analyser/parser.clj @@ -142,9 +142,6 @@ [_ (&lexer/$Real param-value*)] &lexer/lex-real] (return (double param-value*))) - (|do [[_ (&lexer/$Char param-value*)] &lexer/lex-char] - (return (char param-value*))) - (|do [[_ (&lexer/$Text param-value*)] &lexer/lex-text] (return param-value*)) ))] diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 0695de2a6..27af2a08d 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -131,7 +131,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/Char &type/Maybe)) + _ (&type/check exo-type (&/$Apply &type/Nat &type/Maybe)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "char"]) @@ -217,9 +217,6 @@ ^:private analyse-real-rem ["real" "%"] &type/Real &type/Real ^:private analyse-real-eq ["real" "="] &type/Real &type/Bool ^:private analyse-real-lt ["real" "<"] &type/Real &type/Bool - - ^:private analyse-char-eq ["char" "="] &type/Char &type/Bool - ^:private analyse-char-lt ["char" "<"] &type/Char &type/Bool ) (do-template [<name> <proc>] @@ -294,13 +291,10 @@ ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"] ^:private analyse-int-to-nat &type/Int &type/Nat ["int" "to-nat"] - ^:private analyse-nat-to-char &type/Nat &type/Char ["nat" "to-char"] - ^:private analyse-char-to-nat &type/Char &type/Nat ["char" "to-nat"] + ^:private analyse-nat-to-char &type/Nat &type/Text ["nat" "to-char"] ^:private analyse-int-to-real &type/Int &type/Real ["int" "to-real"] ^:private analyse-real-to-int &type/Real &type/Int ["real" "to-int"] - - ^:private analyse-char-to-text &type/Char &type/Text ["char" "to-text"] ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"] ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"] @@ -598,14 +592,6 @@ "to-int" (analyse-real-to-int analyse exo-type ?values) ) - "char" - (case proc - "=" (analyse-char-eq analyse exo-type ?values) - "<" (analyse-char-lt analyse exo-type ?values) - "to-text" (analyse-char-to-text analyse exo-type ?values) - "to-nat" (analyse-char-to-nat analyse exo-type ?values) - ) - "math" (case proc "e" (analyse-math-e analyse exo-type ?values) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index c63cce34e..8a7378586 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -76,7 +76,6 @@ ("Int" 1) ("Deg" 1) ("Real" 1) - ("Char" 1) ("Text" 1) ("Symbol" 1) ("Tag" 1) @@ -223,7 +222,6 @@ ("IntA" 1) ("DegA" 1) ("RealA" 1) - ("CharA" 1) ("TextA" 1) ("IdentA" 1) ("ListA" 1) @@ -1222,9 +1220,6 @@ [_ ($Real ?value)] (pr-str ?value) - [_ ($Char ?value)] - (str "#\"" (pr-str ?value) "\"") - [_ ($Text ?value)] (str "\"" ?value "\"") diff --git a/luxc/src/lux/compiler/cache/ann.clj b/luxc/src/lux/compiler/cache/ann.clj index b71d6707b..35a41f247 100644 --- a/luxc/src/lux/compiler/cache/ann.clj +++ b/luxc/src/lux/compiler/cache/ann.clj @@ -43,9 +43,6 @@ (&/$RealA value) (str "R" value stop) - (&/$CharA value) - (str "C" value stop) - (&/$TextA value) (serialize-text value) @@ -88,7 +85,6 @@ ^:private deserialize-int "I" &/$IntA Long/parseLong ^:private deserialize-deg "D" &/$DegA Long/parseLong ^:private deserialize-real "R" &/$RealA Double/parseDouble - ^:private deserialize-char "C" &/$CharA (fn [^String input] (.charAt input 0)) ^:private deserialize-text "T" &/$TextA identity ) @@ -143,7 +139,6 @@ (deserialize-int input) (deserialize-deg input) (deserialize-real input) - (deserialize-char input) (deserialize-text input) (deserialize-ident input) (deserialize-list input) diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj index c19a40dcd..b618b7b1b 100644 --- a/luxc/src/lux/compiler/js.clj +++ b/luxc/src/lux/compiler/js.clj @@ -51,9 +51,6 @@ (&o/$real ?value) (&&lux/compile-real ?value) - (&o/$char ?value) - (&&lux/compile-char ?value) - (&o/$text ?value) (&&lux/compile-text ?value) diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj index d066dff17..593055b8b 100644 --- a/luxc/src/lux/compiler/js/lux.clj +++ b/luxc/src/lux/compiler/js/lux.clj @@ -192,10 +192,6 @@ (&o/$RealPM _value) (return (str "if(" cursor-peek " !== " _value ") { " pm-fail " }")) - (&o/$CharPM _value) - (|do [=value (compile-char _value)] - (return (str "if(" (str "(" cursor-peek ").C") " !== " (str "(" =value ").C") ") { " pm-fail " }"))) - (&o/$TextPM _value) (|do [=value (compile-text _value)] (return (str "if(" cursor-peek " !== " =value ") { " pm-fail " }"))) diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj index 22310201c..5c11c0c6d 100644 --- a/luxc/src/lux/compiler/jvm.clj +++ b/luxc/src/lux/compiler/jvm.clj @@ -62,9 +62,6 @@ (&o/$real ?value) (&&lux/compile-real ?value) - (&o/$char ?value) - (&&lux/compile-char ?value) - (&o/$text ?value) (&&lux/compile-text ?value) diff --git a/luxc/src/lux/compiler/jvm/case.clj b/luxc/src/lux/compiler/jvm/case.clj index da8d8d0a9..c205381e8 100644 --- a/luxc/src/lux/compiler/jvm/case.clj +++ b/luxc/src/lux/compiler/jvm/case.clj @@ -101,13 +101,6 @@ (.visitInsn Opcodes/DCMPL) (.visitJumpInsn Opcodes/IFNE $else)) - (&o/$CharPM _value) - (doto writer - stack-peek - &&/unwrap-char - (.visitLdcInsn _value) - (.visitJumpInsn Opcodes/IF_ICMPNE $else)) - (&o/$TextPM _value) (doto writer stack-peek diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index bb7dda339..123676d35 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -41,7 +41,6 @@ compile-int "java/lang/Long" "J" long compile-deg "java/lang/Long" "J" long compile-real "java/lang/Double" "D" double - compile-char "java/lang/Character" "C" char ) (defn compile-text [?value] diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 821fcc619..7c44f3434 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -274,31 +274,6 @@ ^:private compile-real-lt Opcodes/DCMPG -1 &&/unwrap-double ) -(do-template [<name> <opcode> <unwrap>] - (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - <unwrap>)] - _ (compile ?y) - :let [_ (doto *writer* - <unwrap>) - $then (new Label) - $end (new Label) - _ (doto *writer* - (.visitJumpInsn <opcode> $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean")) - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean")) - (.visitLabel $end))]] - (return nil))) - - ^:private compile-char-eq Opcodes/IF_ICMPEQ &&/unwrap-char - ^:private compile-char-lt Opcodes/IF_ICMPLT &&/unwrap-char - ) - (do-template [<name> <cmp-output>] (defn <name> [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] @@ -440,34 +415,15 @@ ^:private compile-real-to-deg "java.lang.Double" "real-to-deg" "(D)J" &&/unwrap-double &&/wrap-long ) -(let [widen (fn [^MethodVisitor *writer*] - (doto *writer* - (.visitInsn Opcodes/I2L))) - shrink (fn [^MethodVisitor *writer*] - (doto *writer* - (.visitInsn Opcodes/L2I) - (.visitInsn Opcodes/I2C)))] - (do-template [<name> <unwrap> <wrap> <adjust>] - (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - <unwrap> - <adjust> - <wrap>)]] - (return nil))) - - ^:private compile-nat-to-char &&/unwrap-long &&/wrap-char shrink - ^:private compile-char-to-nat &&/unwrap-char &&/wrap-long widen - )) - -(defn ^:private compile-char-to-text [compile ?values special-args] +(defn ^:private compile-nat-to-char [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?x) :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "toString" "()Ljava/lang/String;"))]] + &&/unwrap-long + (.visitInsn Opcodes/L2I) + (.visitInsn Opcodes/I2C) + (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/String" "valueOf" "(C)Ljava/lang/String;"))]] (return nil))) (do-template [<name>] @@ -968,14 +924,6 @@ "decode" (compile-real-decode compile ?values special-args) ) - "char" - (case proc - "=" (compile-char-eq compile ?values special-args) - "<" (compile-char-lt compile ?values special-args) - "to-nat" (compile-char-to-nat compile ?values special-args) - "to-text" (compile-char-to-text compile ?values special-args) - ) - "math" (case proc "e" (compile-math-e compile ?values special-args) diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 31a2c800c..63a5e1935 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -698,8 +698,9 @@ (.visitLabel $from) (.visitVarInsn Opcodes/ALOAD 0) (.visitVarInsn Opcodes/ILOAD 1) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") - &&/wrap-char + (.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) diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 58f8f95f7..dbdeef6a8 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -14,7 +14,6 @@ ("Int" 1) ("Deg" 1) ("Real" 1) - ("Char" 1) ("Text" 1) ("Symbol" 1) ("Tag" 1) @@ -27,32 +26,6 @@ ) ;; [Utils] -(defn ^:private escape-char [escaped] - "(-> Text (Lux Text))" - (cond (.equals ^Object escaped "\\t") (return "\t") - (.equals ^Object escaped "\\v") (return "\u000B") - (.equals ^Object escaped "\\b") (return "\b") - (.equals ^Object escaped "\\n") (return "\n") - (.equals ^Object escaped "\\r") (return "\r") - (.equals ^Object escaped "\\f") (return "\f") - (.equals ^Object escaped "\\\"") (return "\"") - (.equals ^Object escaped "\\\\") (return "\\") - :else - (&/fail-with-loc (str "[Lexer Error] Unknown escape character: " escaped)))) - -(defn ^:private escape-char* [escaped] - "(-> Text Text)" - (cond (.equals ^Object escaped "\\t") "\t" - (.equals ^Object escaped "\\v") "\u000B" - (.equals ^Object escaped "\\b") "\b" - (.equals ^Object escaped "\\n") "\n" - (.equals ^Object escaped "\\r") "\r" - (.equals ^Object escaped "\\f") "\f" - (.equals ^Object escaped "\\\"") "\"" - (.equals ^Object escaped "\\\\") "\\" - :else - (assert false (str "[Lexer Error] Unknown escape character: " escaped)))) - (defn ^:private clean-line [^String raw-line] "(-> Text Text)" (let [line-length (.length raw-line) @@ -171,17 +144,6 @@ lex-real $Real #"^-?(0\.[0-9_]+|[1-9][0-9_]*\.[0-9_]+)(e-?[1-9][0-9_]*)?" ) -(def lex-char - (|do [[meta _ _] (&reader/read-text "#\"") - token (&/try-all% (&/|list (|do [[_ _ escaped] (&reader/read-regex #"^(\\.)")] - (escape-char escaped)) - (|do [[_ _ ^String unicode] (&reader/read-regex #"^(\\u[0-9a-fA-F]{4})")] - (return (str (char (Integer/valueOf (.substring unicode 2) 16))))) - (|do [[_ _ char] (&reader/read-regex #"^(.)")] - (return char)))) - _ (&reader/read-text "\"")] - (return (&/T [meta ($Char token)])))) - (def ^:private lex-ident (&/try-all-% "[Reader Error]" (&/|list (|do [[meta _ token] (&reader/read-regex +ident-re+) @@ -246,7 +208,6 @@ lex-real lex-deg lex-int - lex-char lex-text lex-symbol lex-tag diff --git a/luxc/src/lux/optimizer.clj b/luxc/src/lux/optimizer.clj index d83ac3014..107435f92 100644 --- a/luxc/src/lux/optimizer.clj +++ b/luxc/src/lux/optimizer.clj @@ -11,7 +11,6 @@ ("int" 1) ("deg" 1) ("real" 1) - ("char" 1) ("text" 1) ("variant" 3) ("tuple" 1) @@ -76,8 +75,6 @@ ("DegPM" 1) ;; Compare the CDN with a real value. ("RealPM" 1) - ;; Compare the CDN with a character value. - ("CharPM" 1) ;; Compare the CDN with a text value. ("TextPM" 1) ;; Compare the CDN with a variant value. If valid, proceed to test @@ -197,10 +194,6 @@ (&/|list ($RealPM _value) $PopPM) - (&a-case/$CharTestAC _value) - (&/|list ($CharPM _value) - $PopPM) - (&a-case/$TextTestAC _value) (&/|list ($TextPM _value) $PopPM) @@ -267,57 +260,6 @@ ($ExecPM body-id) (clean-unnecessary-pops (&/|reverse (transform-pm* test))))) -(defn ^:private pattern->text [pattern] - (|case pattern - ($PopPM) - "$PopPM" - - ($BindPM _id) - (str "($BindPM " _id ")") - - ($BoolPM _value) - (str "($BoolPM " (pr-str _value) ")") - - ($NatPM _value) - (str "($NatPM " (pr-str _value) ")") - - ($IntPM _value) - (str "($IntPM " (pr-str _value) ")") - - ($DegPM _value) - (str "($DegPM " (pr-str _value) ")") - - ($RealPM _value) - (str "($RealPM " (pr-str _value) ")") - - ($CharPM _value) - (str "($CharPM " (pr-str _value) ")") - - ($TextPM _value) - (str "($TextPM " (pr-str _value) ")") - - ($TuplePM (&/$Left _idx)) - (str "($TuplePM L" _idx ")") - - ($TuplePM (&/$Right _idx)) - (str "($TuplePM R" _idx ")") - - ($VariantPM (&/$Left _idx)) - (str "($VariantPM L" _idx ")") - - ($VariantPM (&/$Right _idx)) - (str "($VariantPM R" _idx ")") - - ($SeqPM _left _right) - (str "($SeqPM " (pattern->text _left) " " (pattern->text _right) ")") - - ($ExecPM _idx) - (str "($ExecPM " _idx ")") - - ;; $AltPM is not considered because it's not supposed to be - ;; present anywhere at this point in time. - )) - ;; This function fuses together the paths of the PM traversal, adding ;; branching AltPMs where necessary, and fusing similar paths together ;; as much as possible, when early parts of them coincide. @@ -358,11 +300,6 @@ ($RealPM _pre-value) ($AltPM pre post)) - [($CharPM _pre-value) ($CharPM _post-value)] - (if (= _pre-value _post-value) - ($CharPM _pre-value) - ($AltPM pre post)) - [($TextPM _pre-value) ($TextPM _post-value)] (if (= _pre-value _post-value) ($TextPM _pre-value) @@ -1079,9 +1016,6 @@ (&a/$real value) (&/T [meta ($real value)]) - (&a/$char value) - (&/T [meta ($char value)]) - (&a/$text value) (&/T [meta ($text value)]) diff --git a/luxc/src/lux/parser.clj b/luxc/src/lux/parser.clj index c502efff2..7c9076aee 100644 --- a/luxc/src/lux/parser.clj +++ b/luxc/src/lux/parser.clj @@ -79,9 +79,6 @@ (&lexer/$Real ?value) (return (&/|list (&/T [meta (&/$Real (Double/parseDouble ?value))]))) - (&lexer/$Char ^String ?value) - (return (&/|list (&/T [meta (&/$Char (.charAt ?value 0))]))) - (&lexer/$Text ?value) (return (&/|list (&/T [meta (&/$Text ?value)]))) diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index b569d890f..e6cc86fff 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -28,7 +28,6 @@ (def Deg (&/$Named (&/T ["lux" "Deg"]) (&/$Host &&host/deg-data-tag &/$Nil))) (def Int (&/$Named (&/T ["lux" "Int"]) (&/$Host "#Int" &/$Nil))) (def Real (&/$Named (&/T ["lux" "Real"]) (&/$Host "#Real" &/$Nil))) -(def Char (&/$Named (&/T ["lux" "Char"]) (&/$Host "#Char" &/$Nil))) (def Text (&/$Named (&/T ["lux" "Text"]) (&/$Host "#Text" &/$Nil))) (def Ident (&/$Named (&/T ["lux" "Ident"]) (&/$Product Text Text))) @@ -144,19 +143,16 @@ ;; RealA Real (&/$Sum - ;; CharA - Char + ;; TextA + Text (&/$Sum - ;; TextA - Text + ;; IdentA + Ident (&/$Sum - ;; IdentA - Ident - (&/$Sum - ;; ListA - (&/$Apply Ann-Value List) - ;; DictA - (&/$Apply (&/$Product Text Ann-Value) List)))))))))) + ;; ListA + (&/$Apply Ann-Value List) + ;; DictA + (&/$Apply (&/$Product Text Ann-Value) List))))))))) ))))) (def Anns 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<Text>])) - -## [Structures] -(struct: #export _ (Eq Char) - (def: (= x y) - (_lux_proc ["char" "="] [x y]))) - -(struct: #export _ (Hash Char) - (def: eq Eq<Char>) - (def: (hash input) - (_lux_proc ["char" "to-nat"] [input]))) - -(struct: #export _ (order;Order Char) - (def: eq Eq<Char>) - - (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<Text,Real>] maybe - [char "Char/" Codec<Text,Char>] ["R" result] [sum] [product] @@ -426,57 +425,6 @@ [text? text! Text text;Eq<Text> 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<Char> = test value) - (#R;Success true) - (#R;Error (format "Value mismatch: " - (:: char;Codec<Text,Char> encode test) "=/=" (:: char;Codec<Text,Char> 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<Char> = test value) - (#R;Success []) - (#R;Error (format "Value mismatch: " - (:: char;Codec<Text,Char> encode test) "=/=" (:: char;Codec<Text,Char> 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 <basic> @@ -902,7 +849,6 @@ [Bool poly;bool ;;bool] [Int poly;int ;;int] [Real poly;real ;;real] - [Char poly;char ;;char] [Text poly;text ;;text]) <complex> (do-template [<type> <matcher> <decoder>] [(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<JSON,?> 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<Char>] [product] [maybe "m/" Monad<Maybe>] [ident "Ident/" Eq<Ident>] @@ -55,7 +54,7 @@ (#;Some _) (l;codec number;Hex@Codec<Text,Int> (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> <base> <char-set> <error>] [(struct: #export <struct> (Codec Text Nat) (def: (encode value) (loop [input value output ""] - (let [digit (assume (_lux_proc ["text" "char"] [<char-set> (n.% <base> input)])) - output' (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit]) - output]) + (let [digit (assume (get-char <char-set> (n.% <base> input))) + output' (_lux_proc ["text" "append"] [digit output]) input' (n./ <base> 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"] - [<char-set> - (_lux_proc ["char" "to-text"] [digit]) - +0]) + (let [digit (assume (get-char input idx))] + (case (_lux_proc ["text" "index"] [<char-set> digit +0]) #;None (#R;Error (_lux_proc ["text" "append"] [<error> repr])) @@ -225,23 +225,20 @@ "-" "")] (loop [input (|> value (i./ <base>) (:: Number<Int> abs)) - output (|> value (i.% <base>) (:: Number<Int> abs) - int-to-nat [<char-set>] (_lux_proc ["text" "char"]) - assume - [] - (_lux_proc ["char" "to-text"]))] + output (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat + (get-char <char-set>) + assume)] (if (i.= 0 input) (_lux_proc ["text" "append"] [sign output]) - (let [digit (assume (_lux_proc ["text" "char"] [<char-set> (int-to-nat (i.% <base> input))]))] + (let [digit (assume (get-char <char-set> (int-to-nat (i.% <base> input))))] (recur (i./ <base> 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"] - [<char-set> - (_lux_proc ["char" "to-text"] [digit]) - +0]) + (let [digit (assume (get-char input idx))] + (case (_lux_proc ["text" "index"] [<char-set> digit +0]) #;None (#R;Error <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 "."))) [(:: <nat> 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.* <base> dec-left) digit (|> shifted (r.% <base>) real-to-int int-to-nat - [<char-set>] (_lux_proc ["text" "char"]) assume - [] (_lux_proc ["char" "to-text"]))] + (get-char <char-set>) 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<Text,Int> encode)] [%d Deg (:: number;Codec<Text,Deg> encode)] [%r Real (:: number;Codec<Text,Real> encode)] - [%c Char (:: char;Codec<Text,Char> encode)] [%t Text text;encode] [%ident Ident (:: ident;Codec<Text,Ident> 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<Text>] + (data [text "T/" Order<Text>] text/format [product] - [char "C/" Order<Char> Codec<Text,Char>] maybe ["R" result] (coll [list "L/" Functor<List>])))) @@ -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<Parser> [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 [<name> <bottom> <top> <desc>] [(def: #export <name> {#;doc (#;TextA (format "Only lex " <desc> " characters."))} (Lexer Text) - (range <bottom> <top>))] + (range (char <bottom>) (char <top>)))] - [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<Parser>]) - (data [char] - [text] + (data [text] ["l" text/lexer] text/format [number "Int/" Codec<Text,Int>] @@ -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> "Text/" Monoid<Text>] ident (coll [list #* "" Functor<List> Fold<List>]) @@ -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<Int>] [#;Deg Eq<Deg>] [#;Real Eq<Real>] - [#;Char char;Eq<Char>] [#;Text Eq<Text>] [#;Symbol Eq<Ident>] [#;Tag Eq<Ident>]) @@ -107,7 +103,6 @@ [#;Int Codec<Text,Int>] [#;Deg Codec<Text,Deg>] [#;Real Codec<Text,Real>] - [#;Char char;Codec<Text,Char>] [#;Symbol Codec<Text,Ident>]) [_ (#;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<Ident>]) [macro #+ Monad<Lux> 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 <primitives>)))) 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<Lux> with-gensyms] (macro [code] @@ -54,7 +53,6 @@ [Int poly;int number;Eq<Int>] [Deg poly;deg number;Eq<Deg>] [Real poly;real number;Eq<Real>] - [Char poly;char char;Eq<Char>] [Text poly;text text;Eq<Text>]) <composites> (do-template [<name> <eq>] [(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<Text,Ident>]) [macro #+ Monad<Lux> 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<Text,Ident>]) [macro #+ Monad<Lux> with-gensyms] @@ -48,7 +47,6 @@ [Int poly;int (:: number;Codec<Text,Int> encode)] [Deg poly;deg (:: number;Codec<Text,Deg> encode)] [Real poly;real (:: number;Codec<Text,Real> encode)] - [Char poly;char (:: char;Codec<Text,Char> 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<Text>] [ident] @@ -60,7 +59,6 @@ [ int Int #;Int number;Eq<Int> "int"] [ deg Deg #;Deg number;Eq<Deg> "deg"] [ real Real #;Real number;Eq<Real> "real"] - [ char Char #;Char char;Eq<Char> "char"] [ text Text #;Text text;Eq<Text> "text"] [symbol Ident #;Symbol ident;Eq<Ident> "symbol"] [ tag Ident #;Tag ident;Eq<Ident> "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>] text/format [product] @@ -100,24 +99,18 @@ (Random Deg) (:: Monad<Random> map real-to-deg real)) -(def: #export char - (Random Char) - (do Monad<Random> - [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<Random> wrap "") (do Monad<Random> [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 [<name> <type> <ctor> <gen>] [(def: #export <name> 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))) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index 5c4f5851c..4580dca1e 100644 --- a/stdlib/test/test/lux/control/parser.lux +++ b/stdlib/test/test/lux/control/parser.lux @@ -9,7 +9,6 @@ text/format [number] [bool] - [char] [ident] ["R" result]) ["r" math/random] diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux deleted file mode 100644 index e0f790905..000000000 --- a/stdlib/test/test/lux/data/char.lux +++ /dev/null @@ -1,48 +0,0 @@ -(;module: - lux - (lux (control [monad] - pipe) - [io] - (data char - [text] - text/format) - ["R" math/random]) - lux/test) - -(context: "Char operations" - [value R;char - other R;char] - ($_ seq - (test "Can compare characterss for equality." - (:: Eq<Char> = value value)) - - (test "Can go back-and-forth into numeric codes." - (|> value code char (:: Eq<Char> = value))) - - (test "Can encode/decode as text." - (and (|> value - (:: Codec<Text,Char> encode) - (:: Codec<Text,Char> decode) - (case> (#;Right dec-value) - (:: Eq<Char> = value dec-value) - - (#;Left _) - false)) - (|> value as-text - (text;nth +0) (default (undefined)) - (:: Eq<Char> = value)))) - - (test "Characters have an ordering relationship." - (if (:: Order<Char> < other value) - (:: Order<Char> > value other) - (:: Order<Char> >= other value))) - )) - -(context: "Special cases" - (test "Can test whether a char is white-space." - (and (space? #" ") - (space? #"\n") - (space? #"\t") - (space? #"\r") - (space? #"\f") - (not (space? #"a"))))) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index 0153e8049..7d90e428d 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -6,7 +6,6 @@ (data [text "Text/" Monoid<Text>] text/format [number] - [char] (coll ["&" dict] [list "List/" Fold<List> Functor<List>])) ["R" math/random]) @@ -15,11 +14,9 @@ (context: "Dictionaries." [#let [capped-nat (:: R;Monad<Random> map (n.% +100) R;nat)] size capped-nat - dict (R;dict char;Hash<Char> size R;char capped-nat) - non-key (|> R;char - (R;filter (function [key] (not (&;contains? key dict))))) - test-val (|> R;nat - (R;filter (function [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))] + dict (R;dict number;Hash<Nat> size R;nat capped-nat) + non-key (|> R;nat (R;filter (function [key] (not (&;contains? key dict))))) + test-val (|> R;nat (R;filter (function [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))] ($_ seq (test "Size function should correctly represent Dict size." (n.= size (&;size dict))) @@ -30,7 +27,7 @@ (not (&;empty? dict)))) (test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list;Eq<List> (eq;conj char;Eq<Char> number;Eq<Nat>)) = + (:: (list;Eq<List> (eq;conj number;Eq<Nat> number;Eq<Nat>)) = (&;entries dict) (list;zip2 (&;keys dict) (&;values dict)))) @@ -91,7 +88,7 @@ (test "A Dict should equal itself & going to<->from lists shouldn't change that." (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] (and (= dict dict) - (|> dict &;entries (&;from-list char;Hash<Char>) (= dict))))) + (|> dict &;entries (&;from-list number;Hash<Nat>) (= dict))))) (test "Merging a Dict to itself changes nothing." (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] @@ -100,7 +97,7 @@ (test "If you merge, and the second dict has overlapping keys, it should overwrite yours." (let [dict' (|> dict &;entries (List/map (function [[k v]] [k (n.inc v)])) - (&;from-list char;Hash<Char>)) + (&;from-list number;Hash<Nat>)) (^open) (&;Eq<Dict> number;Eq<Nat>)] (= dict' (&;merge dict' dict)))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index e133ef87d..c61429b87 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -9,7 +9,6 @@ text/format [result] [bool] - [char] [maybe] [number "i/" Number<Int>] (format ["&" json]) @@ -65,12 +64,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 (d;Dict Text Int)}) (def: gen-record @@ -83,12 +81,11 @@ r;bool gen-int r;real - r;char (r;text size) (r;maybe gen-int) (r;list size gen-int) ($_ r;alt r;bool gen-int r;real) - ($_ r;seq gen-int r;real r;char) + ($_ r;seq gen-int r;real (r;text size)) (r;dict text;Hash<Text> size (r;text size) gen-int) ))) @@ -112,7 +109,6 @@ (and (:: bool;Eq<Bool> = (get@ #bool recL) (get@ #bool recR)) (i.= (get@ #int recL) (get@ #int recR)) (r.= (get@ #real recL) (get@ #real recR)) - (:: char;Eq<Char> = (get@ #char recL) (get@ #char recR)) (:: text;Eq<Text> = (get@ #text recL) (get@ #text recR)) (:: (maybe;Eq<Maybe> number;Eq<Int>) = (get@ #maybe recL) (get@ #maybe recR)) (:: (list;Eq<List> number;Eq<Int>) = (get@ #list recL) (get@ #list recR)) @@ -121,7 +117,7 @@ [tR0 tR1 tR2] (get@ #tuple recR)] (and (i.= tL0 tR0) (r.= tL1 tR1) - (:: char;Eq<Char> = tL2 tR2))) + (:: text;Eq<Text> = tL2 tR2))) (:: (d;Eq<Dict> i.=) = (get@ #dict recL) (get@ #dict recR)) )))) diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 414f19941..25002112a 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -3,50 +3,54 @@ (lux [io] (control monad pipe) - (data [char] - [text "Text/" Monoid<Text>] + (data [text "Text/" Monoid<Text>] text/format [ident] (format ["&" xml]) (coll [dict] [list])) - ["R" math/random "R/" Monad<Random>] + ["r" math/random "r/" Monad<Random>] test) ) -(def: (valid-xml-char? char) - (text;contains? (char;as-text char) - (format "_" - "abcdefghijklmnopqrstuvwxyz" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) +(def: char-range + Text + (format "_" + "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) + +(def: xml-char^ + (r;Random Nat) + (do r;Monad<Random> + [idx (|> r;nat (:: @ map (n.% (text;size char-range))))] + (wrap (assume (text;nth idx char-range))))) (def: (size^ bottom top) - (-> Nat Nat (R;Random Nat)) + (-> Nat Nat (r;Random Nat)) (let [constraint (|>. (n.% top) (n.max bottom))] - (R/map constraint R;nat))) + (r/map constraint r;nat))) (def: (xml-text^ bottom top) - (-> Nat Nat (R;Random Text)) - (do R;Monad<Random> + (-> Nat Nat (r;Random Text)) + (do r;Monad<Random> [size (size^ bottom top)] - (R;text' (R;filter valid-xml-char? R;char) - size))) + (r;text' xml-char^ size))) (def: xml-identifier^ - (R;Random Ident) - (R;seq (xml-text^ +0 +10) + (r;Random Ident) + (r;seq (xml-text^ +0 +10) (xml-text^ +1 +10))) (def: gen-xml - (R;Random &;XML) - (R;rec (function [gen-xml] - (R;alt (xml-text^ +1 +10) - (do R;Monad<Random> + (r;Random &;XML) + (r;rec (function [gen-xml] + (r;alt (xml-text^ +1 +10) + (do r;Monad<Random> [size (size^ +0 +2)] - ($_ R;seq + ($_ r;seq xml-identifier^ - (R;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) - (R;list size gen-xml))))))) + (r;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) + (r;list size gen-xml))))))) (context: "XML" [sample gen-xml diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index bf509ff53..7005fdaf4 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -4,37 +4,36 @@ (control monad pipe) (data ["&" text] - [char] text/format [number] (coll [list])) - ["R" math/random]) + ["r" math/random]) lux/test) (context: "Size" - [size (:: @ map (n.% +100) R;nat) - sample (R;text size)] + [size (:: @ map (n.% +100) r;nat) + sample (r;text size)] (test "" (or (and (n.= +0 size) (&;empty? sample)) (n.= size (&;size sample))))) (def: bounded-size - (R;Random Nat) - (|> R;nat - (:: R;Monad<Random> map (|>. (n.% +20) (n.+ +1))))) + (r;Random Nat) + (|> r;nat + (:: r;Monad<Random> map (|>. (n.% +20) (n.+ +1))))) (context: "Locations" [size bounded-size - idx (:: @ map (n.% size) R;nat) - sample (R;text size)] + idx (:: @ map (n.% size) r;nat) + sample (r;text size)] (test "" (|> sample (&;nth idx) (case> (^multi (#;Some char) - [(char;as-text char) char'] - [[(&;index-of' char' sample) - (&;last-index-of' char' sample) - (&;index-of char' idx sample) - (&;last-index-of char' idx sample)] + [(&;from-code char) char] + [[(&;index-of' char sample) + (&;last-index-of' char sample) + (&;index-of char idx sample) + (&;last-index-of char idx sample)] [(#;Some io) (#;Some lio) (#;Some io') (#;Some lio')]]) (and (n.<= idx io) @@ -43,7 +42,7 @@ (n.= idx io') (n.>= idx lio') - (&;contains? char' sample)) + (&;contains? char sample)) _ false @@ -53,8 +52,8 @@ (context: "Text functions" [sizeL bounded-size sizeR bounded-size - sampleL (R;text sizeL) - sampleR (R;text sizeR) + sampleL (r;text sizeL) + sampleR (r;text sizeR) #let [sample (&;concat (list sampleL sampleR)) fake-sample (&;join-with " " (list sampleL sampleR)) dup-sample (&;join-with "" (list sampleL sampleR)) @@ -97,12 +96,12 @@ #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> R;char (:: @ map (|>. char;code (n.% +128) (n.max +1) char;char)))] - sep1 (R;text' normal-char-gen +1) - sep2 (R;text' normal-char-gen +1) - #let [part-gen (|> (R;text' normal-char-gen sizeP) - (R;filter (. not (&;contains? sep1))))] - parts (R;list sizeL part-gen) + normal-char-gen (|> r;nat (:: @ map (|>. (n.% +128) (n.max +1))))] + sep1 (r;text' normal-char-gen +1) + sep2 (r;text' normal-char-gen +1) + #let [part-gen (|> (r;text' normal-char-gen sizeP) + (r;filter (. not (&;contains? sep1))))] + parts (r;list sizeL part-gen) #let [sample1 (&;concat (list;interpose sep1 parts)) sample2 (&;concat (list;interpose sep2 parts)) (^open "&/") &;Eq<Text>]] diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index afd788fa0..b852c6e56 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -14,7 +14,6 @@ (and (&/= "true" (%b true)) (&/= "123" (%i 123)) (&/= "123.456" (%r 123.456)) - (&/= "#\"t\"" (%c #"t")) (&/= "\"YOLO\"" (%t "YOLO")) (&/= "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))))) ))) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index 8752d4b96..3f9621d9c 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -94,9 +94,9 @@ (test "Can lex characters ranges." (and (should-passT "Y" (&;run "Y" - (&;range #"X" #"Z"))) + (&;range (char "X") (char "Z")))) (should-fail (&;run "M" - (&;range #"X" #"Z"))))) + (&;range (char "X") (char "Z")))))) (test "Can lex upper-case and &;lower-case letters." (and (should-passT "Y" (&;run "Y" diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index ce18c0539..b819b99bb 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -12,7 +12,7 @@ [macro] (macro [code] ["s" syntax #+ syntax:]) - ["R" math/random]) + ["r" math/random]) lux/test) ## [Utils] @@ -267,9 +267,9 @@ )) (context: "Pattern-matching" - [sample1 (R;text +3) - sample2 (R;text +3) - sample3 (R;text +4)] + [sample1 (r;text +3) + sample2 (r;text +3) + sample3 (r;text +4)] (case (format sample1 "-" sample2 "-" sample3) (&;^regex "(.{3})-(.{3})-(.{4})" [_ match1 match2 match3]) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index a90db336c..191d0f463 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -8,7 +8,7 @@ [product] [text "Text/" Eq<Text>]) ["&" host #+ jvm-import class: interface: object] - ["R" math/random]) + ["r" math/random]) lux/test) (jvm-import java.lang.Exception @@ -53,7 +53,7 @@ ([] foo [boolean String] void #throws [Exception])) (context: "Conversions" - [sample R;int] + [sample r;int] (with-expansions [<int-convs> (do-template [<to> <from> <message>] [(test <message> @@ -100,9 +100,9 @@ )) (context: "Arrays" - [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1)))) - idx (|> R;nat (:: @ map (n.% size))) - value R;int] + [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1)))) + idx (|> r;nat (:: @ map (n.% size))) + value r;int] ($_ seq (test "Can create arrays of some length." (n.= size (&;array-length (&;array Long size)))) diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index fd1d7415e..5e5d71d44 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -20,7 +20,6 @@ [(&;bool false) "false"] [(&;int 123) "123"] [(&;real 123.0) "123.0"] - [(&;char #"\n") "#\"\\n\""] [(&;text "\n") "\"\\n\""] [(&;tag ["yolo" "lol"]) "#yolo;lol"] [(&;symbol ["yolo" "lol"]) "yolo;lol"] diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index 512a7633b..e3c059ddd 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -6,9 +6,8 @@ (data text/format [bool] [number "i/" Number<Int>] - [char] [text]) - ["R" math/random] + ["r" math/random] [macro] (macro [poly #+ derived:] ["&" poly/eq])) @@ -25,29 +24,27 @@ #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]}) (def: gen-record - (R;Random Record) - (do R;Monad<Random> - [size (:: @ map (n.% +2) R;nat) - #let [gen-int (|> R;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] - ($_ R;seq + (r;Random Record) + (do r;Monad<Random> + [size (:: @ map (n.% +2) r;nat) + #let [gen-int (|> r;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] + ($_ r;seq (:: @ wrap []) - R;bool + r;bool gen-int - R;real - R;char - (R;text size) - (R;maybe gen-int) - (R;list size gen-int) - ($_ R;alt R;bool gen-int R;real) - ($_ R;seq gen-int R;real R;char) + r;real + (r;text size) + (r;maybe gen-int) + (r;list size gen-int) + ($_ r;alt r;bool gen-int r;real) + ($_ r;seq gen-int r;real (r;text size)) ))) (derived: (&;Eq<?> Record)) diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux index ae0765a60..34d0d1a82 100644 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ b/stdlib/test/test/lux/macro/poly/functor.lux @@ -7,9 +7,8 @@ (data text/format [bool] [number "i/" Number<Int>] - [char] [text]) - ["R" math/random] + ["r" math/random] [macro] (macro [poly #+ derived:] ["&" poly/functor])) diff --git a/stdlib/test/test/lux/macro/poly/text-encoder.lux b/stdlib/test/test/lux/macro/poly/text-encoder.lux index 240ad7ad4..a98b8801d 100644 --- a/stdlib/test/test/lux/macro/poly/text-encoder.lux +++ b/stdlib/test/test/lux/macro/poly/text-encoder.lux @@ -6,9 +6,8 @@ (data text/format [bool] [number "i/" Number<Int>] - [char] [text]) - ["R" math/random] + ["r" math/random] [macro] (macro [poly #+ derived:] ["&" poly/text-encoder])) @@ -25,29 +24,27 @@ #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]}) (def: gen-record - (R;Random Record) - (do R;Monad<Random> - [size (:: @ map (n.% +2) R;nat) - #let [gen-int (|> R;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] - ($_ R;seq + (r;Random Record) + (do r;Monad<Random> + [size (:: @ map (n.% +2) r;nat) + #let [gen-int (|> r;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] + ($_ r;seq (:: @ wrap []) - R;bool + r;bool gen-int - R;real - R;char - (R;text size) - (R;maybe gen-int) - (R;list size gen-int) - ($_ R;alt R;bool gen-int R;real) - ($_ R;seq gen-int R;real R;char) + r;real + (r;text size) + (r;maybe gen-int) + (r;list size gen-int) + ($_ r;alt r;bool gen-int r;real) + ($_ r;seq gen-int r;real (r;text size)) ))) (derived: (&;Codec<Text,?>::encode Record)) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index fa53e4596..ff8befbda 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -8,7 +8,6 @@ text/format [number] [bool] - [char] [ident] ["E" result]) ["R" math/random] @@ -76,7 +75,6 @@ ["Can parse Int syntax." 123 code;int number;Eq<Int> s;int] ["Can parse Deg syntax." .123 code;deg number;Eq<Deg> s;deg] ["Can parse Real syntax." 123.0 code;real number;Eq<Real> s;real] - ["Can parse Char syntax." #"\n" code;char char;Eq<Char> s;char] ["Can parse Text syntax." "\n" code;text text;Eq<Text> s;text] ["Can parse Symbol syntax." ["yolo" "lol"] code;symbol ident;Eq<Ident> s;symbol] ["Can parse Tag syntax." ["yolo" "lol"] code;tag ident;Eq<Ident> s;tag] diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 7fb6eafb7..7eff48e75 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -25,7 +25,6 @@ ["_;" parser]) (data ["_;" bit] ["_;" bool] - ["_;" char] ["_;" result] ["_;" ident] ["_;" identity] @@ -75,7 +74,8 @@ [trace] [store]) [macro] - (math [random])) + (math [random]) + (paradigm ["_;" concatenative])) ) ## [Program] |