diff options
65 files changed, 1821 insertions, 1950 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 2fd94069e..b3f5d2260 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -93,7 +93,6 @@ Otherwise check `define-lux-indent' and `put-lux-indent'." (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) (modify-syntax-entry ?\" "\"\"" table) - (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?# "w 124b" table) (modify-syntax-entry ?\n "> b" table) (modify-syntax-entry '(?a . ?z) "w" table) @@ -122,7 +121,7 @@ Otherwise check `define-lux-indent' and `put-lux-indent'." (modify-syntax-entry ?< "w" table) (modify-syntax-entry ?> "w" table) (modify-syntax-entry ?\; "w" table) - ;; (modify-syntax-entry ?\\ "w" table) + (modify-syntax-entry ?\\ "w" table) (modify-syntax-entry ?\s "-" table) (modify-syntax-entry ?\t "-" table) (modify-syntax-entry ?\r "-" table) @@ -227,7 +226,6 @@ Called by `imenu--generic-function'." (let ((bitRE (literal (special (altRE "0" "1")))) (natRE (literal natural)) (int&fracRE (literal (concat integer "\\(\\." natural "\\(\\(e\\|E\\)" integer "\\)?\\)?"))) - (frac-ratioRE (literal (concat integer "/" natural))) (revRE (literal (concat "\\." natural))) (tagRE (let ((separator "\\.")) (let ((in-prelude separator) @@ -315,8 +313,6 @@ Called by `imenu--generic-function'." (,natRE 0 font-lock-constant-face) ;; Int literals && Frac literals (,int&fracRE 0 font-lock-constant-face) - ;; Frac "ratio" literals - (,frac-ratioRE 0 font-lock-constant-face) ;; Rev literals (,revRE 0 font-lock-constant-face) ;; Tags diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 8c6bd9d88..fbdf05546 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -6,7 +6,7 @@ [type :as &type]) (lux.analyser [base :as &&]))) -(defn ^:private analyse-lux-is [analyse exo-type ?values] +(defn- analyse-lux-is [analyse exo-type ?values] (&type/with-var (fn [$var] (|do [:let [(&/$Cons left (&/$Cons right (&/$Nil))) ?values] @@ -17,7 +17,7 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["lux" "is"]) (&/|list =left =right) (&/|list))))))))) -(defn ^:private analyse-lux-try [analyse exo-type ?values] +(defn- analyse-lux-try [analyse exo-type ?values] (&type/with-var (fn [$var] (|do [:let [(&/$Cons op (&/$Nil)) ?values] @@ -30,7 +30,7 @@ (&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list))))))))) (do-template [<name> <proc> <input-type> <output-type>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] =x (&&/analyse-1 analyse <input-type> x) =y (&&/analyse-1 analyse <input-type> y) @@ -39,13 +39,13 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list))))))) - ^:private analyse-text-eq ["text" "="] &type/Text &type/Bit - ^:private analyse-text-lt ["text" "<"] &type/Text &type/Bit - ^:private analyse-text-concat ["text" "concat"] &type/Text &type/Text + analyse-text-eq ["text" "="] &type/Text &type/Bit + analyse-text-lt ["text" "<"] &type/Text &type/Bit + analyse-text-concat ["text" "concat"] &type/Text &type/Text ) (do-template [<name> <proc-name> <output-type>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Cons part (&/$Cons start (&/$Nil)))) ?values] =text (&&/analyse-1 analyse &type/Text text) =part (&&/analyse-1 analyse &type/Text part) @@ -57,15 +57,15 @@ (&/|list =text =part =start) (&/|list))))))) - ^:private analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe) + analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe) ) -(defn ^:private analyse-text-clip [analyse exo-type ?values] +(defn- analyse-text-clip [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Cons from (&/$Cons to (&/$Nil)))) ?values] =text (&&/analyse-1 analyse &type/Text text) =from (&&/analyse-1 analyse &type/Nat from) =to (&&/analyse-1 analyse &type/Nat to) - _ (&type/check exo-type (&/$Apply &type/Text &type/Maybe)) + _ (&type/check exo-type &type/Text) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "clip"]) @@ -73,7 +73,7 @@ (&/|list))))))) (do-template [<name> <proc>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Nil)) ?values] =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) @@ -83,14 +83,14 @@ (&/|list =text) (&/|list))))))) - ^:private analyse-text-size "size" + analyse-text-size "size" ) -(defn ^:private analyse-text-char [analyse exo-type ?values] +(defn- analyse-text-char [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values] =text (&&/analyse-1 analyse &type/Text text) =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type (&/$Apply &type/Nat &type/Maybe)) + _ (&type/check exo-type &type/Nat) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "char"]) @@ -100,7 +100,7 @@ (do-template [<name> <op>] (let [inputT (&/$Apply &type/Any &type/I64) outputT &type/I64] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons mask (&/$Cons input (&/$Nil))) ?values] =mask (&&/analyse-1 analyse inputT mask) =input (&&/analyse-1 analyse inputT input) @@ -109,15 +109,15 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["i64" <op>]) (&/|list =input =mask) (&/|list)))))))) - ^:private analyse-i64-and "and" - ^:private analyse-i64-or "or" - ^:private analyse-i64-xor "xor" + analyse-i64-and "and" + analyse-i64-or "or" + analyse-i64-xor "xor" ) (do-template [<name> <op>] (let [inputT (&/$Apply &type/Any &type/I64) outputT &type/I64] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons shift (&/$Cons input (&/$Nil))) ?values] =shift (&&/analyse-1 analyse &type/Nat shift) =input (&&/analyse-1 analyse inputT input) @@ -126,15 +126,15 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["i64" <op>]) (&/|list =input =shift) (&/|list)))))))) - ^:private analyse-i64-left-shift "left-shift" - ^:private analyse-i64-arithmetic-right-shift "arithmetic-right-shift" - ^:private analyse-i64-logical-right-shift "logical-right-shift" + analyse-i64-left-shift "left-shift" + analyse-i64-arithmetic-right-shift "arithmetic-right-shift" + analyse-i64-logical-right-shift "logical-right-shift" ) (do-template [<name> <proc> <input-type> <output-type>] (let [inputT <input-type> outputT <output-type>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons subjectC (&/$Cons paramC (&/$Nil))) ?values] subjectA (&&/analyse-1 analyse <input-type> subjectC) paramA (&&/analyse-1 analyse <input-type> paramC) @@ -143,15 +143,15 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <proc>) (&/|list subjectA paramA) (&/|list)))))))) - ^:private analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit - ^:private analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64 - ^:private analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64 + analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit + analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64 + analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64 ) (do-template [<name> <proc> <input-type> <output-type>] (let [inputT <input-type> outputT <output-type>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] =x (&&/analyse-1 analyse <input-type> x) =y (&&/analyse-1 analyse <input-type> y) @@ -160,22 +160,22 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list)))))))) - ^:private analyse-int-mul ["int" "*"] &type/Int &type/Int - ^:private analyse-int-div ["int" "/"] &type/Int &type/Int - ^:private analyse-int-rem ["int" "%"] &type/Int &type/Int - ^:private analyse-int-lt ["int" "<"] &type/Int &type/Bit - - ^:private analyse-frac-add ["frac" "+"] &type/Frac &type/Frac - ^:private analyse-frac-sub ["frac" "-"] &type/Frac &type/Frac - ^:private analyse-frac-mul ["frac" "*"] &type/Frac &type/Frac - ^:private analyse-frac-div ["frac" "/"] &type/Frac &type/Frac - ^:private analyse-frac-rem ["frac" "%"] &type/Frac &type/Frac - ^:private analyse-frac-eq ["frac" "="] &type/Frac &type/Bit - ^:private analyse-frac-lt ["frac" "<"] &type/Frac &type/Bit + analyse-int-mul ["int" "*"] &type/Int &type/Int + analyse-int-div ["int" "/"] &type/Int &type/Int + analyse-int-rem ["int" "%"] &type/Int &type/Int + analyse-int-lt ["int" "<"] &type/Int &type/Bit + + analyse-frac-add ["frac" "+"] &type/Frac &type/Frac + analyse-frac-sub ["frac" "-"] &type/Frac &type/Frac + analyse-frac-mul ["frac" "*"] &type/Frac &type/Frac + analyse-frac-div ["frac" "/"] &type/Frac &type/Frac + analyse-frac-rem ["frac" "%"] &type/Frac &type/Frac + analyse-frac-eq ["frac" "="] &type/Frac &type/Bit + analyse-frac-lt ["frac" "<"] &type/Frac &type/Bit ) (do-template [<encode> <encode-op> <decode> <decode-op> <type>] - (do (defn <encode> [analyse exo-type ?values] + (do (defn- <encode> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse <type> x) _ (&type/check exo-type &type/Text) @@ -184,7 +184,7 @@ (&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list))))))) (let [decode-type (&/$Apply <type> &type/Maybe)] - (defn <decode> [analyse exo-type ?values] + (defn- <decode> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse &type/Text x) _ (&type/check exo-type decode-type) @@ -192,24 +192,24 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list))))))))) - ^:private analyse-frac-encode ["frac" "encode"] ^:private analyse-frac-decode ["frac" "decode"] &type/Frac + analyse-frac-encode ["frac" "encode"] analyse-frac-decode ["frac" "decode"] &type/Frac ) (do-template [<name> <type> <op>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type <type>) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <op>) (&/|list) (&/|list))))))) - ^:private analyse-frac-smallest &type/Frac ["frac" "smallest"] - ^:private analyse-frac-min &type/Frac ["frac" "min"] - ^:private analyse-frac-max &type/Frac ["frac" "max"] + analyse-frac-smallest &type/Frac ["frac" "smallest"] + analyse-frac-min &type/Frac ["frac" "min"] + analyse-frac-max &type/Frac ["frac" "max"] ) (do-template [<name> <from-type> <to-type> <op>] - (defn <name> [analyse exo-type ?values] + (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse <from-type> x) _ (&type/check exo-type <to-type>) @@ -217,22 +217,44 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <op>) (&/|list =x) (&/|list))))))) - ^:private analyse-int-char &type/Int &type/Text ["int" "char"] - ^:private analyse-int-frac &type/Int &type/Frac ["int" "frac"] - ^:private analyse-frac-int &type/Frac &type/Int ["frac" "int"] + analyse-int-char &type/Int &type/Text ["int" "char"] + analyse-int-frac &type/Int &type/Frac ["int" "frac"] + analyse-frac-int &type/Frac &type/Int ["frac" "int"] - ^:private analyse-io-log &type/Text &type/Any ["io" "log"] - ^:private analyse-io-error &type/Text &type/Nothing ["io" "error"] - ^:private analyse-io-exit &type/Int &type/Nothing ["io" "exit"] + analyse-io-log &type/Text &type/Any ["io" "log"] + analyse-io-error &type/Text &type/Nothing ["io" "error"] + analyse-io-exit &type/Int &type/Nothing ["io" "exit"] ) -(defn ^:private analyse-io-current-time [analyse exo-type ?values] +(defn- analyse-io-current-time [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type &type/Int) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["io" "current-time"]) (&/|list) (&/|list))))))) +(defn- analyse-syntax-char-case! [analyse exo-type ?values] + (|do [:let [(&/$Cons ?input (&/$Cons [_ (&/$Tuple ?pairs)] (&/$Cons ?else (&/$Nil)))) ?values] + _cursor &/cursor + =input (&&/analyse-1 analyse &type/Nat ?input) + _ (assert! (even? (&/|length ?pairs)) "The number of matches must be even!") + =pairs (&/map% (fn [?pair] + (|let [[[_ (&/$Tuple ?patterns)] ?match] ?pair] + (|do [=match (&&/analyse-1 analyse exo-type ?match)] + (return (&/T [(&/|map (fn [?pattern] + (|let [[_ (&/$Text ^String ?pattern-char)] ?pattern] + (int (.charAt ?pattern-char 0)))) + ?patterns) + =match]))))) + (&/|as-pairs ?pairs)) + =else (&&/analyse-1 analyse exo-type ?else)] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["lux" "syntax char case!"]) + (&/|list =input + (&&/|meta exo-type _cursor (&&/$tuple (&/|map &/|second =pairs))) + =else) + (&/|map &/|first =pairs))))))) + (defn analyse-proc [analyse exo-type proc ?values] (try (case proc "lux is" (analyse-lux-is analyse exo-type ?values) @@ -281,6 +303,10 @@ "lux frac min" (analyse-frac-min analyse exo-type ?values) "lux frac max" (analyse-frac-max analyse exo-type ?values) "lux frac int" (analyse-frac-int analyse exo-type ?values) + + ;; Special extensions for performance reasons + ;; Will be replaced by custom extensions in the future. + "lux syntax char case!" (analyse-syntax-char-case! analyse exo-type ?values) ;; else (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " proc))) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 36f23263d..5cff63d86 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -263,7 +263,7 @@ &&/unwrap-long (.visitInsn Opcodes/L2I))] :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;"))]] + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;"))]] (return nil))) (defn ^:private compile-text-index [compile ?values special-args] @@ -322,7 +322,9 @@ :let [_ (doto *writer* &&/unwrap-long (.visitInsn Opcodes/L2I) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;"))]] + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") + (.visitInsn Opcodes/I2L) + &&/wrap-long)]] (return nil))) (defn ^:private compile-io-log [compile ?values special-args] @@ -369,12 +371,53 @@ &&/wrap-long)]] (return nil))) +(defn ^:private compile-syntax-char-case! [compile ?values ?patterns] + (|do [:let [(&/$Cons ?input (&/$Cons [_ (&a/$tuple ?matches)] (&/$Cons ?else (&/$Nil)))) ?values] + ^MethodVisitor *writer* &/get-writer + :let [pattern-labels (&/|map (fn [_] (new Label)) ?patterns) + matched-patterns (->> (&/zip2 ?patterns pattern-labels) + (&/flat-map (fn [?chars+?label] + (|let [[?chars ?label] ?chars+?label] + (&/|map (fn [?char] + (&/T [?char ?label])) + ?chars)))) + &/->seq + (sort-by &/|first <) + &/->list) + end-label (new Label) + else-label (new Label)] + _ (compile ?input) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I) + (.visitLookupSwitchInsn else-label + (int-array (&/->seq (&/|map &/|first matched-patterns))) + (into-array (&/->seq (&/|map &/|second matched-patterns)))))] + _ (&/map% (fn [?label+?match] + (|let [[?label ?match] ?label+?match] + (|do [:let [_ (doto *writer* + (.visitLabel ?label))] + _ (compile ?match) + :let [_ (doto *writer* + (.visitJumpInsn Opcodes/GOTO end-label))]] + (return nil)))) + (&/zip2 pattern-labels ?matches)) + :let [_ (doto *writer* + (.visitLabel else-label))] + _ (compile ?else) + :let [_ (doto *writer* + (.visitLabel end-label))]] + (return nil))) + (defn compile-proc [compile category proc ?values special-args] (case category "lux" (case proc "is" (compile-lux-is compile ?values special-args) - "try" (compile-lux-try compile ?values special-args)) + "try" (compile-lux-try compile ?values special-args) + ;; Special extensions for performance reasons + ;; Will be replaced by custom extensions in the future. + "syntax char case!" (compile-syntax-char-case! compile ?values special-args)) "io" (case proc diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 6b9aeb680..948f08805 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -339,52 +339,6 @@ (.visitEnd))] nil)) -(defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] - (do (let [$from (new Label) - $to (new Label) - $handler (new Label) - $end (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;" nil nil) - (.visitCode) - (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") - (.visitLabel $from) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitVarInsn Opcodes/ILOAD 2) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") - (.visitLabel $end) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd))) - (let [$from (new Label) - $to (new Label) - $handler (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;" nil nil) - (.visitCode) - (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") - (.visitLabel $from) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "codePointAt" "(I)I") - (.visitInsn Opcodes/I2L) - &&/wrap-long - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd))) - nil)) - (def compile-LuxRT-class (|do [_ (return nil) :let [full-name &&/lux-utils-class @@ -489,7 +443,6 @@ (compile-LuxRT-pm-methods) (compile-LuxRT-adt-methods) (compile-LuxRT-int-methods) - (compile-LuxRT-frac-methods) - (compile-LuxRT-text-methods))]] + (compile-LuxRT-frac-methods))]] (&&/save-class! (second (string/split &&/lux-utils-class #"/")) (.toByteArray (doto =class .visitEnd))))) diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index f74e14dfd..8ed75b940 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -26,76 +26,12 @@ ) ;; [Utils] -(defn ^:private clean-line [^String raw-line] - "(-> Text Text)" - (let [line-length (.length raw-line) - buffer (new StringBuffer line-length)] - (loop [idx 0] - (if (< idx line-length) - (let [current-char (.charAt raw-line idx)] - (if (= \\ current-char) - (do (assert (< (+ 1 idx) line-length) (str "[Lexer Error] Text is too short for escaping: " raw-line " " idx)) - (case (.charAt raw-line (+ 1 idx)) - \t (do (.append buffer "\t") - (recur (+ 2 idx))) - \v (do (.append buffer "\u000B") - (recur (+ 2 idx))) - \b (do (.append buffer "\b") - (recur (+ 2 idx))) - \n (do (.append buffer "\n") - (recur (+ 2 idx))) - \r (do (.append buffer "\r") - (recur (+ 2 idx))) - \f (do (.append buffer "\f") - (recur (+ 2 idx))) - \" (do (.append buffer "\"") - (recur (+ 2 idx))) - \\ (do (.append buffer "\\") - (recur (+ 2 idx))) - \u (do (assert (< (+ 5 idx) line-length) (str "[Lexer Error] Text is too short for unicode-escaping: " raw-line " " idx)) - (.append buffer (char (Integer/valueOf (.substring raw-line (+ 2 idx) (+ 6 idx)) 16))) - (recur (+ 6 idx))) - ;; else - (assert false (str "[Lexer Error] Invalid escaping syntax: " raw-line " " idx)))) - (do (.append buffer current-char) - (recur (+ 1 idx))))) - (.toString buffer))))) - -(defn ^:private lex-text-body [multi-line? offset] - (|do [[_ eol? ^String pre-quotes**] (&reader/read-regex #"^([^\"]*)") - ^String pre-quotes* (if multi-line? - (|do [:let [empty-line? (and eol? (= "" pre-quotes**))] - _ (&/assert! (or empty-line? - (>= (.length pre-quotes**) offset)) - "Each line of a multi-line text must have an appropriate offset!")] - (return (if empty-line? - "\n" - (str "\n" (.substring pre-quotes** offset))))) - (return pre-quotes**)) - [pre-quotes post-quotes] (if (.endsWith pre-quotes* "\\") - (if eol? - (&/fail-with-loc "[Lexer Error] Cannot leave dangling back-slash \\") - (if (if-let [^String back-slashes (re-find #"\\+$" pre-quotes*)] - (odd? (.length back-slashes))) - (|do [[_ eol?* _] (&reader/read-regex #"^([\"])") - next-part (lex-text-body eol?* offset)] - (return (&/T [(.substring pre-quotes* 0 (dec (.length pre-quotes*))) - (str "\"" next-part)]))) - (|do [post-quotes* (lex-text-body false offset)] - (return (&/T [pre-quotes* post-quotes*]))))) - (if eol? - (|do [next-part (lex-text-body true offset)] - (return (&/T [pre-quotes* - next-part]))) - (return (&/T [pre-quotes* ""]))))] - (return (str (clean-line pre-quotes) post-quotes)))) - (def lex-text (|do [[meta _ _] (&reader/read-text "\"") :let [[_ _ _column] meta] - token (lex-text-body false (inc _column)) + [_ _ ^String content] (&reader/read-regex #"^([^\"]*)") _ (&reader/read-text "\"")] - (return (&/T [meta ($Text token)])))) + (return (&/T [meta ($Text content)])))) (def +ident-re+ #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") @@ -105,26 +41,11 @@ (|do [[meta _ white-space] (&reader/read-regex #"^(\s+|$)")] (return (&/T [meta ($White_Space white-space)])))) -(def ^:private lex-single-line-comment +(def ^:private lex-comment (|do [_ (&reader/read-text "##") [meta _ comment] (&reader/read-regex #"^(.*)$")] (return (&/T [meta ($Comment comment)])))) -(defn ^:private lex-multi-line-comment [_] - (|do [_ (&reader/read-text "#(") - [meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex+ #"(?is)^(?!#\()((?!\)#).)*")] - (return (&/T [meta comment]))) - (|do [[meta pre] (&reader/read-regex+ #"(?is)^((?!#\().)*") - [_ ($Comment inner)] (lex-multi-line-comment nil) - [_ post] (&reader/read-regex+ #"(?is)^((?!\)#).)*")] - (return (&/T [meta (str pre "#(" inner ")#" post)]))))) - _ (&reader/read-text ")#")] - (return (&/T [meta ($Comment comment)])))) - -(def ^:private lex-comment - (&/try-all% (&/|list lex-single-line-comment - (lex-multi-line-comment nil)))) - (do-template [<name> <tag> <regex>] (def <name> (|do [[meta _ token] (&reader/read-regex <regex>)] diff --git a/luxc/src/lux/reader.clj b/luxc/src/lux/reader.clj index 5f4aa8afe..14914cc2e 100644 --- a/luxc/src/lux/reader.clj +++ b/luxc/src/lux/reader.clj @@ -11,7 +11,7 @@ ("Yes" 2)) ;; [Utils] -(defn ^:private with-line [body] +(defn- with-line [body] (fn [state] (|case (&/get$ &/$source state) (&/$Nil) @@ -32,7 +32,7 @@ output)) ))) -(defn ^:private with-lines [body] +(defn- with-lines [body] (fn [state] (|case (body (&/get$ &/$source state)) (&/$Right reader* match) @@ -43,7 +43,7 @@ ((&/fail-with-loc msg) state) ))) -(defn ^:private re-find! [^java.util.regex.Pattern regex column ^String line] +(defn- re-find! [^java.util.regex.Pattern regex column ^String line] (let [matcher (doto (.matcher regex line) (.region column (.length line)) (.useAnchoringBounds true))] @@ -63,8 +63,9 @@ (&/T [(&/T [file-name line-num column-num*]) line])))) ($No (str "[Reader Error] Pattern failed: " regex)))))) -(defn read-regex? [regex] +(defn read-regex? "(-> Regex (Reader (Maybe Text)))" + [regex] (with-line (fn [file-name line-num column-num ^String line] (if-let [^String match (re-find! regex column-num line)] @@ -101,8 +102,9 @@ (&/T [(&/T [file-name line-num column-num]) prefix*])])))) (&/$Left (str "[Reader Error] Pattern failed: " regex)))))))) -(defn read-text [^String text] +(defn read-text "(-> Text (Reader Text))" + [^String text] (with-line (fn [file-name line-num column-num ^String line] (if (.startsWith line text column-num) @@ -114,8 +116,9 @@ (&/T [(&/T [file-name line-num column-num*]) line])))) ($No (str "[Reader Error] Text failed: " text)))))) -(defn read-text? [^String text] +(defn read-text? "(-> Text (Reader (Maybe Text)))" + [^String text] (with-line (fn [file-name line-num column-num ^String line] (if (.startsWith line text column-num) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 1b784ee76..e45a6f8cf 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -223,7 +223,7 @@ paramI <pre-param> <op> <post>))] - [text::= id id + [text::= (<|) (<|) (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) (_.wrap #$.Boolean)] [text::< ..check-stringI ..check-stringI @@ -231,10 +231,10 @@ (predicateI _.IFLT)] [text::concat ..check-stringI ..check-stringI (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0) - id] + (<|)] [text::char ..check-stringI jvm-intI - (_.INVOKESTATIC ///.runtime-class "text_char" (_t.method (list $String _t.int) (#.Some ///.$Variant) (list)) #0) - id] + (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0) + lux-intI] ) (do-template [<name> <pre-subject> <pre-param> <pre-extra> <op>] @@ -246,8 +246,7 @@ <op>))] [text::clip ..check-stringI jvm-intI jvm-intI - (_.INVOKESTATIC ///.runtime-class "text_clip" - (_t.method (list $String _t.int _t.int) (#.Some ///.$Variant) (list)) #0)] + (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)] ) (def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 20c31bd5d..05641fe22 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -129,25 +129,6 @@ (_.wrap #$.Double)))) )) -(def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list))) - -(def: text-methods - Def - (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) - (try-methodI - (|>> (_.ALOAD 0) - (_.ILOAD 1) - (_.ILOAD 2) - (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) - ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) - (try-methodI - (|>> (_.ALOAD 0) - (_.ILOAD 1) - (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) - _.I2L - (_.wrap #$.Long)))) - )) - (def: pm-methods Def (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) @@ -326,7 +307,6 @@ (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list) (|>> adt-methods frac-methods - text-methods pm-methods io-methods))] (do phase.Monad<Operation> diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index bf92eb4db..916b77797 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,8 +1,17 @@ +("lux def" double-quote + ("lux int char" +34) + [["" 0 0] (10 (0))]) + +("lux def" new-line + ("lux int char" +10) + [["" 0 0] (10 (0))]) + +("lux def" __paragraph + ("lux text concat" new-line new-line) + [["" 0 0] (10 (0))]) + ("lux def" dummy-cursor - ("lux check" (2 (0 "#Text" (0)) - (2 (0 "#I64" (1 (0 "#Nat" (0)) (0))) - (0 "#I64" (1 (0 "#Nat" (0)) (0))))) - ["" 0 0]) + ["" 0 0] [["" 0 0] (10 (1 [[["" 0 0] (7 ["lux" "export?"])] [["" 0 0] (0 #1)]] @@ -19,9 +28,9 @@ (1 [[dummy-cursor (7 ["lux" "export?"])] [dummy-cursor (0 #1)]] (1 [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (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.")]] + [dummy-cursor (5 ("lux text concat" + ("lux text concat" "The type of things whose type is irrelevant." __paragraph) + "It can be used to write functions or data-structures that can take, or return, anything."))]] (0)))))]) ## (type: Nothing @@ -35,9 +44,9 @@ (1 [[dummy-cursor (7 ["lux" "export?"])] [dummy-cursor (0 #1)]] (1 [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "The type of things whose type is unknown or undefined. - - Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] + [dummy-cursor (5 ("lux text concat" + ("lux text concat" "The type of things whose type is undefined." __paragraph) + "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] (0)))))]) ## (type: (List a) @@ -98,9 +107,9 @@ (#Cons [[dummy-cursor (7 ["lux" "export?"])] [dummy-cursor (0 #1)]] (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Natural numbers (unsigned integers). - - They start at zero (0) and extend in the positive direction.")]] + [dummy-cursor (5 ("lux text concat" + ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) + "They start at zero (0) and extend in the positive direction."))]] #Nil))))]) ("lux def" Int @@ -124,9 +133,9 @@ (#Cons [[dummy-cursor (7 ["lux" "export?"])] [dummy-cursor (0 #1)]] (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Fractional numbers that live in the interval [0,1). - - Useful for probability, and other domains that work within that interval.")]] + [dummy-cursor (5 ("lux text concat" + ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) + "Useful for probability, and other domains that work within that interval."))]] #Nil))))]) ("lux def" Frac @@ -162,9 +171,7 @@ (#Cons [[dummy-cursor (7 ["lux" "export?"])] [dummy-cursor (0 #1)]] (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "A name. - - It is used as part of Lux syntax to represent identifiers and tags.")]] + [dummy-cursor (5 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] #Nil))))]) ## (type: (Maybe a) @@ -747,11 +754,11 @@ (#Cons (text$ "host") #Nil)))))))))))))] (#Cons [(tag$ ["lux" "doc"]) - (text$ "Represents the state of the Lux compiler during a run. - - It is provided to macros during their invocation, so they can access compiler data. - - Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")] + (text$ ("lux text concat" + ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph) + ("lux text concat" + ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) + "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] default-def-meta-exported)))) ## (type: (Meta a) @@ -763,9 +770,9 @@ (#Apply (#Product Lux (#Parameter 1)) (#Apply Text Either))))) (record$ (#Cons [(tag$ ["lux" "doc"]) - (text$ "Computations that can have access to the state of the compiler. - - These computations may fail, or modify the state of the compiler.")] + (text$ ("lux text concat" + ("lux text concat" "Computations that can have access to the state of the compiler." __paragraph) + "These computations may fail, or modify the state of the compiler."))] (#Cons [(tag$ ["lux" "type-args"]) (tuple$ (#Cons (text$ "a") #Nil))] default-def-meta-exported)))) @@ -1027,9 +1034,11 @@ (macro:' #export (comment tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Throws away any code given to it. - ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. - (comment +1 +2 +3 +4)")] + (text$ ("lux text concat" + ("lux text concat" "## Throws away any code given to it." __paragraph) + ("lux text concat" + ("lux text concat" "## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor." __paragraph) + "(comment +1 +2 +3 +4)")))] #Nil) (return #Nil)) @@ -1219,14 +1228,13 @@ (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Universal quantification. - (All [a] - (-> a a)) - - ## A name can be provided, to specify a recursive type. - (All List [a] - (| Any - [a (List a)]))")] + (text$ ("lux text concat" + ("lux text concat" "## Universal quantification." __paragraph) + ("lux text concat" + ("lux text concat" "(All [a] (-> a a))" __paragraph) + ("lux text concat" + ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) + "(All List [a] (| Any [a (List a)]))"))))] #Nil) (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) [self-name tokens] @@ -1264,16 +1272,13 @@ (macro:' #export (Ex tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Existential quantification. - (Ex [a] - [(Codec Text a) - a]) - - ## A name can be provided, to specify a recursive type. - (Ex Self [a] - [(Codec Text a) - a - (List (Self a))])")] + (text$ ("lux text concat" + ("lux text concat" "## Existential quantification." __paragraph) + ("lux text concat" + ("lux text concat" "(Ex [a] [(Codec Text a) a])" __paragraph) + ("lux text concat" + ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) + "(Ex Self [a] [(Codec Text a) a (List (Self a))])"))))] #Nil) (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) [self-name tokens] @@ -1319,10 +1324,11 @@ (macro:' #export (-> tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Function types: - (-> Int Int Int) - - ## This is the type of a function that takes 2 Ints and returns an Int.")] + (text$ ("lux text concat" + ("lux text concat" "## Function types:" __paragraph) + ("lux text concat" + ("lux text concat" "(-> Int Int Int)" __paragraph) + "## This is the type of a function that takes 2 Ints and returns an Int.")))] #Nil) ({(#Cons output inputs) (return (#Cons (list/fold ("lux check" (#Function Code (#Function Code Code)) @@ -1337,8 +1343,9 @@ (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## List-construction macro. - (list +1 +2 +3)")] + (text$ ("lux text concat" + ("lux text concat" "## List-construction macro." __paragraph) + "(list +1 +2 +3)"))] #Nil) (return (#Cons (list/fold (function'' [head tail] (form$ (#Cons (tag$ ["lux" "Cons"]) @@ -1350,9 +1357,11 @@ (macro:' #export (list& xs) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## List-construction macro, with the last element being a tail-list. - ## In other words, this macro prepends elements to another list. - (list& +1 +2 +3 (list +4 +5 +6))")] + (text$ ("lux text concat" + ("lux text concat" "## List-construction macro, with the last element being a tail-list." __paragraph) + ("lux text concat" + ("lux text concat" "## In other words, this macro prepends elements to another list." __paragraph) + "(list& +1 +2 +3 (list +4 +5 +6))")))] #Nil) ({(#Cons last init) (return (list (list/fold (function'' [head tail] @@ -1367,11 +1376,13 @@ (macro:' #export (& tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Tuple types: - (& Text Int Bit) - - ## Any. - (&)")] + (text$ ("lux text concat" + ("lux text concat" "## Tuple types:" __paragraph) + ("lux text concat" + ("lux text concat" "(& Text Int Bit)" __paragraph) + ("lux text concat" + ("lux text concat" "## Any." __paragraph) + "(&)"))))] #Nil) ({#Nil (return (list (identifier$ ["lux" "Any"]))) @@ -1384,11 +1395,13 @@ (macro:' #export (| tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Variant types: - (| Text Int Bit) - - ## Nothing. - (|)")] + (text$ ("lux text concat" + ("lux text concat" "## Variant types:" __paragraph) + ("lux text concat" + ("lux text concat" "(| Text Int Bit)" __paragraph) + ("lux text concat" + ("lux text concat" "## Nothing." __paragraph) + "(|)"))))] #Nil) ({#Nil (return (list (identifier$ ["lux" "Nothing"]))) @@ -1563,11 +1576,13 @@ (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Left-association for the application of binary functions over variadic arguments. - (_$ text/compose \"Hello, \" name \".\\nHow are you?\") - - ## => - (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] + (text$ ("lux text concat" + ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new-line) + ("lux text concat" + ("lux text concat" "(_$ text/compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" + ("lux text concat" "## =>" ..new-line) + "(text/compose (text/compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') ({(#Cons first nexts) @@ -1583,11 +1598,13 @@ (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Right-association for the application of binary functions over variadic arguments. - ($_ text/compose \"Hello, \" name \".\\nHow are you?\") - - ## => - (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] + (text$ ("lux text concat" + ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new-line) + ("lux text concat" + ("lux text concat" "($_ text/compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" + ("lux text concat" "## =>" ..new-line) + "(text/compose ''Hello, '' (text/compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') ({(#Cons last prevs) @@ -1715,13 +1732,10 @@ (macro:' #export (if tokens) (list [(tag$ ["lux" "doc"]) - (text$ "Picks which expression to evaluate based on a bit test value. - - (if #1 - \"Oh, yeah!\" - \"Aw hell naw!\") - - => \"Oh, yeah!\"")]) + (text$ ($_ "lux text concat" + "Picks which expression to evaluate based on a bit test value." __paragraph + "(if #1 ''Oh, yeah!'' ''Aw hell naw!'')" __paragraph + "=> ''Oh, yeah!''"))]) ({(#Cons test (#Cons then (#Cons else #Nil))) (return (list (form$ (list (record$ (list [(bit$ #1) then] [(bit$ #0) else])) @@ -1759,9 +1773,9 @@ (def:''' #export (log! message) (list [(tag$ ["lux" "doc"]) - (text$ "Logs message to standard output. - - Useful for debugging.")]) + (text$ ($_ "lux text concat" + "Logs message to standard output." __paragraph + "Useful for debugging."))]) (-> Text Any) ("lux io log" message)) @@ -1966,10 +1980,10 @@ (macro:' #export (primitive tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Macro to treat define new primitive types. - (primitive \"java.lang.Object\") - - (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")]) + (text$ ($_ "lux text concat" + "## Macro to treat define new primitive types." __paragraph + "(primitive ''java.lang.Object'')" __paragraph + "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) ({(#Cons [_ (#Text class-name)] #Nil) (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) @@ -1997,11 +2011,10 @@ (macro:' #export (` tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms. - ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. - (` (def: (~ name) - (function ((~' _) (~+ args)) - (~ body))))")]) + (text$ ($_ "lux text concat" + "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph + "## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." __paragraph + "(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) (do Monad<Meta> [current-module current-module-name @@ -2016,10 +2029,9 @@ (macro:' #export (`' tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms. - (`' (def: (~ name) - (function (_ (~+ args)) - (~ body))))")]) + (text$ ($_ "lux text concat" + "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph + "(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) (do Monad<Meta> [=template (untemplate #1 "" template)] @@ -2031,8 +2043,9 @@ (macro:' #export (' tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Quotation as a macro. - (' \"YOLO\")")]) + (text$ ($_ "lux text concat" + "## Quotation as a macro." __paragraph + "(' YOLO)"))]) ({(#Cons template #Nil) (do Monad<Meta> [=template (untemplate #0 "" template)] @@ -2044,13 +2057,11 @@ (macro:' #export (|> tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Piping macro. - (|> elems (list/map int/encode) (interpose \" \") (fold text/compose \"\")) - - ## => - (fold text/compose \"\" - (interpose \" \" - (list/map int/encode elems)))")]) + (text$ ($_ "lux text concat" + "## Piping macro." __paragraph + "(|> elems (list/map int/encode) (interpose '' '') (fold text/compose ''''))" __paragraph + "## =>" __paragraph + "(fold text/compose '''' (interpose '' '' (list/map int/encode elems)))"))]) ({(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) (function' [app acc] @@ -2072,13 +2083,11 @@ (macro:' #export (<| tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Reverse piping macro. - (<| (fold text/compose \"\") (interpose \" \") (list/map int/encode) elems) - - ## => - (fold text/compose \"\" - (interpose \" \" - (list/map int/encode elems)))")]) + (text$ ($_ "lux text concat" + "## Reverse piping macro." __paragraph + "(<| (fold text/compose '''') (interpose '' '') (list/map int/encode) elems)" __paragraph + "## =>" __paragraph + "(fold text/compose '''' (interpose '' '' (list/map int/encode elems)))"))]) ({(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) (function' [app acc] @@ -2249,14 +2258,12 @@ (macro:' #export (do-template tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. - (do-template [<name> <diff>] - [(def: #export <name> - (-> Int Int) - (i/+ <diff>))] - - [inc +1] - [dec -1])")]) + (text$ ($_ "lux text concat" + "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." __paragraph + "(do-template [<name> <diff>]" ..new-line + " " "[(def: #export <name> (-> Int Int) (i/+ <diff>))]" __paragraph + " " "[inc +1]" ..new-line + " " "[dec -1]"))]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux check" (-> RepEnv ($' List Code)) @@ -2602,11 +2609,10 @@ (def:''' #export (not x) (list [(tag$ ["lux" "doc"]) - (text$ "## Bit negation. - - (not #1) => #0 - - (not #0) => #1")]) + (text$ ($_ "lux text concat" + "## Bit negation." __paragraph + "(not #1) => #0" __paragraph + "(not #0) => #1"))]) (-> Bit Bit) (if x #0 #1)) @@ -2815,8 +2821,9 @@ (macro:' #export (type tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Takes a type expression and returns it's representation as data-structure. - (type (All [a] (Maybe (List a))))")]) + (text$ ($_ "lux text concat" + "## Takes a type expression and returns it's representation as data-structure." __paragraph + "(type (All [a] (Maybe (List a))))"))]) ({(#Cons type #Nil) (do Monad<Meta> [type+ (macro-expand-all type)] @@ -2833,8 +2840,9 @@ (macro:' #export (: tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## The type-annotation macro. - (: (List Int) (list +1 +2 +3))")]) + (text$ ($_ "lux text concat" + "## The type-annotation macro." __paragraph + "(: (List Int) (list +1 +2 +3))"))]) ({(#Cons type (#Cons value #Nil)) (return (list (` ("lux check" (type (~ type)) (~ value))))) @@ -2844,8 +2852,9 @@ (macro:' #export (:coerce tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## The type-coercion macro. - (:coerce Dinosaur (list +1 +2 +3))")]) + (text$ ($_ "lux text concat" + "## The type-coercion macro." __paragraph + "(:coerce Dinosaur (list +1 +2 +3))"))]) ({(#Cons type (#Cons value #Nil)) (return (list (` ("lux coerce" (type (~ type)) (~ value))))) @@ -2941,10 +2950,10 @@ (macro:' #export (Rec tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Parameter-less recursive types. - ## A name has to be given to the whole type, to use it within its body. - (Rec Self - [Int (List Self)])")]) + (text$ ($_ "lux text concat" + "## Parameter-less recursive types." __paragraph + "## A name has to be given to the whole type, to use it within its body." __paragraph + "(Rec Self [Int (List Self)])"))]) ({(#Cons [_ (#Identifier "" name)] (#Cons body #Nil)) (let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-parameter 1)) (~ (make-parameter 0))))]) (update-parameters body))] @@ -2956,12 +2965,13 @@ (macro:' #export (exec tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Sequential execution of expressions (great for side-effects). - (exec - (log! \"#1\") - (log! \"#2\") - (log! \"#3\") - \"YOLO\")")]) + (text$ ($_ "lux text concat" + "## Sequential execution of expressions (great for side-effects)." __paragraph + "(exec" ..new-line + " " "(log! ''#1'')" ..new-line + " " "(log! ''#2'')" ..new-line + " " "(log! ''#3'')" ..new-line + "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (identifier$ ["" ""])] (return (list (list/fold ("lux check" (-> Code Code Code) @@ -3043,7 +3053,7 @@ (frac/encode value) [_ (#Text value)] - ($_ text/compose "\"" value "\"") + ($_ text/compose ..double-quote value ..double-quote) [_ (#Identifier [prefix name])] (if (text/= "" prefix) @@ -3104,23 +3114,23 @@ (do Monad<Meta> [] (wrap (list))) _ - (fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches - (list/map code-to-text) - (interpose " ") - list/reverse - (list/fold text/compose ""))))} + (fail ($_ text/compose "'lux.case' expects an even number of tokens: " (|> branches + (list/map code-to-text) + (interpose " ") + list/reverse + (list/fold text/compose ""))))} branches)) (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## The pattern-matching macro. - ## Allows the usage of macros within the patterns to provide custom syntax. - (case (: (List Int) (list +1 +2 +3)) - (#Cons x (#Cons y (#Cons z #Nil))) - (#Some ($_ i/* x y z)) - - _ - #None)")]) + (text$ ($_ "lux text concat" + "## The pattern-matching macro." ..new-line + "## Allows the usage of macros within the patterns to provide custom syntax." ..new-line + "(case (: (List Int) (list +1 +2 +3))" ..new-line + " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new-line + " " "(#Some ($_ i/* x y z))" __paragraph + " " "_" ..new-line + " " "#None)"))]) ({(#Cons value branches) (do Monad<Meta> [expansion (expander branches)] @@ -3132,14 +3142,15 @@ (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Macro-expanding patterns. - ## It's a special macro meant to be used with 'case'. - (case (: (List Int) (list +1 +2 +3)) - (^ (list x y z)) - (#Some ($_ i/* x y z)) - - _ - #None)")]) + (text$ ($_ "lux text concat" + "## Macro-expanding patterns." ..new-line + "## It's a special macro meant to be used with 'case'." ..new-line + "(case (: (List Int) (list +1 +2 +3))" ..new-line + " (^ (list x y z))" ..new-line + " (#Some ($_ i/* x y z))" + __paragraph + " _" ..new-line + " #None)"))]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) (do Monad<Meta> @@ -3156,25 +3167,19 @@ (macro:' #export (^or tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Or-patterns. - ## It's a special macro meant to be used with 'case'. - (type: Weekday - #Monday - #Tuesday - #Wednesday - #Thursday - #Friday - #Saturday - #Sunday) - - (def: (weekend? day) - (-> Weekday Bit) - (case day - (^or #Saturday #Sunday) - #1 - - _ - #0))")]) + (text$ ($_ "lux text concat" + "## Or-patterns." ..new-line + "## It's a special macro meant to be used with 'case'." ..new-line + "(type: Weekday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday)" + __paragraph + "(def: (weekend? day)" ..new-line + " (-> Weekday Bit)" ..new-line + " (case day" ..new-line + " (^or #Saturday #Sunday)" ..new-line + " #1" + __paragraph + " _" ..new-line + " #0))"))]) (case tokens (^ (list& [_ (#Form patterns)] body branches)) (case patterns @@ -3200,11 +3205,12 @@ (macro:' #export (let tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Creates local bindings. - ## Can (optionally) use pattern-matching macros when binding. - (let [x (foo bar) - y (baz quux)] - (op x y))")]) + (text$ ($_ "lux text concat" + "## Creates local bindings." ..new-line + "## Can (optionally) use pattern-matching macros when binding." ..new-line + "(let [x (foo bar)" ..new-line + " y (baz quux)]" ..new-line + " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (list/size bindings)) @@ -3225,13 +3231,14 @@ (macro:' #export (function tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Syntax for creating functions. - ## Allows for giving the function itself a name, for the sake of recursion. - (: (All [a b] (-> a b a)) - (function (_ x y) x)) - - (: (All [a b] (-> a b a)) - (function (const x y) x))")]) + (text$ ($_ "lux text concat" + "## Syntax for creating functions." ..new-line + "## Allows for giving the function itself a name, for the sake of recursion." ..new-line + "(: (All [a b] (-> a b a))" ..new-line + " (function (_ x y) x))" + __paragraph + "(: (All [a b] (-> a b a))" ..new-line + " (function (const x y) x))"))]) (case (: (Maybe [Text Code (List Code) Code]) (case tokens (^ (list [_ (#Form (list& [_ (#Identifier ["" name])] head tail))] body)) @@ -3343,15 +3350,16 @@ (macro:' #export (def: tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Defines global constants/functions. - (def: (rejoin-pair pair) - (-> [Code Code] (List Code)) - (let [[left right] pair] - (list left right))) - - (def: branching-exponent - Int - +5)")]) + (text$ ($_ "lux text concat" + "## Defines global constants/functions." ..new-line + "(def: (rejoin-pair pair)" ..new-line + " (-> [Code Code] (List Code))" ..new-line + " (let [[left right] pair]" ..new-line + " (list left right)))" + __paragraph + "(def: branching-exponent" ..new-line + " Int" ..new-line + " +5)"))]) (let [[export? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) (case tokens' @@ -3427,17 +3435,17 @@ (macro:' #export (macro: tokens) (list [(tag$ ["lux" "doc"]) - (text$ "Macro-definition macro. - - (macro: #export (name-of tokens) - (case tokens - (^template [<tag>] - (^ (list [_ (<tag> [prefix name])])) - (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) - ([#Identifier] [#Tag]) - - _ - (fail \"Wrong syntax for name-of\")))")]) + (text$ ($_ "lux text concat" + "## Macro-definition macro." ..new-line + "(macro: #export (name-of tokens)" ..new-line + " (case tokens" ..new-line + " (^template [<tag>]" ..new-line + " (^ (list [_ (<tag> [prefix name])]))" ..new-line + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))" ..new-line + " ([#Identifier] [#Tag])" + __paragraph + " _" ..new-line + " (fail ''Wrong syntax for name-of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) Code Code]) (case tokens @@ -3474,18 +3482,19 @@ (fail "Wrong syntax for macro:")))) (macro: #export (signature: tokens) - {#.doc "## Definition of signatures ala ML. - (signature: #export (Ord a) - (: (Equivalence a) - eq) - (: (-> a a Bit) - <) - (: (-> a a Bit) - <=) - (: (-> a a Bit) - >) - (: (-> a a Bit) - >=))"} + {#.doc (text$ ($_ "lux text concat" + "## Definition of signatures ala ML." ..new-line + "(signature: #export (Ord a)" ..new-line + " (: (Equivalence a)" ..new-line + " eq)" ..new-line + " (: (-> a a Bit)" ..new-line + " <)" ..new-line + " (: (-> a a Bit)" ..new-line + " <=)" ..new-line + " (: (-> a a Bit)" ..new-line + " >)" ..new-line + " (: (-> a a Bit)" ..new-line + " >=))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Name (List Code) Code (List Code)]) (case tokens' @@ -3566,8 +3575,8 @@ _ (fail <message>)))] - [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting \"and\".\n(and #1 #0 #1) ## => #0"] - [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\".\n(or #1 #0 #1) ## => #1"]) + [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] + [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) (def: (index-of part text) (-> Text Text (Maybe Nat)) @@ -3591,26 +3600,35 @@ #None #None)) -(def: (clip1 from text) +(def: (clip/1 from text) (-> Nat Text (Maybe Text)) - ("lux text clip" text from ("lux text size" text))) + (let [size ("lux text size" text)] + (if (n/<= size from) + (#.Some ("lux text clip" text from size)) + #.None))) -(def: (clip2 from to text) +(def: (clip/2 from to text) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" text from to)) + (if (and (n/<= to from) + (n/<= ("lux text size" text) to)) + (#.Some ("lux text clip" text from to)) + #.None)) (def: #export (error! message) - {#.doc "## Causes an error, with the given error message. - (error! \"OH NO!\")"} + {#.doc (text$ ($_ "lux text concat" + "## Causes an error, with the given error message." ..new-line + "(error! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) (macro: (default tokens state) - {#.doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #.None. - (default +20 (#.Some +10)) => +10 - - (default +20 #.None) => +20"} + {#.doc (text$ ($_ "lux text concat" + "## Allows you to provide a default value that will be used" ..new-line + "## if a (Maybe x) value turns out to be #.None." + __paragraph + "(default +20 (#.Some +10)) ## => +10" + __paragraph + "(default +20 #.None) ## => +20"))} (case tokens (^ (list else maybe)) (let [g!temp (: Code [dummy-cursor (#Identifier ["" ""])]) @@ -3632,11 +3650,9 @@ (list input) (#Some idx) - (list& (default (error! "UNDEFINED") - (clip2 0 idx input)) + (list& ("lux text clip" input 0 idx) (text/split splitter - (default (error! "UNDEFINED") - (clip1 (n/+ 1 idx) input)))))) + ("lux text clip" input (n/+ 1 idx) ("lux text size" input)))))) (def: (nth idx xs) (All [a] @@ -3846,7 +3862,7 @@ (#Left "Not expecting any type."))))) (macro: #export (structure tokens) - {#.doc "Not meant to be used directly. Prefer \"structure:\"."} + {#.doc "Not meant to be used directly. Prefer 'structure:'."} (do Monad<Meta> [tokens' (monad/map Monad<Meta> macro-expand tokens) struct-type get-expected-type @@ -3883,19 +3899,20 @@ (|> parts list/reverse (list/fold text/compose ""))) (macro: #export (structure: tokens) - {#.doc "## Definition of structures ala ML. - (structure: #export Ord<Int> (Ord Int) - (def: eq Equivalence<Int>) - (def: (< test subject) - (lux.< test subject)) - (def: (<= test subject) - (or (lux.< test subject) - (lux.= test subject))) - (def: (lux.> test subject) - (lux.> test subject)) - (def: (lux.>= test subject) - (or (lux.> test subject) - (lux.= test subject))))"} + {#.doc (text$ ($_ "lux text concat" + "## Definition of structures ala ML." ..new-line + "(structure: #export Ord<Int> (Ord Int)" ..new-line + " (def: eq Equivalence<Int>)" ..new-line + " (def: (< test subject)" ..new-line + " (lux.i/< test subject))" ..new-line + " (def: (<= test subject)" ..new-line + " (or (lux.i/< test subject)" ..new-line + " (lux.i/= test subject)))" ..new-line + " (def: (> test subject)" ..new-line + " (lux.i/> test subject))" ..new-line + " (def: (>= test subject)" ..new-line + " (or (lux.i/> test subject)" ..new-line + " (lux.i/= test subject))))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' @@ -3955,23 +3972,20 @@ (structure (~+ definitions))))))) #None - (fail "Cannot infer name, so struct must have a name other than \"_\"!")) + (fail "Cannot infer name, so struct must have a name other than '_'!")) #None (fail "Wrong syntax for structure:")))) (def: #export (id x) - {#.doc "Identity function. - - Does nothing to it's argument and just returns it."} + {#.doc "Identity function. Does nothing to it's argument and just returns it."} (All [a] (-> a a)) x) (macro: #export (type: tokens) - {#.doc "## The type-definition macro. - (type: (List a) - #Nil - (#Cons a (List a)))"} + {#.doc (text$ ($_ "lux text concat" + "## The type-definition macro." ..new-line + "(type: (List a) #Nil (#Cons a (List a)))"))} (let [[exported? tokens'] (export^ tokens) [rec? tokens'] (case tokens' (#Cons [_ (#Tag [_ "rec"])] tokens') @@ -4128,23 +4142,17 @@ _ (return [#.Nil parts]))) -(def: (split at x) - (-> Nat Text (Maybe [Text Text])) - (case [(..clip2 0 at x) (..clip1 at x)] - [(#.Some pre) (#.Some post)] - (#.Some [pre post]) - - _ - #.None)) +(def: (split! at x) + (-> Nat Text [Text Text]) + [("lux text clip" x 0 at) + ("lux text clip" x at ("lux text size" x))]) (def: (split-with token sample) (-> Text Text (Maybe [Text Text])) (do ..Monad<Maybe> [index (..index-of token sample) - pre+post' (split index sample) - #let [[pre post'] pre+post'] - _+post (split ("lux text size" token) post') - #let [[_ post] _+post]] + #let [[pre post'] (split! index sample) + [_ post] (split! ("lux text size" token) post')]] (wrap [pre post]))) (def: (replace-all pattern value template) @@ -4197,15 +4205,15 @@ list/reverse (interpose "/") text/join) - clean (|> module (clip1 ups) (default (error! "UNDEFINED"))) + clean ("lux text clip" module ups ("lux text size" module)) output (case ("lux text size" clean) 0 prefix _ ($_ text/compose prefix "/" clean))] (return output)) - (fail ($_ text/compose - "Cannot climb the module hierarchy...\n" - "Importing module: " module "\n" - " Relative Root: " relative-root "\n")))))) + (fail ($_ "lux text concat" + "Cannot climb the module hierarchy..." ..new-line + "Importing module: " module ..new-line + " Relative Root: " relative-root ..new-line)))))) (def: (parse-imports nested? relative-root imports) (-> Bit Text (List Code) (Meta (List Importation))) @@ -4488,11 +4496,12 @@ )) (macro: #export (^open tokens) - {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. - ## Takes an \"alias\" text for the generated local bindings. - (def: #export (range (^open \".\") from to) - (All [a] (-> (Enum a) a a (List a))) - (range' <= succ from to))"} + {#.doc (text$ ($_ "lux text concat" + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new-line + "## Takes an 'alias' text for the generated local bindings." ..new-line + "(def: #export (range (^open ''.'') from to)" ..new-line + " (All [a] (-> (Enum a) a a (List a)))" ..new-line + " (range' <= succ from to))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) (do Monad<Meta> @@ -4505,7 +4514,7 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #None - (fail (text/compose "Can only \"open\" structs: " (type/encode init-type))) + (fail (text/compose "Can only 'open' structs: " (type/encode init-type))) (#Some tags&members) (do Monad<Meta> @@ -4538,11 +4547,13 @@ (fail "Wrong syntax for ^open"))) (macro: #export (cond tokens) - {#.doc "## Branching structures with multiple test conditions. - (cond (n/even? num) \"even\" - (n/odd? num) \"odd\" - ## else-branch - \"???\")"} + {#.doc (text$ ($_ "lux text concat" + "## Branching structures with multiple test conditions." ..new-line + "(cond (n/even? num) ''even''" ..new-line + " (n/odd? num) ''odd''" + __paragraph + " ## else-branch" ..new-line + " ''???'')"))} (if (n/= 0 (n/% 2 (list/size tokens))) (fail "cond requires an uneven number of arguments.") (case (list/reverse tokens) @@ -4571,16 +4582,16 @@ (enumerate' 0 xs)) (macro: #export (get@ tokens) - {#.doc "## Accesses the value of a record at a given tag. - (get@ #field my-record) - - ## Can also work with multiple levels of nesting: - (get@ [#foo #bar #baz] my-record) - - ## And, if only the slot/path is given, generates an - ## accessor function: - (let [getter (get@ [#foo #bar #baz])] - (getter my-record))"} + {#.doc (text$ ($_ "lux text concat" + "## Accesses the value of a record at a given tag." ..new-line + "(get@ #field my-record)" + __paragraph + "## Can also work with multiple levels of nesting:" ..new-line + "(get@ [#foo #bar #baz] my-record)" + __paragraph + "## And, if only the slot/path is given, generates an accessor function:" ..new-line + "(let [getter (get@ [#foo #bar #baz])]" ..new-line + " (getter my-record))"))} (case tokens (^ (list [_ (#Tag slot')] record)) (do Monad<Meta> @@ -4639,14 +4650,17 @@ [(~ cursor-code) (#.Record #Nil)]))))))) (macro: #export (open: tokens) - {#.doc "## Opens a structure and generates a definition for each of its members (including nested members). - ## For example: - (open: \"i:.\" Number<Int>) - ## Will generate: - (def: i:+ (:: Number<Int> +)) - (def: i:- (:: Number<Int> -)) - (def: i:* (:: Number<Int> *)) - ..."} + {#.doc (text$ ($_ "lux text concat" + "## Opens a structure and generates a definition for each of its members (including nested members)." + __paragraph + "## For example:" ..new-line + "(open: ''i:.'' Number<Int>)" + __paragraph + "## Will generate:" ..new-line + "(def: i:+ (:: Number<Int> +))" ..new-line + "(def: i:- (:: Number<Int> -))" ..new-line + "(def: i:* (:: Number<Int> *))" ..new-line + "..."))} (case tokens (^ (list [_ (#Text alias)] struct)) (case struct @@ -4665,7 +4679,7 @@ (return (list/join decls'))) _ - (fail (text/compose "Can only \"open:\" structs: " (type/encode struct-type))))) + (fail (text/compose "Can only 'open:' structs: " (type/encode struct-type))))) _ (do Monad<Meta> @@ -4678,26 +4692,22 @@ (fail "Wrong syntax for open:"))) (macro: #export (|>> tokens) - {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (|>> (list/map int/encode) (interpose \" \") (fold text/compose \"\")) - ## => - (function (_ <arg>) - (fold text/compose \"\" - (interpose \" \" - (list/map int/encode <arg>))))"} + {#.doc (text$ ($_ "lux text concat" + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line + "(|>> (list/map int/encode) (interpose '' '') (fold text/compose ''''))" ..new-line + "## =>" ..new-line + "(function (_ <arg>) (fold text/compose '''' (interpose '' '' (list/map int/encode <arg>))))"))} (do Monad<Meta> [g!_ (gensym "_") g!arg (gensym "arg")] (return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) (macro: #export (<<| tokens) - {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (<<| (fold text/compose \"\") (interpose \" \") (list/map int/encode)) - ## => - (function (_ <arg>) - (fold text/compose \"\" - (interpose \" \" - (list/map int/encode <arg>))))"} + {#.doc (text$ ($_ "lux text concat" + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line + "(<<| (fold text/compose '''') (interpose '' '') (list/map int/encode))" ..new-line + "## =>" ..new-line + "(function (_ <arg>) (fold text/compose '''' (interpose '' '' (list/map int/encode <arg>))))"))} (do Monad<Meta> [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4734,10 +4744,10 @@ _ (fail ($_ text/compose "Wrong syntax for refer @ " current-module - "\n" (|> options - (list/map code-to-text) - (interpose " ") - (list/fold text/compose ""))))))) + ..new-line (|> options + (list/map code-to-text) + (interpose " ") + (list/fold text/compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) (-> Text Refer (Meta (List Code))) @@ -4821,26 +4831,23 @@ (~+ openings))))) (macro: #export (module: tokens) - {#.doc "Module-definition macro. - - Can take optional annotations and allows the specification of modules to import. - - ## Examples - (.module: {#.doc \"Some documentation...\"} - [lux #* - [control - [\"M\" monad #*]] - [data - maybe - [\".\" name (\"name/.\" Codec<Text,Name>)] - [\".\" text (\"text/.\" Monoid<Text>)] - [collection - [list (\"list/.\" Monad<List>)]]] - meta - [macro - code]] - [// - [type (\".\" Equivalence<Type>)]])"} + {#.doc (text$ ($_ "lux text concat" + "## Module-definition macro." + __paragraph + "## Can take optional annotations and allows the specification of modules to import." + __paragraph + "## Example" ..new-line + "(.module: {#.doc ''Some documentation...''}" ..new-line + " [lux #*" ..new-line + " [control" ..new-line + " [''M'' monad #*]]" ..new-line + " [data" ..new-line + " maybe" ..new-line + " [''.'' name (''name/.'' Codec<Text,Name>)]]" ..new-line + " [macro" ..new-line + " code]]" ..new-line + " [//" ..new-line + " [type (''.'' Equivalence<Type>)]])"))} (do Monad<Meta> [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens @@ -4866,11 +4873,12 @@ (wrap (#Cons =module =refers)))) (macro: #export (:: tokens) - {#.doc "## Allows accessing the value of a structure's member. - (:: Codec<Text,Int> encode) - - ## Also allows using that value as a function. - (:: Codec<Text,Int> encode +123)"} + {#.doc (text$ ($_ "lux text concat" + "## Allows accessing the value of a structure's member." ..new-line + "(:: Codec<Text,Int> encode)" + __paragraph + "## Also allows using that value as a function." ..new-line + "(:: Codec<Text,Int> encode +123)"))} (case tokens (^ (list struct [_ (#Identifier member)])) (return (list (` (let [(^open ".") (~ struct)] (~ (identifier$ member)))))) @@ -4882,19 +4890,16 @@ (fail "Wrong syntax for ::"))) (macro: #export (set@ tokens) - {#.doc "## Sets the value of a record at a given tag. - (set@ #name \"Lux\" lang) - - ## Can also work with multiple levels of nesting: - (set@ [#foo #bar #baz] value my-record) - - ## And, if only the slot/path and (optionally) the value are given, generates a - ## mutator function: - (let [setter (set@ [#foo #bar #baz] value)] - (setter my-record)) - - (let [setter (set@ [#foo #bar #baz])] - (setter value my-record))"} + {#.doc (text$ ($_ "lux text concat" + "## Sets the value of a record at a given tag." ..new-line + "(set@ #name ''Lux'' lang)" + __paragraph + "## Can also work with multiple levels of nesting:" ..new-line + "(set@ [#foo #bar #baz] value my-record)" + __paragraph + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line + "(let [setter (set@ [#foo #bar #baz] value)] (setter my-record))" ..new-line + "(let [setter (set@ [#foo #bar #baz])] (setter value my-record))"))} (case tokens (^ (list [_ (#Tag slot')] value record)) (do Monad<Meta> @@ -4972,19 +4977,16 @@ (fail "Wrong syntax for set@"))) (macro: #export (update@ tokens) - {#.doc "## Modifies the value of a record at a given tag, based on some function. - (update@ #age inc person) - - ## Can also work with multiple levels of nesting: - (update@ [#foo #bar #baz] func my-record) - - ## And, if only the slot/path and (optionally) the value are given, generates a - ## mutator function: - (let [updater (update@ [#foo #bar #baz] func)] - (updater my-record)) - - (let [updater (update@ [#foo #bar #baz])] - (updater func my-record))"} + {#.doc (text$ ($_ "lux text concat" + "## Modifies the value of a record at a given tag, based on some function." ..new-line + "(update@ #age inc person)" + __paragraph + "## Can also work with multiple levels of nesting:" ..new-line + "(update@ [#foo #bar #baz] func my-record)" + __paragraph + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line + "(let [updater (update@ [#foo #bar #baz] func)] (updater my-record))" ..new-line + "(let [updater (update@ [#foo #bar #baz])] (updater func my-record))"))} (case tokens (^ (list [_ (#Tag slot')] fun record)) (do Monad<Meta> @@ -5048,41 +5050,40 @@ (fail "Wrong syntax for update@"))) (macro: #export (^template tokens) - {#.doc "## It's similar to do-template, but meant to be used during pattern-matching. - (def: (beta-reduce env type) - (-> (List Type) Type Type) - (case type - (#.Primitive name params) - (#.Primitive name (list/map (beta-reduce env) params)) - - (^template [<tag>] - (<tag> left right) - (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#.Sum] [#.Product]) - - (^template [<tag>] - (<tag> left right) - (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#.Function] - [#.Apply]) - - (^template [<tag>] - (<tag> old-env def) - (case old-env - #.Nil - (<tag> env def) - - _ - type)) - ([#.UnivQ] - [#.ExQ]) - - (#.Parameter idx) - (default type (list.nth idx env)) - - _ - type - ))"} + {#.doc (text$ ($_ "lux text concat" + "## It's similar to do-template, but meant to be used during pattern-matching." ..new-line + "(def: (beta-reduce env type)" ..new-line + " (-> (List Type) Type Type)" ..new-line + " (case type" ..new-line + " (#.Primitive name params)" ..new-line + " (#.Primitive name (list/map (beta-reduce env) params))" + __paragraph + " (^template [<tag>]" ..new-line + " (<tag> left right)" ..new-line + " (<tag> (beta-reduce env left) (beta-reduce env right)))" ..new-line + " ([#.Sum] [#.Product])" + __paragraph + " (^template [<tag>]" ..new-line + " (<tag> left right)" ..new-line + " (<tag> (beta-reduce env left) (beta-reduce env right)))" ..new-line + " ([#.Function] [#.Apply])" + __paragraph + " (^template [<tag>]" ..new-line + " (<tag> old-env def)" ..new-line + " (case old-env" ..new-line + " #.Nil" ..new-line + " (<tag> env def)" + __paragraph + " _" ..new-line + " type))" ..new-line + " ([#.UnivQ] [#.ExQ])" + __paragraph + " (#.Parameter idx)" ..new-line + " (default type (list.nth idx env))" + __paragraph + " _" ..new-line + " type" ..new-line + " ))"))} (case tokens (^ (list& [_ (#Form (list& [_ (#Tuple bindings)] templates))] [_ (#Form data)] @@ -5158,17 +5159,7 @@ (def: (text/encode original) (-> Text Text) - (let [escaped (|> original - (replace-all "\t" "\\t") - (replace-all "\v" "\\v") - (replace-all "\b" "\\b") - (replace-all "\n" "\\n") - (replace-all "\r" "\\r") - (replace-all "\f" "\\f") - (replace-all "\"" "\\\"") - (replace-all "\\" "\\\\") - )] - ($_ text/compose "\"" escaped "\""))) + ($_ text/compose ..double-quote original ..double-quote)) (do-template [<name> <extension> <doc>] [(def: #export (<name> value) @@ -5205,7 +5196,7 @@ (-> Nat Cursor Cursor Text) (if (n/= old-line new-line) (text/join (repeat (.int (n/- old-column new-column)) " ")) - (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) "\n")) + (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) ..new-line)) space-padding (text/join (repeat (.int (n/- baseline new-column)) " "))] (text/compose extra-lines space-padding)))) @@ -5271,27 +5262,28 @@ (case fragment (#Doc-Comment comment) (|> comment - (text/split "\n") - (list/map (function (_ line) ($_ text/compose "## " line "\n"))) + (text/split ..new-line) + (list/map (function (_ line) ($_ text/compose "## " line ..new-line))) text/join) (#Doc-Example example) (let [baseline (find-baseline-column example) [cursor _] example [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] - (text/compose text "\n\n")))) + (text/compose text __paragraph)))) (macro: #export (doc tokens) - {#.doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. - - ## For Example: - (doc \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop. - Can be used in monadic code to create monadic loops.\" - (loop [count +0 - x init] - (if (< +10 count) - (recur (inc count) (f x)) - x)))"} + {#.doc (text$ ($_ "lux text concat" + "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." + __paragraph + "## For Example:" ..new-line + "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new-line + " ''Can be used in monadic code to create monadic loops.''" ..new-line + " (loop [count +0" ..new-line + " x init]" ..new-line + " (if (< +10 count)" ..new-line + " (recur (inc count) (f x))" ..new-line + " x)))"))} (return (list (` [(~ cursor-code) (#.Text (~ (|> tokens (list/map (|>> identify-doc-fragment doc-fragment->Text)) @@ -5350,7 +5342,7 @@ (identifier$ [module name]))) (macro: #export (loop tokens) - {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." + {#.doc (doc "Allows arbitrary looping, using the 'recur' form to re-start the loop." "Can be used in monadic code to create monadic loops." (loop [count +0 x init] @@ -5493,18 +5485,18 @@ (compare <text> (:: Code/encode encode <expr>)) (compare #1 (:: Equivalence<Code> = <expr> <expr>))] - [(bit #1) "#1" [_ (#.Bit #1)]] - [(bit #0) "#0" [_ (#.Bit #0)]] + [(bit #1) "#1" [_ (#.Bit #1)]] + [(bit #0) "#0" [_ (#.Bit #0)]] [(int +123) "+123" [_ (#.Int +123)]] [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "\n") "\"\\n\"" [_ (#.Text "\n")]] - [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] - [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] + [(text "123") "'123'" [_ (#.Text "123")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] - [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] - [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] + [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] )] (test-all <tests>))))} (case tokens @@ -5610,7 +5602,7 @@ (wrap (list pattern'))) _ - (fail "Wrong syntax for \"static\"."))) + (fail "Wrong syntax for 'static'."))) (type: Multi-Level-Case [Code (List [Code Code])]) @@ -5763,7 +5755,7 @@ (fail "Wrong syntax for $"))) (def: #export (is? reference sample) - {#.doc (doc "Tests whether the 2 values are identical (not just \"equal\")." + {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." "This one should succeed:" (let [value +5] (is? value value)) @@ -5945,7 +5937,7 @@ (^ (list (~+ (list/map (|>> [""] identifier$) args)))) (#.Right [(~ g!compiler) (list (~+ (list/map (function (_ template) - (` (` (~ (replace-syntax rep-env template))))) + (` (`' (~ (replace-syntax rep-env template))))) input-templates)))]) (~ g!_) @@ -5961,7 +5953,6 @@ (^multi (^ (list [_ (#Text input)])) (n/= 1 ("lux text size" input))) (|> ("lux text char" input 0) - (default (undefined)) nat$ list [compiler] #Right) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index abb1d0c38..07e79d86f 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -66,7 +66,7 @@ [[remaining raw] (any inputs)] (if (text/= reference raw) (wrap [remaining []]) - (E.fail (format "Missing token: \"" reference "\"")))))) + (E.fail (format "Missing token: '" reference "'")))))) (def: #export (somewhere cli) {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."} @@ -118,7 +118,7 @@ (syntax: #export (program: {args program-args^} body) - {#.doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)." + {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." (program: all-args (do Monad<IO> diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index 16c1a2b0e..73b018c95 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)]] [data ["." product] - ["." error] + ["." error (#+ Error)] [text ("text/." Hash<Text>) format ["." encoding]] @@ -36,12 +36,20 @@ ## [cache/io]) ) -(def: #export prelude Text "lux") +(type: Reader + (-> .Source (Error [.Source Code]))) -(def: (read current-module aliases) - (-> Text Aliases (analysis.Operation Code)) +(def: (reader current-module aliases) + (-> Text Aliases (analysis.Operation Reader)) + (function (_ [bundle state]) + (let [[cursor offset source-code] (get@ #.source state)] + (#error.Success [[bundle state] + (syntax.parse current-module aliases ("lux text size" source-code))])))) + +(def: (read reader) + (-> Reader (analysis.Operation Code)) (function (_ [bundle compiler]) - (case (syntax.read current-module aliases (get@ #.source compiler)) + (case (reader (get@ #.source compiler)) (#error.Error error) (#error.Error error) @@ -88,26 +96,30 @@ (|>> module.set-compiled statement.lift-analysis)) - (def: (loop-module-compilation module-name) + (def: (module-compilation-iteration reader) + (-> Reader (All [anchor expression statement] <Operation>)) + (<| (phase.timed (name-of ..module-compilation-iteration) "ITERATION") + (do phase.Monad<Operation> + [code (statement.lift-analysis + (do @ + [code (<| (phase.timed (name-of ..module-compilation-iteration) "syntax") + (..read reader)) + #let [[cursor _] code] + _ (analysis.set-cursor cursor)] + (wrap code))) + _ (<| (phase.timed (name-of ..module-compilation-iteration) "PHASE") + (totalS.phase code))] + init.refresh))) + + (def: (module-compilation-loop module-name) (All [anchor expression statement] (-> Text <Operation>)) - (let [iteration (: (All [anchor expression statement] - <Operation>) - (<| (phase.timed (name-of ..loop-module-compilation) "ITERATION") - (do phase.Monad<Operation> - [code (statement.lift-analysis - (do @ - [code (<| (phase.timed (name-of ..loop-module-compilation) "syntax") - (..read module-name syntax.no-aliases)) - #let [[cursor _] code] - _ (analysis.set-cursor cursor)] - (wrap code))) - _ (<| (phase.timed (name-of ..loop-module-compilation) "PHASE") - (totalS.phase code))] - init.refresh)))] + (do phase.Monad<Operation> + [reader (statement.lift-analysis + (..reader module-name syntax.no-aliases))] (function (_ state) (loop [state state] - (case (iteration state) + (case (module-compilation-iteration reader state) (#error.Success [state' output]) (recur state') @@ -121,7 +133,7 @@ (-> Text Source <Operation>)) (do phase.Monad<Operation> [_ (begin-module-compilation module-name source) - _ (loop-module-compilation module-name)] + _ (module-compilation-loop module-name)] (end-module-compilation module-name))) (def: #export (compile-module platform configuration compiler) @@ -186,7 +198,7 @@ (-> <Platform> Configuration <Bundle> (! Any))) (do (:: (get@ #file-system platform) &monad) [compiler (initialize platform configuration translation-bundle) - _ (compile-module platform (set@ #cli.module ..prelude configuration) compiler) + _ (compile-module platform (set@ #cli.module syntax.prelude configuration) compiler) _ (compile-module platform configuration compiler) ## _ (cache/io.clean target ...) ] diff --git a/stdlib/source/lux/compiler/default/name.lux b/stdlib/source/lux/compiler/default/name.lux index ddbf9ee8f..925b0585d 100644 --- a/stdlib/source/lux/compiler/default/name.lux +++ b/stdlib/source/lux/compiler/default/name.lux @@ -12,7 +12,7 @@ (^ (char "+")) "_PLUS_" (^ (char "-")) "_DASH_" (^ (char "/")) "_SLASH_" - (^ (char "\\")) "_BSLASH_" + (^ (char "\")) "_BSLASH_" (^ (char "_")) "_UNDERS_" (^ (char "%")) "_PERCENT_" (^ (char "$")) "_DOLLAR_" diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index 8ef8324ae..615075800 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -81,20 +81,20 @@ [(template: #export (<name> content) (<tag> content))] - [control/case #Case] + [control/case #..Case] ) (do-template [<name> <type> <tag>] [(def: #export <name> (-> <type> Analysis) - (|>> <tag> #Primitive))] - - [bit Bit #Bit] - [nat Nat #Nat] - [int Int #Int] - [rev Rev #Rev] - [frac Frac #Frac] - [text Text #Text] + (|>> <tag> #..Primitive))] + + [bit Bit #..Bit] + [nat Nat #..Nat] + [int Int #..Int] + [rev Rev #..Rev] + [frac Frac #..Frac] + [text Text #..Text] ) (type: #export Arity Nat) @@ -142,7 +142,7 @@ (do-template [<name> <tag>] [(template: #export (<name> content) - (.<| #Complex + (.<| #..Complex <tag> content))] @@ -236,7 +236,7 @@ output]) (#error.Error error) - (#error.Error (format "@ " (%cursor cursor) "\n" + (#error.Error (format "@ " (%cursor cursor) text.new-line error))))))) (do-template [<name> <type> <field> <value>] diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux index ed2f81735..317f86a6f 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux @@ -26,14 +26,14 @@ (exception: #export (macro-expansion-failed {macro Name} {inputs (List Code)} {error Text}) (ex.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format "\n\t"))) + (list/map (|>> %code (format text.new-line text.tab))) (text.join-with ""))] ["Error" error])) (exception: #export (macro-call-must-have-single-expansion {macro Name} {inputs (List Code)}) (ex.report ["Macro" (%name macro)] ["Inputs" (|> inputs - (list/map (|>> %code (format "\n\t"))) + (list/map (|>> %code (format text.new-line text.tab))) (text.join-with ""))])) (exception: #export (unrecognized-syntax {code Code}) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/function.lux b/stdlib/source/lux/compiler/default/phase/analysis/function.lux index 1f0e4c8f9..a996457d9 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/function.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/function.lux @@ -30,7 +30,7 @@ ["Arguments" (|> arguments list.enumerate (list/map (.function (_ [idx argC]) - (format "\n " (%n idx) " " (%code argC)))) + (format text.new-line " " (%n idx) " " (%code argC)))) (text.join-with ""))])) (def: #export (function analyse function-name arg-name body) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/inference.lux b/stdlib/source/lux/compiler/default/phase/analysis/inference.lux index c96d0457c..010bdc437 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/inference.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/inference.lux @@ -27,7 +27,7 @@ ["Arguments" (|> args list.enumerate (list/map (function (_ [idx argC]) - (format "\n " (%n idx) " " (%code argC)))) + (format text.new-line " " (%n idx) " " (%code argC)))) (text.join-with ""))])) (exception: #export (cannot-infer-argument {inferred Type} {argument Code}) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index 38ca02700..c87d8d54c 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -49,7 +49,7 @@ ["Available" (|> bundle dictionary.keys (list.sort text/<) - (list/map (|>> %t (format "\n\t"))) + (list/map (|>> %t (format text.new-line text.tab))) (text.join-with ""))])) (exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) @@ -75,7 +75,9 @@ (ex.throw unknown [where name bundle]) (#.Some handler) - ((handler name phase) parameters stateE)))) + ((<| (//.timed (name-of ..apply) (%t name)) + ((handler name phase) parameters)) + stateE)))) (def: #export (localized get set transform) (All [s s' i o v] diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 690a4accb..d599af130 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -201,8 +201,8 @@ (bundle.install "concat" (binary Text Text Text)) (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat)))) (bundle.install "size" (unary Text Nat)) - (bundle.install "char" (binary Text Nat (type (Maybe Nat)))) - (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) + (bundle.install "char" (binary Text Nat Nat)) + (bundle.install "clip" (trinary Text Nat Nat Text)) ))) (def: #export (bundle eval) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 5406ac20a..64edb791b 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -95,7 +95,7 @@ (ex.report ["Class" class] ["Method" method] ["Hints" (|> hints - (list/map (|>> product.left %type (format "\n\t"))) + (list/map (|>> product.left %type (format text.new-line text.tab))) (text.join-with ""))]))] [no-candidates] @@ -643,14 +643,14 @@ num-type-params (list.size params)] (cond (not (text/= class-name name)) (////.throw cannot-correspond-type-with-a-class - (format "Class = " class-name "\n" + (format "Class = " class-name text.new-line "Type = " (%type type))) (not (n/= num-class-params num-type-params)) (////.throw type-parameter-mismatch - (format "Expected: " (%i (.int num-class-params)) "\n" - " Actual: " (%i (.int num-type-params)) "\n" - " Class: " class-name "\n" + (format "Expected: " (%i (.int num-class-params)) text.new-line + " Actual: " (%i (.int num-type-params)) text.new-line + " Class: " class-name text.new-line " Type: " (%type type))) ## else @@ -704,9 +704,9 @@ (wrap #1)) (do @ [current-class (load-class current-name) - _ (////.assert cannot-cast (format "From class/primitive: " current-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n") + _ (////.assert cannot-cast (format "From class/primitive: " current-name text.new-line + " To class/primitive: " to-name text.new-line + " For value: " (%code valueC) text.new-line) (Class::isAssignableFrom [current-class] to-class)) candiate-parents (monad.map @ (function (_ java-type) @@ -726,17 +726,17 @@ (recur [next-name nextT])) #.Nil - (////.throw cannot-cast (format "From class/primitive: " from-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n"))) + (////.throw cannot-cast (format "From class/primitive: " from-name text.new-line + " To class/primitive: " to-name text.new-line + " For value: " (%code valueC) text.new-line))) ))))))] (if can-cast? (wrap (#analysis.Extension extension-name (list (analysis.text from-name) (analysis.text to-name) valueA))) - (////.throw cannot-cast (format "From class/primitive: " from-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n")))) + (////.throw cannot-cast (format "From class/primitive: " from-name text.new-line + " To class/primitive: " to-name text.new-line + " For value: " (%code valueC) text.new-line)))) _ (////.throw ///.invalid-syntax extension-name)))) @@ -764,9 +764,9 @@ (if (is? owner class) (wrap [class field]) (////.throw mistaken-field-owner - (format " Field: " field-name "\n" - " Owner Class: " (Class::getName [] owner) "\n" - "Target Class: " class-name "\n")))) + (format " Field: " field-name text.new-line + " Owner Class: " (Class::getName [] owner) text.new-line + "Target Class: " class-name text.new-line)))) (#e.Error _) (////.throw unknown-field (format class-name "#" field-name))))) @@ -802,9 +802,9 @@ [#let [num-params (list.size _class-params) num-vars (list.size var-names)] _ (////.assert type-parameter-mismatch - (format "Expected: " (%i (.int num-params)) "\n" - " Actual: " (%i (.int num-vars)) "\n" - " Class: " _class-name "\n" + (format "Expected: " (%i (.int num-params)) text.new-line + " Actual: " (%i (.int num-vars)) text.new-line + " Class: " _class-name text.new-line " Type: " (%type objectT)) (n/= num-params num-vars))] (wrap (|> (list.zip2 var-names _class-params) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 5f2d6d93b..52ac38720 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -22,179 +22,104 @@ ## updated cursor pointing to the end position, after the parser was run. ## Lux Code nodes/tokens are annotated with cursor meta-data -## (file-name, line, column) to keep track of their provenance and +## [file-name, line, column] to keep track of their provenance and ## location, which is helpful for documentation and debugging. (.module: - [lux (#- nat int rev true false) + [lux (#- int rev) [control monad ["p" parser ("parser/." Monad<Parser>)] ["ex" exception (#+ exception:)]] [data - ["e" error] + ["." error (#+ Error)] ["." number] - ["." product] - ["." maybe] ["." text - ["l" lexer (#+ Lexer)] + ["l" lexer (#+ Offset Lexer)] format] [collection - ["." row (#+ Row)] - ["." dictionary (#+ Dictionary)]]] - ["." function]]) + ["." list] + ["." dictionary (#+ Dictionary)]]]]) + +## TODO: Optimize how forms, tuples & records are parsed in the end. +## There is repeated-work going on when parsing the white-space before the +## closing parenthesis/bracket/brace. +## That repeated-work should be avoided. + +## TODO: Implement "lux syntax char case!" as a custom extension. +## That way, it should be possible to obtain the char without wrapping +## it into a java.lang.Long, thereby improving performance. + +## TODO: Make an extension to take advantage of java/lang/String::indexOf<int,int> +## to get better performance than the current "lux text index" extension. + +(type: Char Nat) + +(do-template [<name> <extension> <diff>] + [(template: (<name> value) + (<extension> value <diff>))] + + [!inc "lux i64 +" 1] + [!inc/2 "lux i64 +" 2] + [!dec "lux i64 -" 1] + ) + +(template: (!clip from to text) + ("lux text clip" text from to)) + +(do-template [<name> <extension>] + [(template: (<name> reference subject) + (<extension> subject reference))] + + [!n/= "lux i64 ="] + [!i/< "lux int <"] + ) + +(do-template [<name> <extension>] + [(template: (<name> param subject) + (<extension> subject param))] + + [!n/+ "lux i64 +"] + [!n/- "lux i64 -"] + ) + +(type: #export Syntax + (-> Cursor (Lexer [Cursor Code]))) (type: #export Aliases (Dictionary Text Text)) (def: #export no-aliases Aliases (dictionary.new text.Hash<Text>)) -(def: white-space Text "\t\v \r\f") -(def: new-line Text "\n") - -## This is the parser for white-space. -## Whenever a new-line is encountered, the column gets reset to 0, and -## the line gets incremented. -## It operates recursively in order to produce the longest continuous -## chunk of white-space. -(def: (space^ where) - (-> Cursor (Lexer [Cursor Text])) - (p.either (do p.Monad<Parser> - [content (l.many (l.one-of white-space))] - (wrap [(update@ #.column (n/+ (text.size content)) where) - content])) - ## New-lines must be handled as a separate case to ensure line - ## information is handled properly. - (do p.Monad<Parser> - [content (l.many (l.one-of new-line))] - (wrap [(|> where - (update@ #.line (n/+ (text.size content))) - (set@ #.column 0)) - content])) - )) - -## Single-line comments can start anywhere, but only go up to the -## next new-line. -(def: (single-line-comment^ where) - (-> Cursor (Lexer [Cursor Text])) - (do p.Monad<Parser> - [_ (l.this "##") - comment (l.some (l.none-of new-line)) - _ (l.this new-line)] - (wrap [(|> where - (update@ #.line inc) - (set@ #.column 0)) - comment]))) - -## This is just a helper parser to find text which doesn't run into -## any special character sequences for multi-line comments. -(def: comment-bound^ - (Lexer Any) - ($_ p.either - (l.this new-line) - (l.this ")#") - (l.this "#("))) - -## Multi-line comments are bounded by #( these delimiters, #(and, they may -## also be nested)# )#. -## Multi-line comment syntax must be balanced. -## That is, any nested comment must have matched delimiters. -## Unbalanced comments ought to be rejected as invalid code. -(def: (multi-line-comment^ where) - (-> Cursor (Lexer [Cursor Text])) - (do p.Monad<Parser> - [_ (l.this "#(")] - (loop [comment "" - where (update@ #.column (n/+ 2) where)] - ($_ p.either - ## These are normal chunks of commented text. - (do @ - [chunk (l.many (l.not comment-bound^))] - (recur (format comment chunk) - (|> where - (update@ #.column (n/+ (text.size chunk)))))) - ## This is a special rule to handle new-lines within - ## comments properly. - (do @ - [_ (l.this new-line)] - (recur (format comment new-line) - (|> where - (update@ #.line inc) - (set@ #.column 0)))) - ## This is the rule for handling nested sub-comments. - ## Ultimately, the whole comment is just treated as text - ## (the comment must respect the syntax structure, but the - ## output produced is just a block of text). - ## That is why the sub-comment is covered in delimiters - ## and then appended to the rest of the comment text. - (do @ - [[sub-where sub-comment] (multi-line-comment^ where)] - (recur (format comment "#(" sub-comment ")#") - sub-where)) - ## Finally, this is the rule for closing the comment. - (do @ - [_ (l.this ")#")] - (wrap [(update@ #.column (n/+ 2) where) - comment])) - )))) - -## This is the only parser that should be used directly by other -## parsers, since all comments must be treated as either being -## single-line or multi-line. -## That is, there is no syntactic rule prohibiting one type of comment -## from being used in any situation (alternatively, forcing one type -## of comment to be the only usable one). -(def: (comment^ where) - (-> Cursor (Lexer [Cursor Text])) - (p.either (single-line-comment^ where) - (multi-line-comment^ where))) - -## To simplify parsing, I remove any left-padding that an Code token -## may have prior to parsing the token itself. -## Left-padding is assumed to be either white-space or a comment. -## The cursor gets updated, but the padding gets ignored. -(def: (left-padding^ where) - (-> Cursor (Lexer Cursor)) - ($_ p.either - (do p.Monad<Parser> - [[where comment] (comment^ where)] - (left-padding^ where)) - (do p.Monad<Parser> - [[where white-space] (space^ where)] - (left-padding^ where)) - (:: p.Monad<Parser> wrap where))) - -## Escaped character sequences follow the usual syntax of -## back-slash followed by a letter (e.g. \n). -## Unicode escapes are possible, with hexadecimal sequences between 1 -## and 4 characters long (e.g. \u12aB). -## Escaped characters may show up in Char and Text literals. -(def: escaped-char^ - (Lexer [Nat Text]) - (p.after (l.this "\\") - (do p.Monad<Parser> - [code l.any] - (case code - ## Handle special cases. - "t" (wrap [2 "\t"]) - "v" (wrap [2 "\v"]) - "b" (wrap [2 "\b"]) - "n" (wrap [2 "\n"]) - "r" (wrap [2 "\r"]) - "f" (wrap [2 "\f"]) - "\"" (wrap [2 "\""]) - "\\" (wrap [2 "\\"]) - - ## Handle unicode escapes. - "u" - (do p.Monad<Parser> - [code (l.between 1 4 l.hexadecimal)] - (wrap (case (:: number.Hex@Codec<Text,Nat> decode code) - (#.Right value) - [(n/+ 2 (text.size code)) (text.from-code value)] - - _ - (undefined)))) - - _ - (p.fail (format "Invalid escaping syntax: " (%t code))))))) +(def: #export prelude "lux") + +(def: #export space " ") + +(def: #export text-delimiter text.double-quote) + +(def: #export open-form "(") +(def: #export close-form ")") + +(def: #export open-tuple "[") +(def: #export close-tuple "]") + +(def: #export open-record "{") +(def: #export close-record "}") + +(def: #export sigil "#") + +(def: #export digit-separator "_") + +(def: #export positive-sign "+") +(def: #export negative-sign "-") + +(def: #export frac-separator ".") + +## The parts of an name are separated by a single mark. +## E.g. module.short. +## Only one such mark may be used in an name, since there +## can only be 2 parts to an name (the module [before the +## mark], and the short [after the mark]). +## There are also some extra rules regarding name syntax, +## encoded on the parser. +(def: #export name-separator ".") ## These are very simple parsers that just cut chunks of text in ## specific shapes and then use decoders already present in the @@ -211,73 +136,8 @@ (def: sign^ (l.one-of "+-")) -(do-template [<name> <tag> <lexer> <codec>] - [(def: #export (<name> where) - (-> Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [chunk <lexer>] - (case (:: <codec> decode chunk) - (#.Left error) - (p.fail error) - - (#.Right value) - (wrap [(update@ #.column (n/+ (text.size chunk)) where) - [where (<tag> value)]]))))] - - [int #.Int - (l.and sign^ rich-digits^) - number.Codec<Text,Int>] - - [rev #.Rev - (l.and (l.one-of ".") - rich-digits^) - number.Codec<Text,Rev>] - ) - -(def: (nat-char where) - (-> Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [_ (l.this "#\"") - [where' char] (: (Lexer [Cursor Text]) - ($_ p.either - ## Normal text characters. - (do @ - [normal (l.none-of "\\\"\n")] - (wrap [(|> where - (update@ #.column inc)) - normal])) - ## Must handle escaped - ## chars separately. - (do @ - [[chars-consumed char] escaped-char^] - (wrap [(|> where - (update@ #.column (n/+ chars-consumed))) - char])))) - _ (l.this "\"") - #let [char (maybe.assume (text.nth 0 char))]] - (wrap [(|> where' - (update@ #.column inc)) - [where (#.Nat char)]]))) - -(def: (normal-nat where) - (-> Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [chunk rich-digits^] - (case (:: number.Codec<Text,Nat> decode chunk) - (#.Left error) - (p.fail error) - - (#.Right value) - (wrap [(update@ #.column (n/+ (text.size chunk)) where) - [where (#.Nat value)]])))) - -(def: #export (nat where) - (-> Cursor (Lexer [Cursor Code])) - (p.either (normal-nat where) - (nat-char where))) - -(def: (normal-frac where) - (-> Cursor (Lexer [Cursor Code])) +(def: #export (frac where) + Syntax (do p.Monad<Parser> [chunk ($_ l.and sign^ @@ -297,341 +157,435 @@ (wrap [(update@ #.column (n/+ (text.size chunk)) where) [where (#.Frac value)]])))) -(def: frac-ratio-fragment - (Lexer Frac) - (<| (p.codec number.Codec<Text,Frac>) - (:: p.Monad<Parser> map (function (_ digits) - (format digits ".0"))) - rich-digits^)) - -(def: (ratio-frac where) - (-> Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [chunk ($_ l.and - (p.default "" (l.one-of "-")) - rich-digits^ - (l.one-of "/") - rich-digits^) - value (l.local chunk - (do @ - [signed? (l.this? "-") - numerator frac-ratio-fragment - _ (l.this? "/") - denominator frac-ratio-fragment - _ (p.assert "Denominator cannot be 0." - (not (f/= +0.0 denominator)))] - (wrap (|> numerator - (f/* (if signed? -1.0 +1.0)) - (f// denominator)))))] - (wrap [(update@ #.column (n/+ (text.size chunk)) where) - [where (#.Frac value)]]))) - -(def: #export (frac where) - (-> Cursor (Lexer [Cursor Code])) - (p.either (normal-frac where) - (ratio-frac where))) - -## This parser looks so complex because text in Lux can be multi-line -## and there are rules regarding how this is handled. -(def: #export (text where) - (-> Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [## Lux text "is delimited by double-quotes", as usual in most - ## programming languages. - _ (l.this "\"") - ## I must know what column the text body starts at (which is - ## always 1 column after the left-delimiting quote). - ## This is important because, when procesing subsequent lines, - ## they must all start at the same column, being left-padded with - ## as many spaces as necessary to be column-aligned. - ## This helps ensure that the formatting on the text in the - ## source-code matches the formatting of the Text value. - #let [offset-column (inc (get@ #.column where))] - [where' text-read] (: (Lexer [Cursor Text]) - ## I must keep track of how much of the - ## text body has been read, how far the - ## cursor has progressed, and whether I'm - ## processing a subsequent line, or just - ## processing normal text body. - (loop [text-read "" - where (|> where - (update@ #.column inc)) - must-have-offset? #0] - (p.either (if must-have-offset? - ## If I'm at the start of a - ## new line, I must ensure the - ## space-offset is at least - ## as great as the column of - ## the text's body's column, - ## to ensure they are aligned. - (do @ - [offset (l.many (l.one-of " ")) - #let [offset-size (text.size offset)]] - (if (n/>= offset-column offset-size) - ## Any extra offset - ## becomes part of the - ## text's body. - (recur (|> offset - (text.split offset-column) - (maybe.default (undefined)) - product.right - (format text-read)) - (|> where - (update@ #.column (n/+ offset-size))) - #0) - (p.fail (format "Each line of a multi-line text must have an appropriate offset!\n" - "Expected: " (%i (.int offset-column)) " columns.\n" - " Actual: " (%i (.int offset-size)) " columns.\n")))) - ($_ p.either - ## Normal text characters. - (do @ - [normal (l.many (l.none-of "\\\"\n"))] - (recur (format text-read normal) - (|> where - (update@ #.column (n/+ (text.size normal)))) - #0)) - ## Must handle escaped - ## chars separately. - (do @ - [[chars-consumed char] escaped-char^] - (recur (format text-read char) - (|> where - (update@ #.column (n/+ chars-consumed))) - #0)) - ## The text ends when it - ## reaches the right-delimiter. - (do @ - [_ (l.this "\"")] - (wrap [(update@ #.column inc where) - text-read])))) - ## If a new-line is - ## encountered, it gets - ## appended to the value and - ## the loop is alerted that the - ## next line must have an offset. - (do @ - [_ (l.this new-line)] - (recur (format text-read new-line) - (|> where - (update@ #.line inc) - (set@ #.column 0)) - #1)))))] - (wrap [where' - [where (#.Text text-read)]]))) - -## Form and tuple syntax is mostly the same, differing only in the -## delimiters involved. -## They may have an arbitrary number of arbitrary Code nodes as elements. -(do-template [<name> <tag> <open> <close>] - [(def: (<name> where ast) - (-> Cursor - (-> Cursor (Lexer [Cursor Code])) - (Lexer [Cursor Code])) - (do p.Monad<Parser> - [_ (l.this <open>) - [where' elems] (loop [elems (: (Row Code) - row.empty) - where where] - (p.either (do @ - [## Must update the cursor as I - ## go along, to keep things accurate. - [where' elem] (ast where)] - (recur (row.add elem elems) - where')) - (do @ - [## Must take into account any - ## padding present before the - ## end-delimiter. - where' (left-padding^ where) - _ (l.this <close>)] - (wrap [(update@ #.column inc where') - (row.to-list elems)]))))] - (wrap [where' - [where (<tag> elems)]])))] - - [form #.Form "(" ")"] - [tuple #.Tuple "[" "]"] - ) - -## Records are almost (syntactically) the same as forms and tuples, -## with the exception that their elements must come in pairs (as in -## key-value pairs). -## Semantically, though, records and tuples are just 2 different -## representations for the same thing (a tuple). -## In normal Lux syntax, the key position in the pair will be a tag -## Code node, however, record Code nodes allow any Code node to occupy -## this position, since it may be useful when processing Code syntax in -## macros. -(def: (record where ast) - (-> Cursor - (-> Cursor (Lexer [Cursor Code])) - (Lexer [Cursor Code])) - (do p.Monad<Parser> - [_ (l.this "{") - [where' elems] (loop [elems (: (Row [Code Code]) - row.empty) - where where] - (p.either (do @ - [[where' key] (ast where) - [where' val] (ast where')] - (recur (row.add [key val] elems) - where')) - (do @ - [where' (left-padding^ where) - _ (l.this "}")] - (wrap [(update@ #.column inc where') - (row.to-list elems)]))))] - (wrap [where' - [where (#.Record elems)]]))) - -## The parts of an name are separated by a single mark. -## E.g. module.short. -## Only one such mark may be used in an name, since there -## can only be 2 parts to an name (the module [before the -## mark], and the short [after the mark]). -## There are also some extra rules regarding name syntax, -## encoded on the parser. -(def: name-separator Text ".") - -## A Lux name is a pair of chunks of text, where the first-part -## refers to the module that gives context to the name, and the -## second part corresponds to the short of the name itself. -## The module part may be absent (by being the empty text ""), but the -## name part must always be present. -## The rules for which characters you may use are specified in terms -## of which characters you must avoid (to keep things as open-ended as -## possible). -## In particular, no white-space can be used, and neither can other -## characters which are already used by Lux as delimiters for other -## Code nodes (thereby reducing ambiguity while parsing). -## Additionally, the first character in an name's part cannot be -## a digit, to avoid confusion with regards to numbers. -(def: name-part^ - (Lexer Text) - (do p.Monad<Parser> - [#let [digits "0123456789" - delimiters (format "()[]{}#\"" name-separator) - space (format white-space new-line) - head-lexer (l.none-of (format digits delimiters space)) - tail-lexer (l.some (l.none-of (format delimiters space)))] - head head-lexer - tail tail-lexer] - (wrap (format head tail)))) - -(def: current-module-mark Text (format name-separator name-separator)) - -(def: (name^ current-module aliases) - (-> Text Aliases (Lexer [Name Nat])) - ($_ p.either - ## When an name starts with 2 marks, its module is - ## taken to be the current-module being compiled at the moment. - ## This can be useful when mentioning names and tags - ## inside quoted/templated code in macros. - (do p.Monad<Parser> - [_ (l.this current-module-mark) - def-name name-part^] - (wrap [[current-module def-name] - (n/+ 2 (text.size def-name))])) - ## If the name is prefixed by the mark, but no module - ## part, the module is assumed to be "lux" (otherwise known as - ## the 'prelude'). - ## This makes it easy to refer to definitions in that module, - ## since it is the most fundamental module in the entire - ## standard library. - (do p.Monad<Parser> - [_ (l.this name-separator) - def-name name-part^] - (wrap [["lux" def-name] - (inc (text.size def-name))])) - ## Not all names must be specified with a module part. - ## If that part is not provided, the name will be created - ## with the empty "" text as the module. - ## During program analysis, such names tend to be treated - ## as if their context is the current-module, but this only - ## applies to names for tags and module definitions. - ## Function arguments and local-variables may not be referred-to - ## using names with module parts, so being able to specify - ## names with empty modules helps with those use-cases. - (do p.Monad<Parser> - [first-part name-part^] - (p.either (do @ - [_ (l.this name-separator) - second-part name-part^] - (wrap [[(|> aliases (dictionary.get first-part) (maybe.default first-part)) - second-part] - ($_ n/+ - (text.size first-part) - 1 - (text.size second-part))])) - (wrap [["" first-part] - (text.size first-part)]))))) - -(do-template [<name> <pre> <tag> <length>] - [(def: #export (<name> current-module aliases where) - (-> Text Aliases Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [[value length] (<| <pre> - (name^ current-module aliases))] - (wrap [(update@ #.column (|>> (n/+ <length>)) where) - [where (<tag> value)]])))] - - [tag (p.after (l.this "#")) #.Tag (n/+ 1 length)] - [identifier (|>) #.Identifier length] - ) +(exception: #export (end-of-file {module Text}) + (ex.report ["Module" (%t module)])) -(do-template [<name> <value>] - [(def: <name> - (Lexer Bit) - (:: p.Monad<Parser> map (function.constant <value>) (l.this (%b <value>))))] +(def: amount-of-input-shown 64) - [false #0] - [true #1] - ) +(exception: #export (unrecognized-input {[file line column] Cursor} {context Text} {input Text} {offset Offset}) + (let [end-offset (|> offset (n/+ amount-of-input-shown) (n/min ("lux text size" input)))] + (ex.report ["File" file] + ["Line" (%n line)] + ["Column" (%n column)] + ["Context" (%t context)] + ["Input" (!clip offset end-offset input)]))) -(def: #export (bit where) - (-> Cursor (Lexer [Cursor Code])) - (do p.Monad<Parser> - [value (p.either ..false ..true)] - (wrap [(update@ #.column (|>> (n/+ 2)) where) - [where (#.Bit value)]]))) +(exception: #export (text-cannot-contain-new-lines {text Text}) + (ex.report ["Text" (%t text)])) -(exception: #export (end-of-file {module Text}) - (ex.report ["Module" (%t module)])) +(exception: #export (invalid-escape-syntax) + "") -(exception: #export (unrecognized-input {[file line column] Cursor}) - (ex.report ["File" (%t file)] - ["Line" (%n line)] - ["Column" (%n column)])) +(exception: #export (cannot-close-composite-expression {closing-char Char}) + (ex.report ["Closing Character" (text.from-code closing-char)])) (def: (ast current-module aliases) - (-> Text Aliases Cursor (Lexer [Cursor Code])) + (-> Text Aliases Syntax) (function (ast' where) - (do p.Monad<Parser> - [where (left-padding^ where)] - ($_ p.either - (..form where ast') - (..tuple where ast') - (..record where ast') - (..text where) - (..nat where) - (..frac where) - (..int where) - (..rev where) - (..bit where) - (..identifier current-module aliases where) - (..tag current-module aliases where) - (do @ - [end? l.end?] - (if end? - (p.fail (ex.construct end-of-file current-module)) - (p.fail (ex.construct unrecognized-input where)))) - )))) - -(def: #export (read current-module aliases [where offset source-code]) - (-> Text Aliases Source (e.Error [Source Code])) - (case (p.run [offset source-code] (ast current-module aliases where)) - (#e.Error error) - (#e.Error error) - - (#e.Success [[offset' remaining] [where' output]]) - (#e.Success [[where' offset' remaining] output]))) + ($_ p.either + (..frac where) + ))) + +(type: Parser + (-> Source (Error [Source Code]))) + +(template: (!with-char+ @source-code-size @source-code @offset @char @else @body) + (if (!i/< (:coerce Int @source-code-size) + (:coerce Int @offset)) + (let [@char ("lux text char" @source-code @offset)] + @body) + @else)) + +(template: (!with-char @source-code @offset @char @else @body) + (!with-char+ ("lux text size" @source-code) @source-code @offset @char @else @body)) + +(def: close-signal "CLOSE") + +(def: (read-close closing-char source-code//size source-code offset) + (-> Char Nat Text Offset (Error Offset)) + (loop [end offset] + (<| (!with-char+ source-code//size source-code end char (ex.throw cannot-close-composite-expression closing-char) + (if (!n/= closing-char char) + (#error.Success (!inc end)) + (`` ("lux syntax char case!" char + [[(~~ (static ..space)) + (~~ (static text.carriage-return)) + (~~ (static text.new-line))] + (recur (!inc end))] + + ## else + (ex.throw cannot-close-composite-expression closing-char)))))))) + +(`` (do-template [<name> <close> <tag> <context>] + [(def: (<name> parse source) + (-> Parser Parser) + (let [[_ _ source-code] source + source-code//size ("lux text size" source-code)] + (loop [source source + stack (: (List Code) #.Nil)] + (case (parse source) + (#error.Success [source' top]) + (recur source' (#.Cons top stack)) + + (#error.Error error) + (let [[where offset _] source] + (case (read-close (char <close>) source-code//size source-code offset) + (#error.Success offset') + (#error.Success [[(update@ #.column inc where) offset' source-code] + [where (<tag> (list.reverse stack))]]) + + (#error.Error error) + (#error.Error error)))))))] + + ## Form and tuple syntax is mostly the same, differing only in the + ## delimiters involved. + ## They may have an arbitrary number of arbitrary Code nodes as elements. + [parse-form (~~ (static ..close-form)) #.Form "Form"] + [parse-tuple (~~ (static ..close-tuple)) #.Tuple "Tuple"] + )) + +(def: (parse-record parse source) + (-> Parser Parser) + (let [[_ _ source-code] source + source-code//size ("lux text size" source-code)] + (loop [source source + stack (: (List [Code Code]) #.Nil)] + (case (parse source) + (#error.Success [sourceF field]) + (case (parse sourceF) + (#error.Success [sourceFV value]) + (recur sourceFV (#.Cons [field value] stack)) + + (#error.Error error) + (#error.Error error)) + + (#error.Error error) + (let [[where offset _] source] + (<| (!with-char+ source-code//size source-code offset closing-char (#error.Error error)) + (case (read-close (`` (char (~~ (static ..close-record)))) source-code//size source-code offset) + (#error.Success offset') + (#error.Success [[(update@ #.column inc where) offset' source-code] + [where (#.Record (list.reverse stack))]]) + + (#error.Error error) + (#error.Error error)))))))) + +(template: (!guarantee-no-new-lines content body) + (case ("lux text index" content (static text.new-line) 0) + (#.Some g!_) + (ex.throw ..text-cannot-contain-new-lines content) + + g!_ + body)) + +(template: (!read-text where offset source-code) + (case ("lux text index" source-code (static ..text-delimiter) offset) + (#.Some g!end) + (let [g!content (!clip offset g!end source-code)] + (<| (!guarantee-no-new-lines g!content) + (#error.Success [[(update@ #.column (n/+ (!n/- offset g!end)) where) + (!inc g!end) + source-code] + [where + (#.Text g!content)]]))) + + _ + (ex.throw unrecognized-input [where "Text" source-code offset]))) + +(def: digit-bottom Nat (!dec (char "0"))) +(def: digit-top Nat (!inc (char "9"))) + +(template: (!digit? char) + (and (!i/< (:coerce Int char) (:coerce Int (static ..digit-bottom))) + (!i/< (:coerce Int (static ..digit-top)) (:coerce Int char)))) + +(`` (template: (!digit?+ char) + (or (!digit? char) + ("lux i64 =" (.char (~~ (static ..digit-separator))) char)))) + +(`` (template: (!strict-name-char? char) + (not (or ("lux i64 =" (.char (~~ (static ..space))) char) + ("lux i64 =" (.char (~~ (static text.new-line))) char) + + ("lux i64 =" (.char (~~ (static ..name-separator))) char) + + ("lux i64 =" (.char (~~ (static ..open-form))) char) + ("lux i64 =" (.char (~~ (static ..close-form))) char) + + ("lux i64 =" (.char (~~ (static ..open-tuple))) char) + ("lux i64 =" (.char (~~ (static ..close-tuple))) char) + + ("lux i64 =" (.char (~~ (static ..open-record))) char) + ("lux i64 =" (.char (~~ (static ..close-record))) char) + + ("lux i64 =" (.char (~~ (static ..text-delimiter))) char) + ("lux i64 =" (.char (~~ (static ..sigil))) char))))) + +(template: (!name-char?|head char) + (and (!strict-name-char? char) + (not (!digit? char)))) + +(template: (!name-char? char) + (or (!strict-name-char? char) + (!digit? char))) + +(template: (!number-output <start> <end> <codec> <tag>) + (case (:: <codec> decode (!clip <start> <end> source-code)) + (#error.Success output) + (#error.Success [[(update@ #.column (n/+ (!n/- <start> <end>)) where) + <end> + source-code] + [where (<tag> output)]]) + + (#error.Error error) + (#error.Error error))) + +(def: no-exponent Offset 0) + +(with-expansions [<int-output> (as-is (!number-output start end number.Codec<Text,Int> #.Int)) + <frac-output> (as-is (!number-output start end number.Codec<Text,Frac> #.Frac)) + <failure> (ex.throw unrecognized-input [where "Frac" source-code offset])] + (def: (parse-frac source-code//size start [where offset source-code]) + (-> Nat Offset Parser) + (loop [end offset + exponent ..no-exponent] + (<| (!with-char+ source-code//size source-code end char/0 <frac-output>) + (cond (!digit?+ char/0) + (recur (!inc end) exponent) + + (and (or (!n/= (char "e") char/0) + (!n/= (char "E") char/0)) + (not (is? ..no-exponent exponent))) + (<| (!with-char+ source-code//size source-code (!inc end) char/1 <failure>) + (if (or (!n/= (`` (char (~~ (static ..positive-sign)))) char/1) + (!n/= (`` (char (~~ (static ..negative-sign)))) char/1)) + (<| (!with-char+ source-code//size source-code (!n/+ 2 end) char/2 <failure>) + (if (!digit?+ char/2) + (recur (!n/+ 3 end) char/0) + <failure>)) + <failure>)) + + ## else + <frac-output>)))) + + (def: (parse-signed start [where offset source-code]) + (-> Offset Parser) + (let [source-code//size ("lux text size" source-code)] + (loop [end offset] + (<| (!with-char+ source-code//size source-code end char <int-output>) + (cond (!digit?+ char) + (recur (!inc end)) + + (!n/= (`` (.char (~~ (static ..frac-separator)))) + char) + (parse-frac source-code//size start [where (!inc end) source-code]) + + ## else + <int-output>)))))) + +(do-template [<name> <codec> <tag>] + [(template: (<name> source-code//size start where offset source-code) + (loop [g!end offset] + (<| (!with-char+ source-code//size source-code g!end g!char (!number-output start g!end <codec> <tag>)) + (if (!digit?+ g!char) + (recur (!inc g!end)) + (!number-output start g!end <codec> <tag>)))))] + + [!parse-nat number.Codec<Text,Nat> #.Nat] + [!parse-rev number.Codec<Text,Rev> #.Rev] + ) + +(template: (!parse-signed source-code//size offset where source-code @end) + (let [g!offset/1 (!inc offset)] + (<| (!with-char+ source-code//size source-code g!offset/1 g!char/1 @end) + (if (!digit? g!char/1) + (parse-signed offset [where (!inc/2 offset) source-code]) + (!parse-full-name offset [where (!inc offset) source-code] where #.Identifier))))) + +(with-expansions [<output> (#error.Success [[(update@ #.column (n/+ (!n/- start end)) where) + end + source-code] + (!clip start end source-code)])] + (def: (parse-name-part start [where offset source-code]) + (-> Offset Source (Error [Source Text])) + (let [source-code//size ("lux text size" source-code)] + (loop [end offset] + (<| (!with-char+ source-code//size source-code end char <output>) + (if (!name-char? char) + (recur (!inc end)) + <output>)))))) + +(template: (!new-line where) + (let [[where::file where::line where::column] where] + [where::file (!inc where::line) 0])) + +(with-expansions [<end> (ex.throw end-of-file current-module) + <failure> (ex.throw unrecognized-input [where "General" source-code offset/0]) + <close!> (#error.Error (`` (~~ (static close-signal)))) + <consume-1> (as-is [where (!inc offset/0) source-code]) + <consume-2> (as-is [where (!inc/2 offset/0) source-code])] + + (template: (!parse-half-name @offset @char @module) + (cond (!name-char?|head @char) + (case (..parse-name-part @offset [where (!inc @offset) source-code]) + (#error.Success [source' name]) + (#error.Success [source' [@module name]]) + + (#error.Error error) + (#error.Error error)) + + ## else + <failure>)) + + (`` (def: (parse-short-name current-module [where offset/0 source-code]) + (-> Text Source (Error [Source Name])) + (<| (!with-char source-code offset/0 char/0 <end>) + (if (!n/= (char (~~ (static ..name-separator))) char/0) + (let [offset/1 (!inc offset/0)] + (<| (!with-char source-code offset/1 char/1 <end>) + (!parse-half-name offset/1 char/1 current-module))) + (!parse-half-name offset/0 char/0 ..prelude))))) + + (template: (!parse-short-name @current-module @source @where @tag) + (case (..parse-short-name @current-module @source) + (#error.Success [source' name]) + (#error.Success [source' [@where (@tag name)]]) + + (#error.Error error) + (#error.Error error))) + + (with-expansions [<simple> (as-is (#error.Success [source' ["" simple]]))] + (`` (def: (parse-full-name start source) + (-> Offset Source (Error [Source Name])) + (case (..parse-name-part start source) + (#error.Success [source' simple]) + (let [[where' offset' source-code'] source'] + (<| (!with-char source-code' offset' char/separator <simple>) + (if (!n/= (char (~~ (static ..name-separator))) char/separator) + (let [offset'' (!inc offset')] + (case (..parse-name-part offset'' [where' offset'' source-code']) + (#error.Success [source'' complex]) + (#error.Success [source'' [simple complex]]) + + (#error.Error error) + (#error.Error error))) + <simple>))) + + (#error.Error error) + (#error.Error error))))) + + (template: (!parse-full-name @offset @source @where @tag) + (case (..parse-full-name @offset @source) + (#error.Success [source' full-name]) + (#error.Success [source' [@where (@tag full-name)]]) + + (#error.Error error) + (#error.Error error))) + + (`` (template: (<<closers>>) + [(~~ (static ..close-form)) + (~~ (static ..close-tuple)) + (~~ (static ..close-record))])) + + (with-expansions [<parse> (as-is (parse current-module aliases source-code//size)) + <horizontal-move> (as-is (recur [(update@ #.column inc where) + (!inc offset/0) + source-code]))] + (def: #export (parse current-module aliases source-code//size) + (-> Text Aliases Nat (-> Source (Error [Source Code]))) + ## The "exec []" is only there to avoid function fusion. + ## This is to preserve the loop as much as possible and keep it tight. + (exec [] + (function (recur [where offset/0 source-code]) + (<| (!with-char+ source-code//size source-code offset/0 char/0 <end>) + ## The space was singled-out for special treatment + ## because of how common it is. + (`` (if (!n/= (char (~~ (static ..space))) char/0) + <horizontal-move> + ("lux syntax char case!" char/0 + [## New line + [(~~ (static text.carriage-return))] + <horizontal-move> + + [(~~ (static text.new-line))] + (recur [(!new-line where) (!inc offset/0) source-code]) + + ## Form + [(~~ (static ..open-form))] + (parse-form <parse> <consume-1>) + + ## Tuple + [(~~ (static ..open-tuple))] + (parse-tuple <parse> <consume-1>) + + ## Record + [(~~ (static ..open-record))] + (parse-record <parse> <consume-1>) + + ## Text + [(~~ (static ..text-delimiter))] + (let [offset/1 (!inc offset/0)] + (!read-text where offset/1 source-code)) + + ## Special code + [(~~ (static ..sigil))] + (let [offset/1 (!inc offset/0)] + (<| (!with-char+ source-code//size source-code offset/1 char/1 <end>) + ("lux syntax char case!" char/1 + [(~~ (do-template [<char> <bit>] + [[<char>] + (#error.Success [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) + source-code] + [where (#.Bit <bit>)]])] + + ["0" #0] + ["1" #1])) + + ## Single-line comment + [(~~ (static ..sigil))] + (case ("lux text index" source-code (static text.new-line) offset/1) + (#.Some end) + (recur [(!new-line where) (!inc end) source-code]) + + _ + <end>) + + [(~~ (static ..name-separator))] + (!parse-short-name current-module <consume-2> where #.Tag)] + + ## else + (cond (!name-char?|head char/1) ## Tag + (!parse-full-name offset/1 <consume-2> where #.Tag) + + ## else + <failure>)))) + + ## Coincidentally (= name-separator frac-separator) + [(~~ (static ..name-separator))] + (let [offset/1 (!inc offset/0)] + (<| (!with-char+ source-code//size source-code offset/1 char/1 <end>) + (if (!digit? char/1) + (let [offset/2 (!inc offset/1)] + (!parse-rev source-code//size offset/0 where offset/2 source-code)) + (!parse-short-name current-module [where offset/1 source-code] where #.Identifier)))) + + [(~~ (static ..positive-sign)) + (~~ (static ..negative-sign))] + (!parse-signed source-code//size offset/0 where source-code <end>) + + ## Invalid characters at this point... + (~~ (<<closers>>)) + <close!>] + + ## else + (if (!digit? char/0) + ## Natural number + (let [offset/1 (!inc offset/0)] + (!parse-nat source-code//size offset/0 where offset/1 source-code)) + ## Identifier + (!parse-full-name offset/0 <consume-1> where #.Identifier)) + ))) + ))) + )) + ) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index a9154877e..0af0d09f9 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -140,8 +140,8 @@ #end default-end}) (def: #export (poison actor) - {#.doc "Kills the actor by sending a message that will kill it upon processing, - but allows the actor to handle previous messages."} + {#.doc (doc "Kills the actor by sending a message that will kill it upon processing," + "but allows the actor to handle previous messages.")} (All [s] (-> (Actor s) (IO Bit))) (send (function (_ state self) (task.throw poisoned [])) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index b0c016a12..c04930171 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -33,19 +33,16 @@ (AtomicReference::get [] (:representation atom))}))) (def: #export (compare-and-swap current new atom) - {#.doc "Only mutates an atom if you can present it's current value. - - That guarantees that atom was not updated since you last read from it."} + {#.doc (doc "Only mutates an atom if you can present it's current value." + "That guarantees that atom was not updated since you last read from it.")} (All [a] (-> a a (Atom a) (IO Bit))) (io (AtomicReference::compareAndSet [current new] (:representation atom)))) )) (def: #export (update f atom) - {#.doc "Updates an atom by applying a function to its current value. - - If it fails to update it (because some other process wrote to it first), it will retry until it succeeds. - - The retries will be done with the new values of the atom, as they show up."} + {#.doc (doc "Updates an atom by applying a function to its current value." + "If it fails to update it (because some other process wrote to it first), it will retry until it succeeds." + "The retries will be done with the new values of the atom, as they show up.")} (All [a] (-> (-> a a) (Atom a) (IO a))) (loop [_ []] (do io.Monad<IO> diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index d736baf2e..3c6691acc 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -232,11 +232,9 @@ ))) (def: #export (commit stm-proc) - {#.doc "Commits a transaction and returns its result (asynchronously). - - Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first. - - For this reason, it's important to note that transactions must be free from side-effects, such as I/O."} + {#.doc (doc "Commits a transaction and returns its result (asynchronously)." + "Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first." + "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} (All [a] (-> (STM a) (Promise a))) (let [output (promise #.None)] (exec (io.run init-processor!) diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index 23a059ae4..2d96364ad 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -8,9 +8,8 @@ ## [Signatures] (signature: #export (CoMonad w) - {#.doc "CoMonads are the opposite/complement to monads. - - CoMonadic structures are often infinite in size and built upon lazily-evaluated functions."} + {#.doc (doc "CoMonads are the opposite/complement to monads." + "CoMonadic structures are often infinite in size and built upon lazily-evaluated functions.")} (: (F.Functor w) functor) (: (All [a] @@ -29,7 +28,7 @@ (def: _cursor Cursor ["" 0 0]) (macro: #export (be tokens state) - {#.doc (doc "A co-monadic parallel to the \"do\" macro." + {#.doc (doc "A co-monadic parallel to the 'do' macro." (let [square (function (_ n) (i/* n n))] (be CoMonad<Stream> [inputs (iterate inc +2)] diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 0011c8956..80fa1b40e 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -63,7 +63,7 @@ (wrap singleton) _ - (macro.fail (format "Cannot expand to more than a single AST/Code node:\n" + (macro.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line (|> expansion (list/map %code) (text.join-with " "))))))) (syntax: #export (=> {aliases aliases^} diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index d2e9c705d..a906c97aa 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -31,9 +31,8 @@ (text.starts-with? (get@ #label exception) error)) (def: #export (catch exception then try) - {#.doc "If a particular exception is detected on a possibly-erroneous value, handle it. - - If no exception was detected, or a different one from the one being checked, then pass along the original value."} + {#.doc (doc "If a particular exception is detected on a possibly-erroneous value, handle it." + "If no exception was detected, or a different one from the one being checked, then pass along the original value.")} (All [e a] (-> (Exception e) (-> Text a) (Error a) (Error a))) @@ -99,7 +98,7 @@ (macro.with-gensyms [g!descriptor] (do @ [current-module macro.current-module-name - #let [descriptor ($_ text/compose "{" current-module "." name "}" "\n") + #let [descriptor ($_ text/compose "{" current-module "." name "}" text.new-line) g!self (code.local-identifier name)]] (wrap (list (` (def: (~+ (csw.export export)) (~ g!self) @@ -123,7 +122,7 @@ (list.repeat (n/- (text.size header) largest-header-size)) (text.join-with ""))] - ($_ text/compose padding header ": " message "\n")))) + ($_ text/compose padding header ": " message text.new-line)))) (text.join-with "")))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) @@ -133,9 +132,9 @@ (def: separator ($_ "lux text concat" - "\n\n" + text.new-line text.new-line "-----------------------------------------" - "\n\n")) + text.new-line text.new-line)) (def: #export (with-stack exception message computation) (All [e a] (-> (Exception e) e (Error a) (Error a))) diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux index aa668c7c7..4e50c3658 100644 --- a/stdlib/source/lux/control/hash.lux +++ b/stdlib/source/lux/control/hash.lux @@ -4,9 +4,8 @@ ## [Signatures] (signature: #export (Hash a) - {#.doc "A way to produce hash-codes for a type's instances. - - A necessity when working with some data-structures, such as dictionaries or sets."} + {#.doc (doc "A way to produce hash-codes for a type's instances." + "A necessity when working with some data-structures, such as dictionaries or sets.")} (: (Equivalence a) eq) (: (-> a Nat) diff --git a/stdlib/source/lux/control/monoid.lux b/stdlib/source/lux/control/monoid.lux index 4976830b6..7d89043a8 100644 --- a/stdlib/source/lux/control/monoid.lux +++ b/stdlib/source/lux/control/monoid.lux @@ -3,9 +3,8 @@ [// [fold (#+ Fold)]]) (signature: #export (Monoid a) - {#.doc "A way to compose values. - - Includes an identity value which does not alter any other value when combined with."} + {#.doc (doc "A way to compose values." + "Includes an identity value which does not alter any other value when combined with.")} (: a identity) (: (-> a a a) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 4895a4f66..a5f9eca95 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -128,7 +128,7 @@ (tuple> [(i/* +10)] [dec (i// +2)] [Int/encode])) - "Will become: [+50 +2 \"+5\"]")} + "Will become: [+50 +2 '+5']")} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] [(~+ (list/map (function (_ body) (` (|> (~ g!temp) (~+ body)))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 7bd43bd09..cfd074f6b 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -7,7 +7,7 @@ ["ex" exception (#+ Exception exception:)]] [data ["e" error (#+ Error)] - [text + ["." text format] [collection [list ("list/." Fold<List>)]]]]) @@ -22,11 +22,11 @@ (def: separator Text - (format "\n" - "-----------------------------------------\n" - "-----------------------------------------\n" - "-----------------------------------------\n" - "\n")) + (format text.new-line + "-----------------------------------------" text.new-line + "-----------------------------------------" text.new-line + "-----------------------------------------" text.new-line + text.new-line)) (exception: #export [a] (clean-up-error {error Text} {output (Error a)}) diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index 026f8bcab..8cf671429 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -45,7 +45,7 @@ ## [Values] (def: #export complement - {#.doc "Generates the complement of a predicate. - That is a predicate that returns the oposite of the original predicate."} + {#.doc (doc "Generates the complement of a predicate." + "That is a predicate that returns the oposite of the original predicate.")} (All [a] (-> (-> a Bit) (-> a Bit))) (compose not)) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index e61d657a5..503ea312d 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -623,18 +623,16 @@ ) (def: #export (merge dict2 dict1) - {#.doc "Merges 2 dictionaries. - - If any collisions with keys occur, the values of dict2 will overwrite those of dict1."} + {#.doc (doc "Merges 2 dictionaries." + "If any collisions with keys occur, the values of dict2 will overwrite those of dict1.")} (All [k v] (-> (Dictionary k v) (Dictionary k v) (Dictionary k v))) (list/fold (function (_ [key val] dict) (put key val dict)) dict1 (entries dict2))) (def: #export (merge-with f dict2 dict1) - {#.doc "Merges 2 dictionaries. - - If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1."} + {#.doc (doc "Merges 2 dictionaries." + "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")} (All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) (list/fold (function (_ [key val2] dict) (case (get key dict) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index d11f0a080..c49a7ba9f 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -53,9 +53,8 @@ [(filter p xs) (filter (complement p) xs)]) (def: #export (as-pairs xs) - {#.doc "Cut the list into pairs of 2. - - Caveat emptor: If the list has an uneven number of elements, the last one will be skipped."} + {#.doc (doc "Cut the list into pairs of 2." + "Caveat emptor: If the list has an uneven number of elements, the last one will be skipped.")} (All [a] (-> (List a) (List [a a]))) (case xs (^ (#.Cons [x1 (#.Cons [x2 xs'])])) @@ -436,8 +435,8 @@ (identifier$ ("lux text concat" base "'"))])))) pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) vars+lists))]) - g!step (identifier$ "\tstep\t") - g!blank (identifier$ "\t_\t") + g!step (identifier$ "0step0") + g!blank (identifier$ "0_0") list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function ((~ g!step) (~+ list-vars)) @@ -467,8 +466,8 @@ (if (n/> 0 num-lists) (let [(^open ".") Functor<List> indices (..indices num-lists) - g!return-type (identifier$ "\treturn-type\t") - g!func (identifier$ "\tfunc\t") + g!return-type (identifier$ "0return-type0") + g!func (identifier$ "0func0") type-vars (: (List Code) (map (|>> nat/encode identifier$) indices)) zip-type (` (All [(~+ type-vars) (~ g!return-type)] (-> (-> (~+ type-vars) (~ g!return-type)) @@ -483,8 +482,8 @@ (identifier$ ("lux text concat" base "'"))])))) pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) vars+lists))]) - g!step (identifier$ "\tstep\t") - g!blank (identifier$ "\t_\t") + g!step (identifier$ "0step0") + g!blank (identifier$ "0_0") list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function ((~ g!step) (~ g!func) (~+ list-vars)) @@ -517,9 +516,8 @@ (last xs'))) (def: #export (inits xs) - {#.doc "For a list of size N, returns the first N-1 elements. - - Empty lists will result in a #.None value being returned instead."} + {#.doc (doc "For a list of size N, returns the first N-1 elements." + "Empty lists will result in a #.None value being returned instead.")} (All [a] (-> (List a) (Maybe (List a)))) (case xs #.Nil diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index 6529a1ced..06209f4d6 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -41,9 +41,8 @@ (pending [x (repeat x)])) (def: #export (cycle xs) - {#.doc "Go over the elements of a list forever. - - The list should not be empty."} + {#.doc (doc "Go over the elements of a list forever." + "The list should not be empty.")} (All [a] (-> (List a) (Maybe (Sequence a)))) (case xs @@ -111,11 +110,9 @@ (filter p xs')))) (def: #export (partition p xs) - {#.doc "Split a sequence in two based on a predicate. - - The left side contains all entries for which the predicate is #1. - - The right side contains all entries for which the predicate is #0."} + {#.doc (doc "Split a sequence in two based on a predicate." + "The left side contains all entries for which the predicate is #1." + "The right side contains all entries for which the predicate is #0.")} (All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)])) [(filter p xs) (filter (complement p) xs)]) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 083195972..fbdad1885 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -37,7 +37,7 @@ (if (list.empty? style) "" (format selector "{" (inline style) "}")))) - (text.join-with "\n"))) + (text.join-with text.new-line))) (def: #export (rgb color) (-> Color Value) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index cc5e6d0e9..45a7117ad 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -18,7 +18,7 @@ (text.replace-all "&" "&") (text.replace-all "<" "<") (text.replace-all ">" ">") - (text.replace-all "\"" """) + (text.replace-all text.double-quote """) (text.replace-all "'" "'") (text.replace-all "/" "/"))) @@ -28,7 +28,7 @@ (def: attrs-to-text (-> Attributes Text) - (|>> (list/map (function (_ [key val]) (format key "=" "\"" (text val) "\""))) + (|>> (list/map (function (_ [key val]) (format key "=" text.double-quote (text val) text.double-quote))) (text.join-with " "))) (def: #export (tag name attrs children) @@ -39,13 +39,15 @@ "</" name ">")) (do-template [<name> <doc-type>] - [(def: #export (<name> document) + [(def: #export <name> (-> HTML HTML) - (format <doc-type> - document))] + (let [doc-type <doc-type>] + (function (_ document) + (format doc-type + document))))] [html-5 "<!DOCTYPE html>"] - [html-4_01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"] - [xhtml-1_0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"] - [xhtml-1_1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"] + [html-4_01 (format "<!DOCTYPE HTML PUBLIC " text.double-quote "-//W3C//DTD HTML 4.01//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/html4/strict.dtd" text.double-quote ">")] + [xhtml-1_0 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double-quote ">")] + [xhtml-1_1 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.1//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double-quote ">")] ) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 3594ef28c..20f059503 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,6 +1,5 @@ -(.module: {#.doc "Functionality for reading and writing values in the JSON format. - - For more information, please see: http://www.json.org/"} +(.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." + "For more information, please see: http://www.json.org/")} [lux #* [control ["." monad (#+ do Monad)] @@ -114,10 +113,10 @@ (#e.Success value) #.None - (#e.Error ($_ text/compose "Missing field \"" key "\" on object."))) + (#e.Error ($_ text/compose "Missing field '" key "' on object."))) _ - (#e.Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get field '" key "' of a non-object.")))) (def: #export (set key value json) {#.doc "A JSON object field setter."} @@ -127,7 +126,7 @@ (#e.Success (#Object (dict.put key value obj))) _ - (#e.Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot set field '" key "' of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) @@ -353,7 +352,7 @@ (fail error)) _ - (fail ($_ text/compose "JSON object does not have field \"" field-name "\"."))) + (fail ($_ text/compose "JSON object does not have field '" field-name "'."))) _ (fail "JSON value is not an object.")))) @@ -453,22 +452,29 @@ (def: escaped~ (l.Lexer Text) ($_ p.either - (p.after (l.this "\\t") (parser/wrap "\t")) - (p.after (l.this "\\b") (parser/wrap "\b")) - (p.after (l.this "\\n") (parser/wrap "\n")) - (p.after (l.this "\\r") (parser/wrap "\r")) - (p.after (l.this "\\f") (parser/wrap "\f")) - (p.after (l.this "\\\"") (parser/wrap "\"")) - (p.after (l.this "\\\\") (parser/wrap "\\")))) + (p.after (l.this "\t") + (parser/wrap text.tab)) + (p.after (l.this "\b") + (parser/wrap text.back-space)) + (p.after (l.this "\n") + (parser/wrap text.new-line)) + (p.after (l.this "\r") + (parser/wrap text.carriage-return)) + (p.after (l.this "\f") + (parser/wrap text.form-feed)) + (p.after (l.this (text/compose "\" text.double-quote)) + (parser/wrap text.double-quote)) + (p.after (l.this "\\") + (parser/wrap "\")))) (def: string~ (l.Lexer String) - (<| (l.enclosed ["\"" "\""]) + (<| (l.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do p.Monad<Parser> - [chars (l.some (l.none-of "\\\"")) + [chars (l.some (l.none-of (text/compose "\" text.double-quote))) stop l.peek]) - (if (text/= "\\" stop) + (if (text/= "\" stop) (do @ [escaped escaped~ next-chars (recur [])] diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 61215813b..0ed744b46 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -33,7 +33,7 @@ (p.after (l.this ">") (parser/wrap ">")) (p.after (l.this "&") (parser/wrap "&")) (p.after (l.this "'") (parser/wrap "'")) - (p.after (l.this """) (parser/wrap "\"")))) + (p.after (l.this """) (parser/wrap text.double-quote)))) (def: xml-unicode-escape-char^ (l.Lexer Text) @@ -56,7 +56,7 @@ (def: xml-char^ (l.Lexer Text) - (p.either (l.none-of "<>&'\"") + (p.either (l.none-of ($_ text/compose "<>&'" text.double-quote)) xml-escape-char^)) (def: xml-identifier @@ -92,7 +92,7 @@ (def: attr-value^ (l.Lexer Text) (let [value^ (l.some xml-char^)] - (p.either (l.enclosed ["\"" "\""] value^) + (p.either (l.enclosed [text.double-quote text.double-quote] value^) (l.enclosed ["'" "'"] value^)))) (def: attrs^ @@ -110,9 +110,9 @@ spaced^ (p.after (l.this "/")) (l.enclosed ["<" ">"]))] - (p.assert ($_ text/compose "Close tag does not match open tag.\n" - "Expected: " (name/encode expected) "\n" - " Actual: " (name/encode actual) "\n") + (p.assert ($_ text/compose "Close tag does not match open tag." text.new-line + "Expected: " (name/encode expected) text.new-line + " Actual: " (name/encode actual) text.new-line) (name/= expected actual)))) (def: comment^ @@ -181,7 +181,7 @@ (text.replace-all "<" "<") (text.replace-all ">" ">") (text.replace-all "'" "'") - (text.replace-all "\"" """))) + (text.replace-all text.double-quote """))) (def: (write-tag [namespace name]) (-> Tag Text) @@ -194,12 +194,12 @@ (|> attrs d.entries (list/map (function (_ [key value]) - ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) + ($_ text/compose (write-tag key) "=" text.double-quote (sanitize-value value) text.double-quote))) (text.join-with " "))) (def: xml-header Text - "<?xml version=\"1.0\" encoding=\"UTF-8\"?>") + ($_ text/compose "<?xml version=" text.double-quote "1.0" text.double-quote " encoding=" text.double-quote "UTF-8" text.double-quote "?>")) (def: #export (write input) (-> XML Text) @@ -254,10 +254,12 @@ (exception: #export (wrong-tag {tag Name}) (name/encode tag)) +(def: blank-line ($_ text/compose text.new-line text.new-line)) + (exception: #export (unconsumed-inputs {inputs (List XML)}) (|> inputs (list/map (:: Codec<Text,XML> encode)) - (text.join-with "\n\n"))) + (text.join-with blank-line))) (def: #export text (Reader Text) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 57ff95727..d0dfe1886 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -82,11 +82,14 @@ (monad.lift Monad<M> (:: Monad<Maybe> wrap))) (macro: #export (default tokens state) - {#.doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #.None. - (default +20 (#.Some +10)) => +10 - - (default +20 #.None) => +20"} + {#.doc (doc "Allows you to provide a default value that will be used" + "if a (Maybe x) value turns out to be #.None." + (default +20 (#.Some +10)) + "=>" + +10 + (default +20 #.None) + "=>" + +20)} (case tokens (^ (list else maybe)) (let [g!temp (: Code [dummy-cursor (#.Identifier ["" ""])]) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4b3b786b4..efd965d1b 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,9 +178,11 @@ ) ## [Values & Syntax] -(def: (get-char full idx) - (-> Text Nat (Maybe Text)) - ("lux text clip" full idx (inc idx))) +(type: Char Nat) + +(def: (get-char! full idx) + (-> Text Nat Char) + ("lux text char" full idx)) (def: (binary-character value) (-> Nat (Maybe Text)) @@ -190,10 +192,10 @@ _ #.None)) (def: (binary-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) _ #.None)) (def: (octal-character value) @@ -210,16 +212,16 @@ _ #.None)) (def: (octal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) _ #.None)) (def: (decimal-character value) @@ -238,18 +240,18 @@ _ #.None)) (def: (decimal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) - "8" (#.Some 8) - "9" (#.Some 9) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) + (^ (char "8")) (#.Some 8) + (^ (char "9")) (#.Some 9) _ #.None)) (def: (hexadecimal-character value) @@ -274,24 +276,24 @@ _ #.None)) (def: (hexadecimal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) - "8" (#.Some 8) - "9" (#.Some 9) - (^or "a" "A") (#.Some 10) - (^or "b" "B") (#.Some 11) - (^or "c" "C") (#.Some 12) - (^or "d" "D") (#.Some 13) - (^or "e" "E") (#.Some 14) - (^or "f" "F") (#.Some 15) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) + (^ (char "8")) (#.Some 8) + (^ (char "9")) (#.Some 9) + (^or (^ (char "a")) (^ (char "A"))) (#.Some 10) + (^or (^ (char "b")) (^ (char "B"))) (#.Some 11) + (^or (^ (char "c")) (^ (char "C"))) (#.Some 12) + (^or (^ (char "d")) (^ (char "D"))) (#.Some 13) + (^or (^ (char "e")) (^ (char "E"))) (#.Some 14) + (^or (^ (char "f")) (^ (char "F"))) (#.Some 15) _ #.None)) (do-template [<struct> <base> <to-character> <to-value> <error>] @@ -312,14 +314,13 @@ (loop [idx 0 output 0] (if (n/< input-size idx) - (let [digit (maybe.assume (get-char repr idx))] - (case (<to-value> digit) - #.None - (#error.Error ("lux text concat" <error> repr)) - - (#.Some digit-value) - (recur (inc idx) - (|> output (n/* <base>) (n/+ digit-value))))) + (case (<to-value> (get-char! repr idx)) + #.None + (#error.Error ("lux text concat" <error> repr)) + + (#.Some digit-value) + (recur (inc idx) + (|> output (n/* <base>) (n/+ digit-value)))) (#error.Success output))) (#error.Error ("lux text concat" <error> repr))))))] @@ -337,29 +338,28 @@ (def: (int/sign?? representation) (-> Text (Maybe Int)) - (case (get-char representation 0) - (^ (#.Some "-")) + (case (get-char! representation 0) + (^ (char "-")) (#.Some -1) - (^ (#.Some "+")) + (^ (char "+")) (#.Some +1) _ #.None)) (def: (int-decode-loop input-size repr sign <base> <to-value> <error>) - (-> Nat Text Int Int (-> Text (Maybe Nat)) Text (Error Int)) + (-> Nat Text Int Int (-> Char (Maybe Nat)) Text (Error Int)) (loop [idx 1 output +0] (if (n/< input-size idx) - (let [digit (maybe.assume (get-char repr idx))] - (case (<to-value> digit) - #.None - (#error.Error <error>) + (case (<to-value> (get-char! repr idx)) + #.None + (#error.Error <error>) - (#.Some digit-value) - (recur (inc idx) - (|> output (i/* <base>) (i/+ (.int digit-value)))))) + (#.Some digit-value) + (recur (inc idx) + (|> output (i/* <base>) (i/+ (.int digit-value))))) (#error.Success (i/* sign output))))) (do-template [<struct> <base> <to-character> <to-value> <error>] @@ -396,35 +396,39 @@ (def: (de-prefix input) (-> Text Text) - (maybe.assume ("lux text clip" input 1 ("lux text size" input)))) + ("lux text clip" input 1 ("lux text size" input))) (do-template [<struct> <nat> <char-bit-size> <error>] - [(structure: #export <struct> (Codec Text Rev) - (def: (encode value) - (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value))) - max-num-chars (n// <char-bit-size> 64) - raw-size ("lux text size" raw-output) - zero-padding (loop [zeroes-left (n/- raw-size max-num-chars) - output ""] - (if (n/= 0 zeroes-left) - output - (recur (dec zeroes-left) - ("lux text concat" "0" output)))) - padded-output ("lux text concat" zero-padding raw-output)] - ("lux text concat" "." padded-output))) - - (def: (decode repr) - (let [repr-size ("lux text size" repr)] - (if (n/>= 2 repr-size) - (case ("lux text char" repr 0) - (^multi (^ (#.Some (char "."))) - [(:: <nat> decode (de-prefix repr)) - (#error.Success output)]) - (#error.Success (:coerce Rev output)) - - _ - (#error.Error ("lux text concat" <error> repr))) - (#error.Error ("lux text concat" <error> repr))))))] + [(with-expansions [<error-output> (as-is (#error.Error ("lux text concat" <error> repr)))] + (structure: #export <struct> (Codec Text Rev) + (def: (encode value) + (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value))) + max-num-chars (n// <char-bit-size> 64) + raw-size ("lux text size" raw-output) + zero-padding (loop [zeroes-left (n/- raw-size max-num-chars) + output ""] + (if (n/= 0 zeroes-left) + output + (recur (dec zeroes-left) + ("lux text concat" "0" output)))) + padded-output ("lux text concat" zero-padding raw-output)] + ("lux text concat" "." padded-output))) + + (def: (decode repr) + (let [repr-size ("lux text size" repr)] + (if (n/>= 2 repr-size) + (case ("lux text char" repr 0) + (^ (char ".")) + (case (:: <nat> decode (de-prefix repr)) + (#error.Success output) + (#error.Success (:coerce Rev output)) + + _ + <error-output>) + + _ + <error-output>) + <error-output>)))))] [Binary@Codec<Text,Rev> Binary@Codec<Text,Nat> 1 "Invalid binary syntax: "] [Octal@Codec<Text,Rev> Octal@Codec<Text,Nat> 3 "Invalid octal syntax: "] @@ -444,17 +448,16 @@ (if (f/= +0.0 dec-left) ("lux text concat" "." output) (let [shifted (f/* <base> dec-left) - digit (|> shifted (f/% <base>) frac-to-int .nat - (get-char <char-set>) maybe.assume)] + digit-idx (|> shifted (f/% <base>) frac-to-int .nat)] (recur (f/% +1.0 shifted) - ("lux text concat" output digit))))))] + ("lux text concat" output ("lux text clip" <char-set> digit-idx (inc digit-idx))))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) (case ("lux text index" repr "." 0) (#.Some split-index) - (let [whole-part (maybe.assume ("lux text clip" repr 0 split-index)) - decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))] + (let [whole-part ("lux text clip" repr 0 split-index) + decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] (^multi [(#error.Success whole) (#error.Success decimal)] @@ -498,8 +501,8 @@ (if (n/<= chunk-size num-digits) (list digits) (let [boundary (n/- chunk-size num-digits) - chunk (maybe.assume ("lux text clip" digits boundary num-digits)) - remaining (maybe.assume ("lux text clip" digits 0 boundary))] + chunk ("lux text clip" digits boundary num-digits) + remaining ("lux text clip" digits 0 boundary)] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -627,10 +630,10 @@ (let [sign (:: Number<Frac> signum value) raw-bin (:: Binary@Codec<Text,Frac> encode value) dot-idx (maybe.assume ("lux text index" raw-bin "." 0)) - whole-part (maybe.assume ("lux text clip" raw-bin - (if (f/= -1.0 sign) 1 0) - dot-idx)) - decimal-part (maybe.assume ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin))) + whole-part ("lux text clip" raw-bin + (if (f/= -1.0 sign) 1 0) + dot-idx) + decimal-part ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin)) hex-output (|> (<from> #0 decimal-part) ("lux text concat" ".") ("lux text concat" (<from> #1 whole-part)) @@ -646,8 +649,8 @@ +1.0)] (case ("lux text index" repr "." 0) (#.Some split-index) - (let [whole-part (maybe.assume ("lux text clip" repr 1 split-index)) - decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr))) + (let [whole-part ("lux text clip" repr 1 split-index) + decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr)) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) @@ -674,15 +677,13 @@ encoding " number, generates a Nat, an Int, a Rev or a Frac.") underscore "Allows for the presence of underscore in the numbers." - description [cursor (#.Text ($_ "lux text concat" - encoding "\n" - underscore))]] + description [cursor (#.Text ($_ "lux text concat" encoding " " underscore))]] (#error.Success [state (list (` (doc (~ description) (~ example-1) (~ example-2))))])) _ - (#error.Error "Wrong syntax for \"encoding-doc\"."))) + (#error.Error "Wrong syntax for 'encoding-doc'."))) (def: (underscore-prefixed? number) (-> Text Bit) @@ -831,14 +832,13 @@ (loop [idx 0 output (make-digits [])] (if (n/< length idx) - (let [char (maybe.assume (get-char input idx))] - (case ("lux text index" "+0123456789" char 0) - #.None - #.None - - (#.Some digit) - (recur (inc idx) - (digits-put idx digit output)))) + (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0) + #.None + #.None + + (#.Some digit) + (recur (inc idx) + (digits-put idx digit output))) (#.Some output))) #.None))) @@ -902,9 +902,7 @@ #0)] (if (and dotted? (n/<= (inc i64.width) length)) - (case (|> ("lux text clip" input 1 length) - maybe.assume - text-to-digits) + (case (text-to-digits ("lux text clip" input 1 length)) (#.Some digits) (loop [digits digits idx 0 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 48f35febe..18ad49032 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -16,13 +16,31 @@ [compiler ["." host]]]) +(def: #export from-code + (-> Nat Text) + (|>> (:coerce Int) "lux int char")) + +(do-template [<name> <code>] + [(def: #export <name> (from-code <code>))] + + [back-space 8] + [tab 9] + [new-line 10] + [vertical-tab 11] + [form-feed 12] + [carriage-return 13] + [double-quote 34] + ) + (def: #export (size x) (-> Text Nat) ("lux text size" x)) (def: #export (nth idx input) (-> Nat Text (Maybe Nat)) - ("lux text char" input idx)) + (if (n/< ("lux text size" input) idx) + (#.Some ("lux text char" input idx)) + #.None)) (def: #export (index-of' pattern from input) (-> Text Nat Text (Maybe Nat)) @@ -89,11 +107,17 @@ (def: #export (clip from to input) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" input from to)) + (if (and (n/<= to from) + (n/<= ("lux text size" input) to)) + (#.Some ("lux text clip" input from to)) + #.None)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) - ("lux text clip" input from (size input))) + (let [size ("lux text size" input)] + (if (n/<= size from) + (#.Some ("lux text clip" input from size)) + #.None))) (def: #export (split at x) (-> Nat Text (Maybe [Text Text])) @@ -122,7 +146,7 @@ (#.Cons sample #.Nil))) (def: #export split-lines - (..split-all-with "\n")) + (..split-all-with ..new-line)) (def: #export (replace-once pattern value template) (-> Text Text Text Text) @@ -182,12 +206,11 @@ (loop [idx 0 hash 0] (if (n/< length idx) - (let [char (|> idx ("lux text char" input) (maybe.default 0))] - (recur (inc idx) - (|> hash - (i64.left-shift 5) - (n/- hash) - (n/+ char)))) + (recur (inc idx) + (|> hash + (i64.left-shift 5) + (n/- hash) + (n/+ ("lux text char" input idx)))) hash))))))) (def: #export concat @@ -218,28 +241,19 @@ (def: #export encode (-> Text Text) - (|>> (replace-all "\\" "\\\\") - (replace-all "\t" "\\t") - (replace-all "\v" "\\v") - (replace-all "\b" "\\b") - (replace-all "\n" "\\n") - (replace-all "\r" "\\r") - (replace-all "\f" "\\f") - (replace-all "\"" "\\\"") - (..enclose' "\""))) - -(def: #export from-code - (-> Nat Text) - (|>> (:coerce Int) "lux int char")) + (..enclose' ..double-quote)) (def: #export (space? char) {#.doc "Checks whether the character is white-space."} (-> Nat Bit) - (case char - (^or (^ (char "\t")) (^ (char "\v")) - (^ (char " ")) (^ (char "\n")) - (^ (char "\r")) (^ (char "\f"))) - #1 - - _ - #0)) + (`` (case char + (^or (^ (char (~~ (static ..tab)))) + (^ (char (~~ (static ..vertical-tab)))) + (^ (char " ")) + (^ (char (~~ (static ..new-line)))) + (^ (char (~~ (static ..carriage-return)))) + (^ (char (~~ (static ..form-feed))))) + #1 + + _ + #0))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 481d17b0a..21aba8360 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -4,25 +4,29 @@ [monad (#+ do Monad)] ["p" parser]] [data - ["." text ("text/." Monoid<Text>)] ["." product] ["." maybe] ["e" error] [collection - ["." list]]] + ["." list ("list/." Fold<List>)]]] [macro - ["." code]]]) + ["." code]]] + ["." // ("text/." Monoid<Text>)]) -(type: Offset Nat) +(type: #export Offset Nat) (def: start-offset Offset 0) (type: #export Lexer (p.Parser [Offset Text])) +(type: #export Slice + {#basis Offset + #distance Offset}) + (def: (remaining offset tape) (-> Offset Text Text) - (|> tape (text.split offset) maybe.assume product.right)) + (|> tape (//.split offset) maybe.assume product.right)) (def: cannot-lex-error Text "Cannot lex from empty text.") @@ -37,54 +41,85 @@ (#e.Error msg) (#e.Success [[end-offset _] output]) - (if (n/= end-offset (text.size input)) + (if (n/= end-offset (//.size input)) (#e.Success output) (#e.Error (unconsumed-input-error end-offset input))) )) +(def: #export offset + (Lexer Offset) + (function (_ (^@ input [offset tape])) + (#e.Success [input offset]))) + +(def: (with-slices lexer) + (-> (Lexer (List Slice)) (Lexer Slice)) + (do p.Monad<Parser> + [offset ..offset + slices lexer] + (wrap (list/fold (function (_ [slice::basis slice::distance] + [total::basis total::distance]) + [total::basis ("lux i64 +" slice::distance total::distance)]) + {#basis offset + #distance 0} + slices)))) + (def: #export any {#.doc "Just returns the next character without applying any logic."} (Lexer Text) (function (_ [offset tape]) - (case (text.nth offset tape) + (case (//.nth offset tape) (#.Some output) - (#e.Success [[(inc offset) tape] (text.from-code output)]) + (#e.Success [[("lux i64 +" 1 offset) tape] (//.from-code output)]) _ - (#e.Error cannot-lex-error)) - )) + (#e.Error cannot-lex-error)))) -(def: #export (not p) - {#.doc "Produce a character if the lexer fails."} - (All [a] (-> (Lexer a) (Lexer Text))) - (function (_ input) - (case (p input) - (#e.Error msg) - (any input) - - _ - (#e.Error "Expected to fail; yet succeeded.")))) +(def: #export any! + {#.doc "Just returns the next character without applying any logic."} + (Lexer Slice) + (function (_ [offset tape]) + (#e.Success [[("lux i64 +" 1 offset) tape] + {#basis offset + #distance 1}]))) + +(do-template [<name> <type> <any>] + [(def: #export (<name> p) + {#.doc "Produce a character if the lexer fails."} + (All [a] (-> (Lexer a) (Lexer <type>))) + (function (_ input) + (case (p input) + (#e.Error msg) + (<any> input) + + _ + (#e.Error "Expected to fail; yet succeeded."))))] + + [not Text ..any] + [not! Slice ..any!] + ) (def: #export (this reference) {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Any)) (function (_ [offset tape]) - (case (text.index-of' reference offset tape) + (case (//.index-of' reference offset tape) (#.Some where) (if (n/= offset where) - (#e.Success [[(n/+ (text.size reference) offset) tape] []]) - (#e.Error ($_ text/compose "Could not match: " (text.encode reference) " @ " (maybe.assume (text.clip' offset tape))))) + (#e.Success [[("lux i64 +" (//.size reference) offset) tape] + []]) + (#e.Error ($_ text/compose "Could not match: " (//.encode reference) " @ " (maybe.assume (//.clip' offset tape))))) _ - (#e.Error ($_ text/compose "Could not match: " (text.encode reference)))))) + (#e.Error ($_ text/compose "Could not match: " (//.encode reference)))))) (def: #export (this? reference) {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Bit)) (function (_ (^@ input [offset tape])) - (case (text.index-of' reference offset tape) + (case (//.index-of' reference offset tape) (^multi (#.Some where) (n/= offset where)) - (#e.Success [[(n/+ (text.size reference) offset) tape] #1]) + (#e.Success [[("lux i64 +" (//.size reference) offset) tape] + #1]) _ (#e.Success [input #0])))) @@ -93,7 +128,7 @@ {#.doc "Ensure the lexer's input is empty."} (Lexer Any) (function (_ (^@ input [offset tape])) - (if (n/= offset (text.size tape)) + (if (n/= offset (//.size tape)) (#e.Success [input []]) (#e.Error (unconsumed-input-error offset tape))))) @@ -101,19 +136,18 @@ {#.doc "Ask if the lexer's input is empty."} (Lexer Bit) (function (_ (^@ input [offset tape])) - (#e.Success [input (n/= offset (text.size tape))]))) + (#e.Success [input (n/= offset (//.size tape))]))) (def: #export peek {#.doc "Lex the next character (without consuming it from the input)."} (Lexer Text) (function (_ (^@ input [offset tape])) - (case (text.nth offset tape) + (case (//.nth offset tape) (#.Some output) - (#e.Success [input (text.from-code output)]) + (#e.Success [input (//.from-code output)]) _ - (#e.Error cannot-lex-error)) - )) + (#e.Error cannot-lex-error)))) (def: #export get-input {#.doc "Get all of the remaining input (without consuming it)."} @@ -126,8 +160,8 @@ (-> Nat Nat (Lexer Text)) (do p.Monad<Parser> [char any - #let [char' (maybe.assume (text.nth 0 char))] - _ (p.assert ($_ text/compose "Character is not within range: " (text.from-code bottom) "-" (text.from-code top)) + #let [char' (maybe.assume (//.nth 0 char))] + _ (p.assert ($_ text/compose "Character is not within range: " (//.from-code bottom) "-" (//.from-code top)) (.and (n/>= bottom char') (n/<= top char')))] (wrap char))) @@ -162,43 +196,59 @@ (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."} - (-> Text (Lexer Text)) - (function (_ [offset tape]) - (case (text.nth offset tape) - (#.Some output) - (let [output (text.from-code output)] - (if (text.contains? output options) - (#e.Success [[(inc offset) tape] output]) - (#e.Error ($_ text/compose "Character (" output ") is not one of: " options)))) - - _ - (#e.Error cannot-lex-error)))) - -(def: #export (none-of options) - {#.doc "Only lex characters that are not part of a piece of text."} - (-> Text (Lexer Text)) - (function (_ [offset tape]) - (case (text.nth offset tape) - (#.Some output) - (let [output (text.from-code output)] - (if (.not (text.contains? output options)) - (#e.Success [[(inc offset) tape] output]) - (#e.Error ($_ text/compose "Character (" output ") is one of: " options)))) +(do-template [<name> <description-modifier> <modifier>] + [(def: #export (<name> options) + {#.doc (code.text ($_ text/compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + (-> Text (Lexer Text)) + (function (_ [offset tape]) + (case (//.nth offset tape) + (#.Some output) + (let [output (//.from-code output)] + (if (<modifier> (//.contains? output options)) + (#e.Success [[("lux i64 +" 1 offset) tape] output]) + (#e.Error ($_ text/compose "Character (" output + ") is should " <description-modifier> + "be one of: " options)))) + + _ + (#e.Error cannot-lex-error))))] + + [one-of "" |>] + [none-of " not" .not] + ) - _ - (#e.Error cannot-lex-error)))) +(do-template [<name> <description-modifier> <modifier>] + [(def: #export (<name> options) + {#.doc (code.text ($_ text/compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + (-> Text (Lexer Slice)) + (function (_ [offset tape]) + (case (//.nth offset tape) + (#.Some output) + (let [output (//.from-code output)] + (if (<modifier> (//.contains? output options)) + (#e.Success [[("lux i64 +" 1 offset) tape] + {#basis offset + #distance 1}]) + (#e.Error ($_ text/compose "Character (" output + ") is should " <description-modifier> + "be one of: " options)))) + + _ + (#e.Error cannot-lex-error))))] + + [one-of! "" |>] + [none-of! " not" .not] + ) (def: #export (satisfies p) {#.doc "Only lex characters that satisfy a predicate."} (-> (-> Nat Bit) (Lexer Text)) (function (_ [offset tape]) - (case (text.nth offset tape) + (case (//.nth offset tape) (#.Some output) (if (p output) - (#e.Success [[(inc offset) tape] (text.from-code output)]) - (#e.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) + (#e.Success [[("lux i64 +" 1 offset) tape] (//.from-code output)]) + (#e.Error ($_ text/compose "Character does not satisfy predicate: " (//.from-code output)))) _ (#e.Error cannot-lex-error)))) @@ -206,7 +256,7 @@ (def: #export space {#.doc "Only lex white-space."} (Lexer Text) - (satisfies text.space?)) + (satisfies //.space?)) (def: #export (and left right) (-> (Lexer Text) (Lexer Text) (Lexer Text)) @@ -215,33 +265,64 @@ =right right] (wrap ($_ text/compose =left =right)))) -(do-template [<name> <base> <doc>] - [(def: #export (<name> p) - {#.doc <doc>} +(def: #export (and! left right) + (-> (Lexer Slice) (Lexer Slice) (Lexer Slice)) + (do p.Monad<Parser> + [[left::basis left::distance] left + [right::basis right::distance] right] + (wrap [left::basis ("lux i64 +" left::distance right::distance)]))) + +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " characters as a single continuous text."))} (-> (Lexer Text) (Lexer Text)) - (|> p <base> (:: p.Monad<Parser> map text.concat)))] + (|> lexer <base> (:: p.Monad<Parser> map //.concat)))] - [some p.some "Lex some characters as a single continuous text."] - [many p.many "Lex many characters as a single continuous text."] + [some p.some "some"] + [many p.many "many"] ) -(do-template [<name> <base> <doc>] - [(def: #export (<name> n p) - {#.doc <doc>} +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " characters as a single continuous text."))} + (-> (Lexer Slice) (Lexer Slice)) + (with-slices (<base> lexer)))] + + [some! p.some "some"] + [many! p.many "many"] + ) + +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> amount lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " N characters."))} (-> Nat (Lexer Text) (Lexer Text)) - (do p.Monad<Parser> - [] - (|> p (<base> n) (:: @ map text.concat))))] + (|> lexer (<base> amount) (:: p.Monad<Parser> map //.concat)))] + + [exactly p.exactly "exactly"] + [at-most p.at-most "at most"] + [at-least p.at-least "at least"] + ) - [exactly p.exactly "Lex exactly N characters."] - [at-most p.at-most "Lex at most N characters."] - [at-least p.at-least "Lex at least N characters."] +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> amount lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " N characters."))} + (-> Nat (Lexer Slice) (Lexer Slice)) + (with-slices (<base> amount lexer)))] + + [exactly! p.exactly "exactly"] + [at-most! p.at-most "at most"] + [at-least! p.at-least "at least"] ) -(def: #export (between from to p) +(def: #export (between from to lexer) {#.doc "Lex between N and M characters."} (-> Nat Nat (Lexer Text) (Lexer Text)) - (|> p (p.between from to) (:: p.Monad<Parser> map text.concat))) + (|> lexer (p.between from to) (:: p.Monad<Parser> map //.concat))) + +(def: #export (between! from to lexer) + {#.doc "Lex between N and M characters."} + (-> Nat Nat (Lexer Slice) (Lexer Slice)) + (with-slices (p.between from to lexer))) (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) @@ -259,3 +340,15 @@ (#e.Success value) (#e.Success [real-input value])))) + +(def: #export (slice lexer) + (-> (Lexer Slice) (Lexer Text)) + (do p.Monad<Parser> + [[basis distance] lexer] + (function (_ (^@ input [offset tape])) + (case (//.clip basis ("lux i64 +" basis distance) tape) + (#.Some output) + (#e.Success [input output]) + + #.None + (#e.Error "Cannot slice."))))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index ffd937d8e..ba0128b7b 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -7,25 +7,25 @@ ["." product] ["e" error] ["." maybe] - ["." number ("int/." Codec<Text,Int>)] - ["." text - ["l" lexer] - format] + ["." number (#+ hex) ("int/." Codec<Text,Int>)] [collection ["." list ("list/." Fold<List> Monad<List>)]]] ["." macro (#+ with-gensyms) ["." code] - ["s" syntax (#+ syntax:)]]]) + ["s" syntax (#+ syntax:)]]] + ["." // + ["l" lexer] + format]) ## [Utils] (def: regex-char^ (l.Lexer Text) - (l.none-of "\\.|&()[]{}")) + (l.none-of "\.|&()[]{}")) (def: escaped-char^ (l.Lexer Text) (do p.Monad<Parser> - [? (l.this? "\\")] + [? (l.this? "\")] (if ? l.any regex-char^))) @@ -50,11 +50,11 @@ (-> (l.Lexer (List Text)) (l.Lexer Text)) (do p.Monad<Parser> [parts part^] - (wrap (text.join-with "" parts)))) + (wrap (//.join-with "" parts)))) (def: name-char^ (l.Lexer Text) - (l.none-of "[]{}()s\"#.<>")) + (l.none-of (format "[]{}()s#.<>" //.double-quote))) (def: name-part^ (l.Lexer Text) @@ -75,15 +75,15 @@ (def: (re-var^ current-module) (-> Text (l.Lexer Code)) (do p.Monad<Parser> - [name (l.enclosed ["\\@<" ">"] (name^ current-module))] + [name (l.enclosed ["\@<" ">"] (name^ current-module))] (wrap (` (: (l.Lexer Text) (~ (code.identifier name))))))) (def: re-range^ (l.Lexer Code) (do p.Monad<Parser> - [from (|> regex-char^ (:: @ map (|>> (text.nth 0) maybe.assume))) + [from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume))) _ (l.this "-") - to (|> regex-char^ (:: @ map (|>> (text.nth 0) maybe.assume)))] + to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))] (wrap (` (l.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ @@ -122,20 +122,21 @@ (def: blank^ (l.Lexer Text) - (l.one-of " \t")) + (l.one-of (format " " //.tab))) (def: ascii^ (l.Lexer Text) - (l.range (char "\u0000") (char "\u007F"))) + (l.range (hex "0") (hex "7F"))) (def: control^ (l.Lexer Text) - (p.either (l.range (char "\u0000") (char "\u001F")) - (l.one-of "\u007F"))) + (p.either (l.range (hex "0") (hex "1F")) + (l.one-of (//.from-code (hex "7F"))))) (def: punct^ (l.Lexer Text) - (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) + (l.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" + //.double-quote))) (def: graph^ (l.Lexer Text) @@ -144,7 +145,7 @@ (def: print^ (l.Lexer Text) (p.either graph^ - (l.one-of "\u0020"))) + (l.one-of (//.from-code (hex "20"))))) (def: re-system-class^ (l.Lexer Code) @@ -152,27 +153,27 @@ [] ($_ p.either (p.after (l.this ".") (wrap (` l.any))) - (p.after (l.this "\\d") (wrap (` l.decimal))) - (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) - (p.after (l.this "\\s") (wrap (` l.space))) - (p.after (l.this "\\S") (wrap (` (l.not l.space)))) - (p.after (l.this "\\w") (wrap (` (~! word^)))) - (p.after (l.this "\\W") (wrap (` (l.not (~! word^))))) - - (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) - (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) - (p.after (l.this "\\p{Alpha}") (wrap (` l.alpha))) - (p.after (l.this "\\p{Digit}") (wrap (` l.decimal))) - (p.after (l.this "\\p{Alnum}") (wrap (` l.alpha-num))) - (p.after (l.this "\\p{Space}") (wrap (` l.space))) - (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) - (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) - (p.after (l.this "\\p{Blank}") (wrap (` (~! blank^)))) - (p.after (l.this "\\p{ASCII}") (wrap (` (~! ascii^)))) - (p.after (l.this "\\p{Contrl}") (wrap (` (~! control^)))) - (p.after (l.this "\\p{Punct}") (wrap (` (~! punct^)))) - (p.after (l.this "\\p{Graph}") (wrap (` (~! graph^)))) - (p.after (l.this "\\p{Print}") (wrap (` (~! print^)))) + (p.after (l.this "\d") (wrap (` l.decimal))) + (p.after (l.this "\D") (wrap (` (l.not l.decimal)))) + (p.after (l.this "\s") (wrap (` l.space))) + (p.after (l.this "\S") (wrap (` (l.not l.space)))) + (p.after (l.this "\w") (wrap (` (~! word^)))) + (p.after (l.this "\W") (wrap (` (l.not (~! word^))))) + + (p.after (l.this "\p{Lower}") (wrap (` l.lower))) + (p.after (l.this "\p{Upper}") (wrap (` l.upper))) + (p.after (l.this "\p{Alpha}") (wrap (` l.alpha))) + (p.after (l.this "\p{Digit}") (wrap (` l.decimal))) + (p.after (l.this "\p{Alnum}") (wrap (` l.alpha-num))) + (p.after (l.this "\p{Space}") (wrap (` l.space))) + (p.after (l.this "\p{HexDigit}") (wrap (` l.hexadecimal))) + (p.after (l.this "\p{OctDigit}") (wrap (` l.octal))) + (p.after (l.this "\p{Blank}") (wrap (` (~! blank^)))) + (p.after (l.this "\p{ASCII}") (wrap (` (~! ascii^)))) + (p.after (l.this "\p{Contrl}") (wrap (` (~! control^)))) + (p.after (l.this "\p{Punct}") (wrap (` (~! punct^)))) + (p.after (l.this "\p{Graph}") (wrap (` (~! graph^)))) + (p.after (l.this "\p{Print}") (wrap (` (~! print^)))) ))) (def: re-class^ @@ -188,11 +189,11 @@ (def: re-back-reference^ (l.Lexer Code) (p.either (do p.Monad<Parser> - [_ (l.this "\\") + [_ (l.this "\") id number^] (wrap (` ((~! ..copy) (~ (code.identifier ["" (int/encode (.int id))])))))) (do p.Monad<Parser> - [_ (l.this "\\k<") + [_ (l.this "\k<") captured-name name-part^ _ (l.this ">")] (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name])))))))) @@ -278,7 +279,7 @@ [idx names (list& (list g!temp complex - (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))])) + (' #let) (` [(~ g!total) (:: (~! //.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))])) steps)] (#.Right [(#Capturing [?name num-captures]) scoped]) @@ -294,7 +295,7 @@ [idx! (list& name! names) (list& (list name! scoped - (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ access))])) + (' #let) (` [(~ g!total) (:: (~! //.Monoid<Text>) (~' compose) (~ g!total) (~ access))])) steps)]) ))) [+0 @@ -410,11 +411,11 @@ (regex ".") "Escaping" - (regex "\\.") + (regex "\.") "Character classes" - (regex "\\d") - (regex "\\p{Lower}") + (regex "\d") + (regex "\p{Lower}") (regex "[abc]") (regex "[a-z]") (regex "[a-zA-Z]") @@ -448,11 +449,11 @@ "Groups" (regex "a(.)c") (regex "a(b+)c") - (regex "(\\d{3})-(\\d{3})-(\\d{4})") - (regex "(\\d{3})-(?:\\d{3})-(\\d{4})") - (regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") - (regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") - (regex "(\\d{3})-((\\d{3})-(\\d{4}))") + (regex "(\d{3})-(\d{3})-(\d{4})") + (regex "(\d{3})-(?:\d{3})-(\d{4})") + (regex "(?<code>\d{3})-\k<code>-(\d{4})") + (regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") + (regex "(\d{3})-((\d{3})-(\d{4}))") "Alternation" (regex "a|b") @@ -464,7 +465,7 @@ (p.before l.end) (l.run pattern)) (#e.Error error) - (macro.fail (format "Error while parsing regular-expression:\n" + (macro.fail (format "Error while parsing regular-expression:" //.new-line error)) (#e.Success regex) @@ -476,11 +477,11 @@ {branches (p.many s.any)}) {#.doc (doc "Allows you to test text against regular expressions." (case some-text - (^regex "(\\d{3})-(\\d{3})-(\\d{4})" + (^regex "(\d{3})-(\d{3})-(\d{4})" [_ country-code area-code place-code]) do-some-thing-when-number - (^regex "\\w+") + (^regex "\w+") do-some-thing-when-word _ diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b7a55dfaa..b5a2454e1 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1088,7 +1088,7 @@ (def: (annotation$ [name params]) (-> Annotation JVM-Code) - (format "(" name " " "{" (text.join-with "\t" (list/map annotation-param$ params)) "}" ")")) + (format "(" name " " "{" (text.join-with text.tab (list/map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) (-> BoundKind JVM-Code) @@ -1319,10 +1319,10 @@ "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed." "Fields and methods defined in the class can be used with special syntax." "For example:" - "::resolved, for accessing the \"resolved\" field." + "::resolved, for accessing the 'resolved' field." "(:= ::resolved #1) for modifying it." "(::new! []) for calling the class's constructor." - "(::resolve! container [value]) for calling the \"resolve\" method." + "(::resolve! container [value]) for calling the 'resolve' method." )} (do Monad<Meta> [current-module macro.current-module-name diff --git a/stdlib/source/lux/interpreter.lux b/stdlib/source/lux/interpreter.lux index 36cef324d..e44084bc0 100644 --- a/stdlib/source/lux/interpreter.lux +++ b/stdlib/source/lux/interpreter.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - [text ("text/." Equivalence<Text>) + ["." text ("text/." Equivalence<Text>) format]] [type (#+ :share) ["." check]] @@ -36,16 +36,16 @@ (def: (add-line line [where offset input]) (-> Text Source Source) - [where offset (format input "\n" line)]) + [where offset (format input text.new-line line)]) (def: exit-command Text "exit") (def: welcome-message Text - (format "\n" - "Welcome to the interpreter!" "\n" - "Type \"exit\" to leave." "\n" - "\n")) + (format text.new-line + "Welcome to the interpreter!" text.new-line + "Type '" ..exit-command "' to leave." text.new-line + text.new-line)) (def: farewell-message Text @@ -68,7 +68,7 @@ (do Monad<!> [state (default.initialize platform configuration) state (default.compile-module platform - (set@ #cli.module default.prelude configuration) + (set@ #cli.module syntax.prelude configuration) (set@ [#extension.state #statement.analysis #statement.state #extension.state @@ -164,7 +164,8 @@ (All [anchor expression statement] (-> <Context> (Error [<Context> Text]))) (do error.Monad<Error> - [[source' input] (syntax.read ..module syntax.no-aliases (get@ #source context)) + [#let [[_where _offset _code] (get@ #source context)] + [source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context)) [state' representation] (let [## TODO: Simplify ASAP state (:share [anchor expression statement] {<Context> diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 5ec03c749..c054c5347 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -6,9 +6,7 @@ [monad (#+ do Monad)] ["ex" exception (#+ Exception)]] [data - ["." error (#+ Error)] - [collection - [list]]]]) + ["." error (#+ Error)]]]) (type: #export (IO a) {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."} @@ -16,7 +14,7 @@ (macro: #export (io tokens state) {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." - "Great for wrapping effectful computations (which will not be performed until the IO is \"run\")." + "Great for wrapping effectful computations (which will not be performed until the IO is 'run')." (io (exec (log! msg) "Some value...")))} diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 7564518f4..5d5c8f0cf 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -264,9 +264,8 @@ #.None)))) (def: #export (normalize name) - {#.doc "If given a name without a module prefix, gives it the current module's name as prefix. - - Otherwise, returns the name as-is."} + {#.doc (doc "If given a name without a module prefix, gives it the current module's name as prefix." + "Otherwise, returns the name as-is.")} (-> Name (Meta Name)) (case name ["" name] @@ -287,9 +286,8 @@ (#e.Success [compiler (find-macro' (get@ #.modules compiler) this-module module name)]))))) (def: #export (expand-once syntax) - {#.doc "Given code that requires applying a macro, does it once and returns the result. - - Otherwise, returns the code as-is."} + {#.doc (doc "Given code that requires applying a macro, does it once and returns the result." + "Otherwise, returns the code as-is.")} (-> Code (Meta (List Code))) (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] @@ -306,9 +304,8 @@ (:: Monad<Meta> wrap (list syntax)))) (def: #export (expand syntax) - {#.doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left. - - Otherwise, returns the code as-is."} + {#.doc (doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left." + "Otherwise, returns the code as-is.")} (-> Code (Meta (List Code))) (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] @@ -367,9 +364,8 @@ (get@ #.seed compiler)]))) (def: #export (gensym prefix) - {#.doc "Generates a unique name as an Code node (ready to be used in code templates). - - A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} + {#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)." + "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")} (-> Text (Meta Code)) (function (_ compiler) (#e.Success [(update@ #.seed inc compiler) @@ -511,17 +507,17 @@ _ (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))] (#e.Error ($_ text/compose - "Unknown definition: " (name/encode name) "\n" - " Current module: " current-module "\n" + "Unknown definition: " (name/encode name) text.new-line + " Current module: " current-module text.new-line (case (get current-module (get@ #.modules compiler)) (#.Some this-module) ($_ text/compose - " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) "\n" - " Aliases: " (|> this-module (get@ #.module-aliases) (list/map (function (_ [alias real]) ($_ text/compose alias " => " real))) (text.join-with ", ")) "\n") + " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) text.new-line + " Aliases: " (|> this-module (get@ #.module-aliases) (list/map (function (_ [alias real]) ($_ text/compose alias " => " real))) (text.join-with ", ")) text.new-line) _ "") - " All Known modules: " (|> compiler (get@ #.modules) (list/map product.left) (text.join-with ", ")) "\n"))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list/map product.left) (text.join-with ", ")) text.new-line))))))) (def: #export (find-def-type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 72a56b81d..51f7a4885 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -12,7 +12,7 @@ ["." maybe] [name ("name/." Codec<Text,Name>)] ["e" error] - ["." number ("nat/." Codec<Text,Nat>)] + ["." number (#+ hex) ("nat/." Codec<Text,Nat>)] ["." text ("text/." Monoid<Text>) format] [collection @@ -56,7 +56,7 @@ (exception: #export (unconsumed {remaining (List Type)}) (ex.report ["Types" (|> remaining - (list/map (|>> %type (format "\n* "))) + (list/map (|>> %type (format text.new-line "* "))) (text.join-with ""))])) (type: #export Env (Dictionary Nat [Type Code])) @@ -131,7 +131,7 @@ (def: (label idx) (-> Nat Code) - (code.local-identifier (text/compose "label\u0000" (nat/encode idx)))) + (code.local-identifier ($_ text/compose "label" text.tab (nat/encode idx)))) (def: #export (with-extension type poly) (All [a] (-> Type (Poly a) (Poly [Code a]))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index db5e086b6..83137cef0 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -31,7 +31,7 @@ ## [Utils] (def: (remaining-inputs asts) (-> (List Code) Text) - ($_ text/compose "\nRemaining input: " + ($_ text/compose text.new-line "Remaining input: " (|> asts (list/map code.to-text) (list.interpose " ") (text.join-with "")))) ## [Syntaxs] @@ -196,7 +196,7 @@ ## [Syntax] (macro: #export (syntax: tokens) - {#.doc (doc "A more advanced way to define macros than \"macro:\"." + {#.doc (doc "A more advanced way to define macros than 'macro:'." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Monad<Meta>, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index dc38d1409..0729c05fe 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -1,6 +1,5 @@ -(.module: {#.doc "Commons syntax readers and writers. - - The goal is to be able to reuse common syntax in macro definitions across libraries."} +(.module: {#.doc (.doc "Commons syntax readers and writers." + "The goal is to be able to reuse common syntax in macro definitions across libraries.")} [lux (#- Definition)]) (type: #export Declaration diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index ef0f36bb2..ac141a3c9 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -19,8 +19,8 @@ (exception: #export zero-cannot-be-a-modulus) (abstract: #export (Modulus m) - {#.doc "A number used as a modulus in modular arithmetic. - It cannot be 0."} + {#.doc (doc "A number used as a modulus in modular arithmetic." + "It cannot be 0.")} Int @@ -37,15 +37,13 @@ (exception: #export [m] (incorrect-modulus {modulus (Modulus m)} {parsed Int}) - ($_ text/compose - "Expected: " (int/encode (to-int modulus)) "\n" - " Actual: " (int/encode parsed) "\n")) + (ex.report ["Expected" (int/encode (to-int modulus))] + ["Actual" (int/encode parsed)])) (exception: #export [rm sm] (cannot-equalize-moduli {reference (Modulus rm)} {sample (Modulus sm)}) - ($_ text/compose - "Reference: " (int/encode (to-int reference)) "\n" - " Sample: " (int/encode (to-int sample)) "\n")) + (ex.report ["Reference" (int/encode (to-int reference))] + ["Sample" (int/encode (to-int sample))])) (def: #export (congruent? modulus reference sample) (All [m] (-> (Modulus m) Int Int Bit)) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 92eced24d..ffb7bc592 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -268,9 +268,8 @@ (def: pcg-32-magic-mult Nat 6364136223846793005) (def: #export (pcg-32 [inc seed]) - {#.doc "An implementation of the PCG32 algorithm. - - For more information, please see: http://www.pcg-random.org/"} + {#.doc (doc "An implementation of the PCG32 algorithm." + "For more information, please see: http://www.pcg-random.org/")} (-> [(I64 Any) (I64 Any)] PRNG) (function (_ _) [(|> seed .nat (n/* pcg-32-magic-mult) ("lux i64 +" inc) [inc] pcg-32) @@ -283,9 +282,8 @@ .i64))])) (def: #export (xoroshiro-128+ [s0 s1]) - {#.doc "An implementation of the Xoroshiro128+ algorithm. - - For more information, please see: http://xoroshiro.di.unimi.it/"} + {#.doc (doc "An implementation of the Xoroshiro128+ algorithm." + "For more information, please see: http://xoroshiro.di.unimi.it/")} (-> [(I64 Any) (I64 Any)] PRNG) (function (_ _) [(let [s01 (i64.xor s0 s1)] diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 5b214579d..b928b1860 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -79,9 +79,9 @@ #let [post (io.run instant.now) _ (log! (format "@ " module " " "(" (%duration (instant.span pre post)) ")" - "\n" - description "\n" - "\n" documentation "\n"))]] + text.new-line + description text.new-line + text.new-line documentation text.new-line))]] (wrap counters))))) (monad.seq @))] (wrap (list/fold add-counters start test-runs)))) @@ -99,7 +99,7 @@ (def: (times-failure seed documentation) (-> (I64 Any) Text Text) - (format "Failed with this seed: " (%n (.nat seed)) "\n" + (format "Failed with this seed: " (%n (.nat seed)) text.new-line documentation)) (def: #export (times amount test) @@ -217,9 +217,9 @@ (def: (success-message successes failures) (-> Nat Nat Text) - (format "Test-suite finished." "\n" - (%n successes) " out of " (%n (n/+ failures successes)) " tests passed." "\n" - (%n failures) " tests failed." "\n")) + (format "Test-suite finished." text.new-line + (%n successes) " out of " (%n (n/+ failures successes)) " tests passed." text.new-line + (%n failures) " tests failed." text.new-line)) (syntax: #export (run) {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules." @@ -264,4 +264,4 @@ [[l-counter l-documentation] left [r-counter r-documentation] right] (wrap [(add-counters l-counter r-counter) - (format l-documentation "\n" r-documentation)]))))) + (format l-documentation text.new-line r-documentation)]))))) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index b902b631f..0e8f5468a 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -318,9 +318,8 @@ (l.run input lex-date)) (structure: #export _ - {#.doc "Based on ISO 8601. - - For example: 2017-01-15"} + {#.doc (doc "Based on ISO 8601." + "For example: 2017-01-15")} (Codec Text Date) (def: encode encode) (def: decode decode)) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 64d4fe172..70890ce4b 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -304,9 +304,8 @@ (l.run input lex-instant)) ## (structure: #export _ -## {#.doc "Based on ISO 8601. - -## For example: 2017-01-15T21:14:51.827Z"} +## {#.doc (doc "Based on ISO 8601." +## "For example: 2017-01-15T21:14:51.827Z")} ## (Codec Text Instant) ## (def: encode encode) ## (def: decode decode)) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index be3b54eed..ff614a328 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -345,8 +345,8 @@ [cursor macro.cursor valueT (macro.find-type valueN) #let [_ (log! ($_ text/compose - ":log!" " @ " (.cursor-description cursor) "\n" - (name/encode valueN) " : " (..to-text valueT) "\n"))]] + ":log!" " @ " (.cursor-description cursor) text.new-line + (name/encode valueN) " : " (..to-text valueT) text.new-line))]] (wrap (list (' [])))) (#.Right valueC) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index ce5ce652a..97ccc0626 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -10,7 +10,7 @@ ["." product] ["." error (#+ Error)] ["." number ("nat/." Codec<Text,Nat>)] - [text ("text/." Monoid<Text> Equivalence<Text>)] + ["." text ("text/." Monoid<Text> Equivalence<Text>)] [collection ["." list] ["." set (#+ Set)]]]] @@ -460,7 +460,9 @@ _ ($_ text/compose (on-error []) - "\n\n-----------------------------------------\n\n" + text.new-line text.new-line + "-----------------------------------------" + text.new-line text.new-line error))) output diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index fc082155a..108b350d0 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -165,9 +165,9 @@ (test "Can query the size/length of a text." (check-success+ "lux text size" (list subjectC) Nat)) (test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat)))) + (check-success+ "lux text char" (list subjectC fromC) Nat)) (test "Can clip a piece of text between 2 indices." - (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text)))) + (check-success+ "lux text clip" (list subjectC fromC toC) Text)) )))) (context: "IO procedures" diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 2b4a8f5b6..887765cbd 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -29,8 +29,8 @@ (r.Random Text) (do r.Monad<Random> [#let [digits "0123456789" - delimiters "()[]{}#.\"" - space "\t\v \n\r\f" + delimiters (format "()[]{}#." &.text-delimiter) + space (format " " text.new-line) invalid-range (format digits delimiters space) char-gen (|> r.nat (:: @ map (|>> (n/% 256) (n/max 1))) @@ -87,23 +87,23 @@ other code^] ($_ seq (test "Can parse Lux code." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 (code.to-text sample)]) + (case (&.parse "" (dict.new text.Hash<Text>) + [default-cursor 0 (code.to-text sample)]) (#e.Error error) #0 (#e.Success [_ parsed]) (:: code.Equivalence<Code> = parsed sample))) (test "Can parse Lux multiple code nodes." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 (format (code.to-text sample) " " - (code.to-text other))]) + (case (&.parse "" (dict.new text.Hash<Text>) + [default-cursor 0 (format (code.to-text sample) " " + (code.to-text other))]) (#e.Error error) #0 (#e.Success [remaining =sample]) - (case (&.read "" (dict.new text.Hash<Text>) - remaining) + (case (&.parse "" (dict.new text.Hash<Text>) + remaining) (#e.Error error) #0 @@ -112,136 +112,33 @@ (:: code.Equivalence<Code> = other =other))))) )))) -(context: "Frac special syntax." - (<| (times 100) - (do @ - [numerator (|> r.nat (:: @ map (|>> (n/% 100) .int int-to-frac))) - denominator (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1) .int int-to-frac))) - signed? r.bit - #let [expected (|> numerator (f// denominator) (f/* (if signed? -1.0 +1.0)))]] - (test "Can parse frac ratio syntax." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format (if signed? "-" "+") - (%i (frac-to-int numerator)) - "/" - (%i (frac-to-int denominator)))]) - (#e.Success [_ [_ (#.Frac actual)]]) - (f/= expected actual) - - _ - #0) - )))) - -(context: "Nat special syntax." - (<| (times 100) - (do @ - [expected (|> r.nat (:: @ map (n/% 1_000)))] - (test "Can parse nat char syntax." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format "#" (%t (text.from-code expected)) "")]) - (#e.Success [_ [_ (#.Nat actual)]]) - (n/= expected actual) - - _ - #0) - )))) - (def: comment-text^ (r.Random Text) - (let [char-gen (|> r.nat (r.filter (function (_ value) - (not (or (text.space? value) - (n/= (char "#") value) - (n/= (char "(") value) - (n/= (char ")") value))))))] + (let [char-gen (|> r.nat (r.filter (|>> (n/= (`` (char (~~ (static text.new-line))))) not)))] (do r.Monad<Random> [size (|> r.nat (r/map (n/% 20)))] (r.text char-gen size)))) (def: comment^ (r.Random Text) - (r.either (do r.Monad<Random> - [comment comment-text^] - (wrap (format "## " comment "\n"))) - (r.rec (function (_ nested^) - (do r.Monad<Random> - [comment (r.either comment-text^ - nested^)] - (wrap (format "#( " comment " )#"))))))) + (do r.Monad<Random> + [comment comment-text^] + (wrap (format "## " comment text.new-line)))) (context: "Multi-line text & comments." (<| (seed 12137892244981970631) ## (times 100) (do @ - [#let [char-gen (|> r.nat (r.filter (function (_ value) - (not (or (text.space? value) - (n/= (char "\"") value))))))] - x char-gen - y char-gen - z char-gen - offset-size (|> r.nat (r/map (|>> (n/% 10) (n/max 1)))) - #let [offset (text.join-with "" (list.repeat offset-size " "))] - sample code^ - comment comment^ - unbalanced-comment comment-text^] + [sample code^ + comment comment^] ($_ seq - (test "Will reject invalid multi-line text." - (let [bad-match (format (text.from-code x) "\n" - (text.from-code y) "\n" - (text.from-code z))] - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format "\"" bad-match "\"")]) - (#e.Error error) - #1 - - (#e.Success [_ parsed]) - #0))) - (test "Will accept valid multi-line text" - (let [good-input (format (text.from-code x) "\n" - offset (text.from-code y) "\n" - offset (text.from-code z)) - good-output (format (text.from-code x) "\n" - (text.from-code y) "\n" - (text.from-code z))] - (case (&.read "" (dict.new text.Hash<Text>) - [(|> default-cursor (update@ #.column (n/+ (dec offset-size)))) - 0 - (format "\"" good-input "\"")]) - (#e.Error error) - #0 - - (#e.Success [_ parsed]) - (:: code.Equivalence<Code> = - parsed - (code.text good-output))))) (test "Can handle comments." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format comment (code.to-text sample))]) + (case (&.parse "" (dict.new text.Hash<Text>) + [default-cursor 0 + (format comment (code.to-text sample))]) (#e.Error error) #0 (#e.Success [_ parsed]) (:: code.Equivalence<Code> = parsed sample))) - (test "Will reject unbalanced multi-line comments." - (and (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format "#(" "#(" unbalanced-comment ")#" - (code.to-text sample))]) - (#e.Error error) - #1 - - (#e.Success [_ parsed]) - #0) - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format "#(" unbalanced-comment ")#" ")#" - (code.to-text sample))]) - (#e.Error error) - #1 - - (#e.Success [_ parsed]) - #0))) )))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index bd66712a8..48cf24306 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -16,6 +16,6 @@ (&/= "+123" (%i +123)) (&/= "+123.456" (%f +123.456)) (&/= ".5" (%r .5)) - (&/= "\"YOLO\"" (%t "YOLO")) + (&/= (format text.double-quote "YOLO" text.double-quote) (%t "YOLO")) (&/= "User-id: +123 -- Active: #1" (format "User-id: " (%i +123) " -- Active: " (%b #1))))) ))) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 96f56c3d9..3398f4685 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -5,7 +5,8 @@ pipe ["p" parser]] [data - [text ("text/." Equivalence<Text>) + [number (#+ hex)] + ["." text ("text/." Equivalence<Text>) format ["." lexer (#+ Lexer)] ["&" regex]]] @@ -52,8 +53,8 @@ (test "Can parse character literals." (and (should-pass (&.regex "a") "a") (should-fail (&.regex "a") ".") - (should-pass (&.regex "\\.") ".") - (should-fail (&.regex "\\.") "a")))) + (should-pass (&.regex "\.") ".") + (should-fail (&.regex "\.") "a")))) (context: "Regular Expressions [System character classes]" ($_ seq @@ -61,79 +62,79 @@ (should-pass (&.regex ".") "a")) (test "Can parse digits." - (and (should-pass (&.regex "\\d") "0") - (should-fail (&.regex "\\d") "m"))) + (and (should-pass (&.regex "\d") "0") + (should-fail (&.regex "\d") "m"))) (test "Can parse non digits." - (and (should-pass (&.regex "\\D") "m") - (should-fail (&.regex "\\D") "0"))) + (and (should-pass (&.regex "\D") "m") + (should-fail (&.regex "\D") "0"))) (test "Can parse white-space." - (and (should-pass (&.regex "\\s") " ") - (should-fail (&.regex "\\s") "m"))) + (and (should-pass (&.regex "\s") " ") + (should-fail (&.regex "\s") "m"))) (test "Can parse non white-space." - (and (should-pass (&.regex "\\S") "m") - (should-fail (&.regex "\\S") " "))) + (and (should-pass (&.regex "\S") "m") + (should-fail (&.regex "\S") " "))) (test "Can parse word characters." - (and (should-pass (&.regex "\\w") "_") - (should-fail (&.regex "\\w") "^"))) + (and (should-pass (&.regex "\w") "_") + (should-fail (&.regex "\w") "^"))) (test "Can parse non word characters." - (and (should-pass (&.regex "\\W") ".") - (should-fail (&.regex "\\W") "a"))) + (and (should-pass (&.regex "\W") ".") + (should-fail (&.regex "\W") "a"))) )) (context: "Regular Expressions [Special system character classes : Part 1]" ($_ seq (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\\p{Lower}") "m") - (should-fail (&.regex "\\p{Lower}") "M")) + (and (and (should-pass (&.regex "\p{Lower}") "m") + (should-fail (&.regex "\p{Lower}") "M")) - (and (should-pass (&.regex "\\p{Upper}") "M") - (should-fail (&.regex "\\p{Upper}") "m")) + (and (should-pass (&.regex "\p{Upper}") "M") + (should-fail (&.regex "\p{Upper}") "m")) - (and (should-pass (&.regex "\\p{Alpha}") "M") - (should-fail (&.regex "\\p{Alpha}") "0")) + (and (should-pass (&.regex "\p{Alpha}") "M") + (should-fail (&.regex "\p{Alpha}") "0")) - (and (should-pass (&.regex "\\p{Digit}") "1") - (should-fail (&.regex "\\p{Digit}") "n")) + (and (should-pass (&.regex "\p{Digit}") "1") + (should-fail (&.regex "\p{Digit}") "n")) - (and (should-pass (&.regex "\\p{Alnum}") "1") - (should-fail (&.regex "\\p{Alnum}") ".")) + (and (should-pass (&.regex "\p{Alnum}") "1") + (should-fail (&.regex "\p{Alnum}") ".")) - (and (should-pass (&.regex "\\p{Space}") " ") - (should-fail (&.regex "\\p{Space}") ".")) + (and (should-pass (&.regex "\p{Space}") " ") + (should-fail (&.regex "\p{Space}") ".")) )) )) (context: "Regular Expressions [Special system character classes : Part 2]" ($_ seq (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\\p{HexDigit}") "a") - (should-fail (&.regex "\\p{HexDigit}") ".")) + (and (and (should-pass (&.regex "\p{HexDigit}") "a") + (should-fail (&.regex "\p{HexDigit}") ".")) - (and (should-pass (&.regex "\\p{OctDigit}") "6") - (should-fail (&.regex "\\p{OctDigit}") ".")) + (and (should-pass (&.regex "\p{OctDigit}") "6") + (should-fail (&.regex "\p{OctDigit}") ".")) - (and (should-pass (&.regex "\\p{Blank}") "\t") - (should-fail (&.regex "\\p{Blank}") ".")) + (and (should-pass (&.regex "\p{Blank}") text.tab) + (should-fail (&.regex "\p{Blank}") ".")) - (and (should-pass (&.regex "\\p{ASCII}") "\t") - (should-fail (&.regex "\\p{ASCII}") "\u1234")) + (and (should-pass (&.regex "\p{ASCII}") text.tab) + (should-fail (&.regex "\p{ASCII}") (text.from-code (hex "1234")))) - (and (should-pass (&.regex "\\p{Contrl}") "\u0012") - (should-fail (&.regex "\\p{Contrl}") "a")) + (and (should-pass (&.regex "\p{Contrl}") (text.from-code (hex "12"))) + (should-fail (&.regex "\p{Contrl}") "a")) - (and (should-pass (&.regex "\\p{Punct}") "@") - (should-fail (&.regex "\\p{Punct}") "a")) + (and (should-pass (&.regex "\p{Punct}") "@") + (should-fail (&.regex "\p{Punct}") "a")) - (and (should-pass (&.regex "\\p{Graph}") "@") - (should-fail (&.regex "\\p{Graph}") " ")) + (and (should-pass (&.regex "\p{Graph}") "@") + (should-fail (&.regex "\p{Graph}") " ")) - (and (should-pass (&.regex "\\p{Print}") "\u0020") - (should-fail (&.regex "\\p{Print}") "\u1234")) + (and (should-pass (&.regex "\p{Print}") (text.from-code (hex "20"))) + (should-fail (&.regex "\p{Print}") (text.from-code (hex "1234")))) )) )) @@ -190,9 +191,9 @@ )) (context: "Regular Expressions [Reference]" - (let [number (&.regex "\\d+")] + (let [number (&.regex "\d+")] (test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\\@<number>)-(\\@<number>)-(\\@<number>)") "809-345-6789")))) + (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) (context: "Regular Expressions [Fuzzy Quantifiers]" ($_ seq @@ -239,14 +240,14 @@ (test "Can extract groups of sub-matches specified in a pattern." (and (should-check ["abc" "b"] (&.regex "a(.)c") "abc") (should-check ["abbbbbc" "bbbbb"] (&.regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (&.regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (&.regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (&.regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") "809-809-6789-6789"))) + (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") + (should-check ["809-345-6789" "809" "6789"] (&.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") + (should-check ["809-809-6789" "809" "6789"] (&.regex "(\d{3})-\0-(\d{4})") "809-809-6789") + (should-check ["809-809-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) (test "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) + (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) )) (context: "Regular Expressions [Alternation]" @@ -262,7 +263,7 @@ (should-fail (&.regex "a(.)(.)|b(.)(.)") "cde") (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])] - (&.regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") + (&.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") "809-345-6789"))) )) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 8832bb3f6..835bdd719 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -88,7 +88,7 @@ (&.instance? Object "") (not (&.instance? Object (&.null))))) - (test "Can run code in a \"synchronized\" block." + (test "Can run code in a 'synchronized' block." (&.synchronized "" #1)) (test "Can access Class instances." diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index 1e0d4a606..be53adfad 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -5,7 +5,7 @@ [monad (#+ do Monad)]] [data [number] - [text ("text/." Equivalence<Text>) + ["." text ("text/." Equivalence<Text>) format]] [math ["r" random]] [macro ["&" code]]] @@ -22,7 +22,7 @@ [(&.bit #0) "#0"] [(&.int +123) "+123"] [(&.frac +123.0) "+123.0"] - [(&.text "\n") "\"\\n\""] + [(&.text "1234") (format text.double-quote "1234" text.double-quote)] [(&.tag ["yolo" "lol"]) "#yolo.lol"] [(&.identifier ["yolo" "lol"]) "yolo.lol"] [(&.form (list (&.bit #1) (&.int +123))) "(#1 +123)"] diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index b1e2f445b..0bf7b8804 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -75,9 +75,9 @@ ["Can parse Bit syntax." #1 code.bit bit.Equivalence<Bit> s.bit] ["Can parse Nat syntax." 123 code.nat number.Equivalence<Nat> s.nat] ["Can parse Int syntax." +123 code.int number.Equivalence<Int> s.int] - ["Can parse Rev syntax." .123 code.rev number.Equivalence<Rev> s.rev] + ["Can parse Rev syntax." .123 code.rev number.Equivalence<Rev> s.rev] ["Can parse Frac syntax." +123.0 code.frac number.Equivalence<Frac> s.frac] - ["Can parse Text syntax." "\n" code.text text.Equivalence<Text> s.text] + ["Can parse Text syntax." text.new-line code.text text.Equivalence<Text> s.text] ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.Equivalence<Name> s.identifier] ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.Equivalence<Name> s.tag] )] diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index fe36a58c5..38f1cc75a 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -153,13 +153,13 @@ [#let [set-10 (set.from-list number.Hash<Nat> (list.n/range 0 10))] sample (|> r.nat (:: @ map (n/% 20)))] ($_ seq - (test "Values that satisfy a predicate have membership = 1. - Values that don't have membership = 0." + (test (format "Values that satisfy a predicate have membership = 1." + "Values that don't have membership = 0.") (bit/= (r/= _.true (&.membership sample (&.from-predicate n/even?))) (n/even? sample))) - (test "Values that belong to a set have membership = 1. - Values that don't have membership = 0." + (test (format "Values that belong to a set have membership = 1." + "Values that don't have membership = 0.") (bit/= (r/= _.true (&.membership sample (&.from-set set-10))) (set.member? set-10 sample))) )))) |