From 9ccc8ea44ebe4f9a3d40c8e94b55f77c0d815099 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 20 Aug 2018 23:23:02 -0400 Subject: Some refactoring. --- luxc/src/lux/lexer.clj | 7 ++++--- luxc/src/lux/reader.clj | 15 +++++++++------ 2 files changed, 13 insertions(+), 9 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index f74e14dfd..0a09c0619 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -26,8 +26,9 @@ ) ;; [Utils] -(defn ^:private clean-line [^String raw-line] +(defn- clean-line "(-> Text Text)" + [^String raw-line] (let [line-length (.length raw-line) buffer (new StringBuffer line-length)] (loop [idx 0] @@ -61,7 +62,7 @@ (recur (+ 1 idx))))) (.toString buffer))))) -(defn ^:private lex-text-body [multi-line? offset] +(defn- 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**))] @@ -110,7 +111,7 @@ [meta _ comment] (&reader/read-regex #"^(.*)$")] (return (&/T [meta ($Comment comment)])))) -(defn ^:private lex-multi-line-comment [_] +(defn- lex-multi-line-comment [_] (|do [_ (&reader/read-text "#(") [meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex+ #"(?is)^(?!#\()((?!\)#).)*")] (return (&/T [meta comment]))) 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) -- cgit v1.2.3 From 6c896325238b63b6fc09f774968be6da0b9c89c1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 17:40:33 -0400 Subject: No more multi-line comments. --- luxc/src/lux/lexer.clj | 17 +---------------- 1 file changed, 1 insertion(+), 16 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 0a09c0619..9e1414b7f 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -106,26 +106,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- 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 [ ] (def (|do [[meta _ token] (&reader/read-regex )] -- cgit v1.2.3 From b60d60ef6c0c70821991991fe716935e73038832 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 19:42:17 -0400 Subject: No more multi-line text. --- luxc/src/lux/lexer.clj | 39 ++++++++++++--------------------------- 1 file changed, 12 insertions(+), 27 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 9e1414b7f..e81599957 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -62,39 +62,24 @@ (recur (+ 1 idx))))) (.toString buffer))))) -(defn- 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**)) +(defn- lex-text-body [_] + (|do [[_ _ ^String pre-quotes*] (&reader/read-regex #"^([^\"]*)") [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* ""]))))] + (if (if-let [^String back-slashes (re-find #"\\+$" pre-quotes*)] + (odd? (.length back-slashes))) + (|do [[_ _ _] (&reader/read-regex #"^([\"])") + next-part (lex-text-body nil)] + (return (&/T [(.substring pre-quotes* 0 (dec (.length pre-quotes*))) + (str "\"" next-part)]))) + (|do [post-quotes* (lex-text-body nil)] + (return (&/T [pre-quotes* post-quotes*])))) + (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)) + token (lex-text-body nil) _ (&reader/read-text "\"")] (return (&/T [meta ($Text token)])))) -- cgit v1.2.3 From 5e13ae0ad68947249a98dc69ab513bdbeca1697e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:50:33 -0400 Subject: No more escaping of horizontal-tab. --- luxc/src/lux/lexer.clj | 2 -- 1 file changed, 2 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index e81599957..37f5fdbed 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -37,8 +37,6 @@ (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") -- cgit v1.2.3 From bf893b3aa2b43c11b1cbb95fb8641f6ae6aa06b0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:53:11 -0400 Subject: No more escaping of back-space. --- luxc/src/lux/lexer.clj | 2 -- 1 file changed, 2 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 37f5fdbed..981b35178 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -39,8 +39,6 @@ (case (.charAt raw-line (+ 1 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") -- cgit v1.2.3 From 533864f86be183cbbb7c11516910acf711d281f4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:54:59 -0400 Subject: No more escaping of form-feed. --- luxc/src/lux/lexer.clj | 2 -- 1 file changed, 2 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 981b35178..00964a057 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -43,8 +43,6 @@ (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 "\\") -- cgit v1.2.3 From f4f1d14416770cc223676a7d89ed15a11222ef1b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:56:56 -0400 Subject: No more escaping of carriage-return. --- luxc/src/lux/lexer.clj | 2 -- 1 file changed, 2 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 00964a057..d52464d5d 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -41,8 +41,6 @@ (recur (+ 2 idx))) \n (do (.append buffer "\n") (recur (+ 2 idx))) - \r (do (.append buffer "\r") - (recur (+ 2 idx))) \" (do (.append buffer "\"") (recur (+ 2 idx))) \\ (do (.append buffer "\\") -- cgit v1.2.3 From 79c2988c1b514657cc384070e66539e51e105987 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 22:59:20 -0400 Subject: No more escaping of vertical-tab. --- luxc/src/lux/lexer.clj | 2 -- 1 file changed, 2 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index d52464d5d..02f1e088a 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -37,8 +37,6 @@ (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)) - \v (do (.append buffer "\u000B") - (recur (+ 2 idx))) \n (do (.append buffer "\n") (recur (+ 2 idx))) \" (do (.append buffer "\"") -- cgit v1.2.3 From 324665cef68fa326d358733d36ed20feba5dbbd6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 23:25:04 -0400 Subject: No more escaping of unicode. --- luxc/src/lux/lexer.clj | 3 --- 1 file changed, 3 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 02f1e088a..1b4722083 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -43,9 +43,6 @@ (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) -- cgit v1.2.3 From a89088576c4e586d3dad18f82eb451ff4eaa14fb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 00:03:26 -0400 Subject: No more escaping of double-quotes. --- luxc/src/lux/lexer.clj | 2 -- 1 file changed, 2 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 1b4722083..8f6d4e19c 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -39,8 +39,6 @@ (case (.charAt raw-line (+ 1 idx)) \n (do (.append buffer "\n") (recur (+ 2 idx))) - \" (do (.append buffer "\"") - (recur (+ 2 idx))) \\ (do (.append buffer "\\") (recur (+ 2 idx))) ;; else -- cgit v1.2.3 From bc251026c21590da76085bc0bc9abeaa5ec242b6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 00:56:59 -0400 Subject: No more escaping of new-line. --- luxc/src/lux/lexer.clj | 20 ++------------------ 1 file changed, 2 insertions(+), 18 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 8f6d4e19c..fc572790b 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -37,8 +37,6 @@ (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)) - \n (do (.append buffer "\n") - (recur (+ 2 idx))) \\ (do (.append buffer "\\") (recur (+ 2 idx))) ;; else @@ -47,26 +45,12 @@ (recur (+ 1 idx))))) (.toString buffer))))) -(defn- lex-text-body [_] - (|do [[_ _ ^String pre-quotes*] (&reader/read-regex #"^([^\"]*)") - [pre-quotes post-quotes] (if (.endsWith pre-quotes* "\\") - (if (if-let [^String back-slashes (re-find #"\\+$" pre-quotes*)] - (odd? (.length back-slashes))) - (|do [[_ _ _] (&reader/read-regex #"^([\"])") - next-part (lex-text-body nil)] - (return (&/T [(.substring pre-quotes* 0 (dec (.length pre-quotes*))) - (str "\"" next-part)]))) - (|do [post-quotes* (lex-text-body nil)] - (return (&/T [pre-quotes* post-quotes*])))) - (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 nil) + [_ _ ^String content] (&reader/read-regex #"^([^\"]*)") _ (&reader/read-text "\"")] - (return (&/T [meta ($Text token)])))) + (return (&/T [meta ($Text (clean-line content))])))) (def +ident-re+ #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") -- cgit v1.2.3 From 7e312258b13c5fc9c80079fede0e41d479a8a327 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 01:24:29 -0400 Subject: No more escaping of back-slash. --- luxc/src/lux/lexer.clj | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index fc572790b..8ed75b940 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -26,31 +26,12 @@ ) ;; [Utils] -(defn- clean-line - "(-> Text Text)" - [^String raw-line] - (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)) - \\ (do (.append buffer "\\") - (recur (+ 2 idx))) - ;; else - (assert false (str "[Lexer Error] Invalid escaping syntax: " raw-line " " idx)))) - (do (.append buffer current-char) - (recur (+ 1 idx))))) - (.toString buffer))))) - (def lex-text (|do [[meta _ _] (&reader/read-text "\"") :let [[_ _ _column] meta] [_ _ ^String content] (&reader/read-regex #"^([^\"]*)") _ (&reader/read-text "\"")] - (return (&/T [meta ($Text (clean-line content))])))) + (return (&/T [meta ($Text content)])))) (def +ident-re+ #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") -- cgit v1.2.3 From d9965e587905cd715ecd4c7150236d660321a02c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 17:18:30 -0400 Subject: Optimized text clipping. --- luxc/src/lux/analyser/proc/common.clj | 2 +- luxc/src/lux/compiler/jvm/proc/common.clj | 2 +- luxc/src/lux/compiler/jvm/rt.clj | 64 ++++++++++--------------------- 3 files changed, 23 insertions(+), 45 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 8c6bd9d88..b52589460 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -65,7 +65,7 @@ =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"]) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 36f23263d..90f7b6bcf 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] diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 6b9aeb680..97b767863 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -340,49 +340,27 @@ 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))) + (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" "charAt" "(I)C") + (.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 -- cgit v1.2.3 From 312cc7dc5f0be0ef0a48ea8470d8ee64b929bc7b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 19:02:47 -0400 Subject: "lux text char" is now unsafe/optimized. --- luxc/src/lux/analyser/proc/common.clj | 2 +- luxc/src/lux/compiler/jvm/proc/common.clj | 4 +++- luxc/src/lux/compiler/jvm/rt.clj | 27 +-------------------------- 3 files changed, 5 insertions(+), 28 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index b52589460..90db8a2cd 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -90,7 +90,7 @@ (|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values] =text (&&/analyse-1 analyse &type/Text text) =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type (&/$Apply &type/Nat &type/Maybe)) + _ (&type/check exo-type &type/Nat) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "char"]) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 90f7b6bcf..b5d0ea475 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -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] diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 97b767863..948f08805 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -339,30 +339,6 @@ (.visitEnd))] nil)) -(defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] - (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" "charAt" "(I)C") - (.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 @@ -467,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))))) -- cgit v1.2.3 From a7f0b1e2c0f2c7c2f5d3fb0ea6e35e3f5957e1fd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 22:20:43 -0400 Subject: Added a special compiler optimization to pattern-match on characters faster. --- luxc/src/lux/analyser/proc/common.clj | 129 ++++++++++++++++++------------ luxc/src/lux/compiler/jvm/proc/common.clj | 40 ++++++++- 2 files changed, 116 insertions(+), 53 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 90db8a2cd..7ce4974f7 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 [ ] - (defn [analyse exo-type ?values] + (defn- [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] =x (&&/analyse-1 analyse x) =y (&&/analyse-1 analyse y) @@ -39,13 +39,13 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|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 [ ] - (defn [analyse exo-type ?values] + (defn- [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,10 +57,10 @@ (&/|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) @@ -73,7 +73,7 @@ (&/|list))))))) (do-template [ ] - (defn [analyse exo-type ?values] + (defn- [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Nil)) ?values] =text (&&/analyse-1 analyse &type/Text text) _ (&type/check exo-type &type/Nat) @@ -83,10 +83,10 @@ (&/|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) @@ -100,7 +100,7 @@ (do-template [ ] (let [inputT (&/$Apply &type/Any &type/I64) outputT &type/I64] - (defn [analyse exo-type ?values] + (defn- [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" ]) (&/|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 [ ] (let [inputT (&/$Apply &type/Any &type/I64) outputT &type/I64] - (defn [analyse exo-type ?values] + (defn- [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" ]) (&/|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 [ ] (let [inputT outputT ] - (defn [analyse exo-type ?values] + (defn- [analyse exo-type ?values] (|do [:let [(&/$Cons subjectC (&/$Cons paramC (&/$Nil))) ?values] subjectA (&&/analyse-1 analyse subjectC) paramA (&&/analyse-1 analyse paramC) @@ -143,15 +143,15 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|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 [ ] (let [inputT outputT ] - (defn [analyse exo-type ?values] + (defn- [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] =x (&&/analyse-1 analyse x) =y (&&/analyse-1 analyse y) @@ -160,22 +160,22 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|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 [ ] - (do (defn [analyse exo-type ?values] + (do (defn- [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse x) _ (&type/check exo-type &type/Text) @@ -184,7 +184,7 @@ (&&/$proc (&/T ) (&/|list =x) (&/|list))))))) (let [decode-type (&/$Apply &type/Maybe)] - (defn [analyse exo-type ?values] + (defn- [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 ) (&/|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 [ ] - (defn [analyse exo-type ?values] + (defn- [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type ) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|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 [ ] - (defn [analyse exo-type ?values] + (defn- [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse x) _ (&type/check exo-type ) @@ -217,22 +217,43 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|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 [[?pattern ?match] ?pair] + (|case ?pattern + [_ (&/$Text ^String ?pattern-char)] + (|do [=match (&&/analyse-1 analyse exo-type ?match)] + (return (&/T [(int (.charAt ?pattern-char 0)) + =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 +302,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 b5d0ea475..dafcb64ef 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -371,12 +371,50 @@ &&/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 [?patterns+?matches* (->> (&/zip2 ?patterns ?matches) + &/->seq + (sort-by &/|first <) + &/->list) + ?patterns* (&/|map &/|first ?patterns+?matches*) + ?matches* (&/|map &/|second ?patterns+?matches*) + end-label (new Label) + else-label (new Label) + pattern-labels (&/|map (fn [_] (new Label)) ?patterns*)] + _ (compile ?input) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I) + (.visitLookupSwitchInsn else-label + (int-array (&/->seq ?patterns*)) + (into-array (&/->seq pattern-labels))))] + _ (&/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 -- cgit v1.2.3 From 676fbcc0d6a8962ce9cb83136b2a0d0e9ff1e28e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 24 Aug 2018 00:19:02 -0400 Subject: Some micro-optimizations. --- luxc/src/lux/analyser/proc/common.clj | 13 +++++++------ luxc/src/lux/compiler/jvm/proc/common.clj | 25 ++++++++++++++----------- 2 files changed, 21 insertions(+), 17 deletions(-) (limited to 'luxc') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 7ce4974f7..fbdf05546 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -239,12 +239,13 @@ =input (&&/analyse-1 analyse &type/Nat ?input) _ (assert! (even? (&/|length ?pairs)) "The number of matches must be even!") =pairs (&/map% (fn [?pair] - (|let [[?pattern ?match] ?pair] - (|case ?pattern - [_ (&/$Text ^String ?pattern-char)] - (|do [=match (&&/analyse-1 analyse exo-type ?match)] - (return (&/T [(int (.charAt ?pattern-char 0)) - =match])))))) + (|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 diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index dafcb64ef..5cff63d86 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -374,22 +374,25 @@ (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 [?patterns+?matches* (->> (&/zip2 ?patterns ?matches) - &/->seq - (sort-by &/|first <) - &/->list) - ?patterns* (&/|map &/|first ?patterns+?matches*) - ?matches* (&/|map &/|second ?patterns+?matches*) + :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) - pattern-labels (&/|map (fn [_] (new Label)) ?patterns*)] + else-label (new Label)] _ (compile ?input) :let [_ (doto *writer* &&/unwrap-long (.visitInsn Opcodes/L2I) (.visitLookupSwitchInsn else-label - (int-array (&/->seq ?patterns*)) - (into-array (&/->seq pattern-labels))))] + (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* @@ -398,7 +401,7 @@ :let [_ (doto *writer* (.visitJumpInsn Opcodes/GOTO end-label))]] (return nil)))) - (&/zip2 pattern-labels ?matches*)) + (&/zip2 pattern-labels ?matches)) :let [_ (doto *writer* (.visitLabel else-label))] _ (compile ?else) -- cgit v1.2.3