aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThe Lux Programming Language2018-08-26 09:14:57 -0400
committerGitHub2018-08-26 09:14:57 -0400
commit2cfa4184f908054b7bb3c3cdc2372cfbeafdd5d2 (patch)
tree4223297955b046205c017b58cf31e490b26e8cea
parent58c299b90fbb3a20cf4e624fd20e4bb7f5846672 (diff)
parentb614f2875fb2e98e8867399b7013503f2b1a4e4c (diff)
Merge pull request #47 from LuxLang/faster-lexer
Faster new-luxc lexer/syntax
Diffstat (limited to '')
-rw-r--r--lux-mode/lux-mode.el6
-rw-r--r--luxc/src/lux/analyser/proc/common.clj134
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj49
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj49
-rw-r--r--luxc/src/lux/lexer.clj85
-rw-r--r--luxc/src/lux/reader.clj15
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux11
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux20
-rw-r--r--stdlib/source/lux.lux905
-rw-r--r--stdlib/source/lux/cli.lux4
-rw-r--r--stdlib/source/lux/compiler/default.lux58
-rw-r--r--stdlib/source/lux/compiler/default/name.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis.lux22
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/expression.lux4
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/function.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/inference.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension.lux6
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux4
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux40
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux1064
-rw-r--r--stdlib/source/lux/concurrency/actor.lux4
-rw-r--r--stdlib/source/lux/concurrency/atom.lux13
-rw-r--r--stdlib/source/lux/concurrency/stm.lux8
-rw-r--r--stdlib/source/lux/control/comonad.lux7
-rw-r--r--stdlib/source/lux/control/concatenative.lux2
-rw-r--r--stdlib/source/lux/control/exception.lux13
-rw-r--r--stdlib/source/lux/control/hash.lux5
-rw-r--r--stdlib/source/lux/control/monoid.lux5
-rw-r--r--stdlib/source/lux/control/pipe.lux2
-rw-r--r--stdlib/source/lux/control/region.lux12
-rw-r--r--stdlib/source/lux/data/bit.lux4
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux10
-rw-r--r--stdlib/source/lux/data/collection/list.lux22
-rw-r--r--stdlib/source/lux/data/collection/sequence.lux13
-rw-r--r--stdlib/source/lux/data/format/css.lux2
-rw-r--r--stdlib/source/lux/data/format/html.lux18
-rw-r--r--stdlib/source/lux/data/format/json.lux40
-rw-r--r--stdlib/source/lux/data/format/xml.lux22
-rw-r--r--stdlib/source/lux/data/maybe.lux13
-rw-r--r--stdlib/source/lux/data/number.lux232
-rw-r--r--stdlib/source/lux/data/text.lux76
-rw-r--r--stdlib/source/lux/data/text/lexer.lux255
-rw-r--r--stdlib/source/lux/data/text/regex.lux109
-rw-r--r--stdlib/source/lux/host.jvm.lux6
-rw-r--r--stdlib/source/lux/interpreter.lux17
-rw-r--r--stdlib/source/lux/io.lux6
-rw-r--r--stdlib/source/lux/macro.lux30
-rw-r--r--stdlib/source/lux/macro/poly.lux6
-rw-r--r--stdlib/source/lux/macro/syntax.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux5
-rw-r--r--stdlib/source/lux/math/modular.lux14
-rw-r--r--stdlib/source/lux/math/random.lux10
-rw-r--r--stdlib/source/lux/test.lux16
-rw-r--r--stdlib/source/lux/time/date.lux5
-rw-r--r--stdlib/source/lux/time/instant.lux5
-rw-r--r--stdlib/source/lux/type.lux4
-rw-r--r--stdlib/source/lux/type/check.lux6
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux4
-rw-r--r--stdlib/test/test/lux/compiler/default/syntax.lux139
-rw-r--r--stdlib/test/test/lux/data/text/format.lux2
-rw-r--r--stdlib/test/test/lux/data/text/regex.lux105
-rw-r--r--stdlib/test/test/lux/host.jvm.lux2
-rw-r--r--stdlib/test/test/lux/macro/code.lux4
-rw-r--r--stdlib/test/test/lux/macro/syntax.lux4
-rw-r--r--stdlib/test/test/lux/math/logic/fuzzy.lux8
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 "&" "&amp;")
(text.replace-all "<" "&lt;")
(text.replace-all ">" "&gt;")
- (text.replace-all "\"" "&quot;")
+ (text.replace-all text.double-quote "&quot;")
(text.replace-all "'" "&#x27;")
(text.replace-all "/" "&#x2F;")))
@@ -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 "&gt;") (parser/wrap ">"))
(p.after (l.this "&amp;") (parser/wrap "&"))
(p.after (l.this "&apos;") (parser/wrap "'"))
- (p.after (l.this "&quot;") (parser/wrap "\""))))
+ (p.after (l.this "&quot;") (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 "<" "&lt;")
(text.replace-all ">" "&gt;")
(text.replace-all "'" "&apos;")
- (text.replace-all "\"" "&quot;")))
+ (text.replace-all text.double-quote "&quot;")))
(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)))
))))