diff options
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 56 | ||||
| -rw-r--r-- | luxc/src/lux/base.clj | 1 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js.clj | 7 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/lux.clj | 29 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/proc/common.clj | 25 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/rt.clj | 11 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/cache.clj | 66 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/lux.clj | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 42 |
9 files changed, 145 insertions, 96 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 4a4048c1c..bec0855e1 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -24,7 +24,7 @@ =y (&&/analyse-1 analyse <input-type> y) _ (&type/check exo-type <output-type>) _cursor &/cursor] - (return (&/|list (&&/|meta <output-type> _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list))))))) ^:private analyse-text-eq ["text" "="] &type/Text &type/Bool @@ -38,7 +38,7 @@ =part (&&/analyse-1 analyse &type/Text part) _ (&type/check exo-type (&/$AppT &type/Maybe &type/Nat)) _cursor &/cursor] - (return (&/|list (&&/|meta &type/Text _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" <proc-name>]) (&/|list =text =part) (&/|list))))))) @@ -71,24 +71,41 @@ (&/|list =text =to-find =replace-with) (&/|list))))))) -(defn ^:private analyse-text-trim [analyse exo-type ?values] +(defn ^:private analyse-text-size [analyse exo-type ?values] (|do [:let [(&/$Cons text (&/$Nil)) ?values] =text (&&/analyse-1 analyse &type/Text text) - _ (&type/check exo-type &type/Text) + _ (&type/check exo-type &type/Nat) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["text" "trim"]) + (&&/$proc (&/T ["text" "size"]) (&/|list =text) (&/|list))))))) -(defn ^:private analyse-text-size [analyse exo-type ?values] - (|do [:let [(&/$Cons text (&/$Nil)) ?values] +(do-template [<name> <proc>] + (defn <name> [analyse exo-type ?values] + (|do [:let [(&/$Cons text (&/$Nil)) ?values] + =text (&&/analyse-1 analyse &type/Text text) + _ (&type/check exo-type &type/Text) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["text" <proc>]) + (&/|list =text) + (&/|list))))))) + + ^:private analyse-text-trim "trim" + ^:private analyse-text-upper-case "upper-case" + ^:private analyse-text-lower-case "lower-case" + ) + +(defn ^:private analyse-text-char [analyse exo-type ?values] + (|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values] =text (&&/analyse-1 analyse &type/Text text) - _ (&type/check exo-type &type/Nat) + =idx (&&/analyse-1 analyse &type/Nat idx) + _ (&type/check exo-type (&/$AppT &type/Maybe &type/Char)) _cursor &/cursor] - (return (&/|list (&&/|meta &type/Text _cursor - (&&/$proc (&/T ["text" "size"]) - (&/|list =text) + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["text" "char"]) + (&/|list =text =idx) (&/|list))))))) (do-template [<name> <op>] @@ -136,7 +153,7 @@ =y (&&/analyse-1 analyse <input-type> y) _ (&type/check exo-type <output-type>) _cursor &/cursor] - (return (&/|list (&&/|meta <output-type> _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list))))))) ^:private analyse-nat-add ["nat" "+"] &type/Nat &type/Nat @@ -178,7 +195,7 @@ =y (&&/analyse-1 analyse &type/Nat y) _ (&type/check exo-type &type/Deg) _cursor &/cursor] - (return (&/|list (&&/|meta &type/Deg _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["deg" "scale"]) (&/|list =x =y) (&/|list))))))) (do-template [<encode> <encode-op> <decode> <decode-op> <type>] @@ -187,7 +204,7 @@ =x (&&/analyse-1 analyse <type> x) _ (&type/check exo-type &type/Text) _cursor &/cursor] - (return (&/|list (&&/|meta &type/Text _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list))))))) (let [decode-type (&/$AppT &type/Maybe <type>)] @@ -196,7 +213,7 @@ =x (&&/analyse-1 analyse &type/Text x) _ (&type/check exo-type decode-type) _cursor &/cursor] - (return (&/|list (&&/|meta decode-type _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list))))))))) ^:private analyse-nat-encode ["nat" "encode"] ^:private analyse-nat-decode ["nat" "decode"] &type/Nat @@ -210,7 +227,7 @@ (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type <type>) _cursor &/cursor] - (return (&/|list (&&/|meta <type> _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <op>) (&/|list) (&/|list))))))) ^:private analyse-nat-min-value &type/Nat ["nat" "min-value"] @@ -235,7 +252,7 @@ =x (&&/analyse-1 analyse <from-type> x) _ (&type/check exo-type <to-type>) _cursor &/cursor] - (return (&/|list (&&/|meta <to-type> _cursor + (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <op>) (&/|list =x) (&/|list))))))) ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"] @@ -331,7 +348,10 @@ "last-index" (analyse-text-last-index analyse exo-type ?values) "size" (analyse-text-size analyse exo-type ?values) "replace-all" (analyse-text-replace-all analyse exo-type ?values) - "trim" (analyse-text-trim analyse exo-type ?values)) + "trim" (analyse-text-trim analyse exo-type ?values) + "char" (analyse-text-char analyse exo-type ?values) + "upper-case" (analyse-text-upper-case analyse exo-type ?values) + "lower-case" (analyse-text-lower-case analyse exo-type ?values)) "bit" (case proc diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index f449a7b3c..1a9fadf63 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -220,7 +220,6 @@ ("DictA" 1)) ;; [Exports] -(def ^:const name-field "_name") (def ^:const hash-field "_hash") (def ^:const value-field "_value") (def ^:const compiler-field "_compiler") diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj index 2e7d01d44..5bb97728f 100644 --- a/luxc/src/lux/compiler/js.clj +++ b/luxc/src/lux/compiler/js.clj @@ -71,8 +71,8 @@ (&o/$apply ?fn ?args) (&&lux/compile-apply compile-expression ?fn ?args) - ;; (&o/$loop _register-offset _inits _body) - ;; (&&lux/compile-loop compile-expression _register-offset _inits _body) + (&o/$loop _register-offset _inits _body) + (&&lux/compile-loop compile-expression _register-offset _inits _body) (&o/$iter _register-offset ?args) (&&lux/compile-iter compile-expression _register-offset ?args) @@ -157,8 +157,7 @@ ?state) (&/$Left ?message) - (&/fail* ?message))))))) - ) + (&/fail* ?message)))))))) )) (let [!err! *err*] diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj index f0ad777c6..39f943dda 100644 --- a/luxc/src/lux/compiler/js/lux.clj +++ b/luxc/src/lux/compiler/js/lux.clj @@ -91,21 +91,15 @@ =args (&/map% compile ?args)] (return (str =fn "(" (->> =args (&/|interpose ",") (&/fold str "")) ")")))) -;; (defn compile-loop [compile-expression register-offset inits body] -;; (|do [^MethodVisitor *writer* &/get-writer -;; :let [idxs+inits (&/zip2 (&/|range* 0 (dec (&/|length inits))) -;; inits)] -;; _ (&/map% (fn [idx+_init] -;; (|do [:let [[idx _init] idx+_init -;; idx+ (+ register-offset idx)] -;; _ (compile-expression nil _init) -;; :let [_ (.visitVarInsn *writer* Opcodes/ASTORE idx+)]] -;; (return nil))) -;; idxs+inits) -;; :let [$begin (new Label) -;; _ (.visitLabel *writer* $begin)]] -;; (compile-expression $begin body) -;; )) +(defn compile-loop [compile register-offset inits body] + (|do [:let [registers (&/|map #(->> % (+ register-offset) register-name) + (&/|range* 0 (dec (&/|length inits))))] + register-inits (&/map% compile inits) + =body (compile body)] + (return (str "(function _loop(" (->> registers (&/|interpose ",") (&/fold str "")) ") {" + =body + "})(" (->> register-inits (&/|interpose ",") (&/fold str "")) ")")) + )) (defn compile-iter [compile register-offset ?args] ;; Can only optimize if it is a simple expression. @@ -128,7 +122,7 @@ ;; ?args)] ;; (return updates)) (|do [=args (&/map% compile ?args)] - (return (str "_0(" + (return (str "_loop(" (->> =args (&/|interpose ",") (&/fold str "")) ")"))) ) @@ -304,7 +298,8 @@ "\"use strict\";" "var num_args = arguments.length;" "if(num_args == " arity ") {" - "var " (register-name 0) " = " function-name ";" + (str "var " (register-name 0) " = " function-name ";") + (str "var _loop = " function-name ";") func-args (str "while(true) {" "return " =body ";" diff --git a/luxc/src/lux/compiler/js/proc/common.clj b/luxc/src/lux/compiler/js/proc/common.clj index 23454914e..ee381add4 100644 --- a/luxc/src/lux/compiler/js/proc/common.clj +++ b/luxc/src/lux/compiler/js/proc/common.clj @@ -310,16 +310,28 @@ =replace-with (compile ?replace-with)] (return (str "LuxRT.replaceAll(" (str =text "," =to-find "," =replace-with) ")")))) -(defn ^:private compile-text-trim [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] - =text (compile ?text)] - (return (str "(" =text ").trim()")))) - (defn ^:private compile-text-size [compile ?values special-args] (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] =text (compile ?text)] (return (str "LuxRT.fromNumberI64(" =text ".length" ")")))) +(defn ^:private compile-text-char [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?idx (&/$Nil))) ?values] + =text (compile ?text) + =idx (compile ?idx)] + (return (str "LuxRT.textChar(" (str =text "," =idx) ")")))) + +(do-template [<name> <method>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + =text (compile ?text)] + (return (str "(" =text ")." <method> "()")))) + + ^:private compile-text-trim "trim" + ^:private compile-text-upper-case "toUpperCase" + ^:private compile-text-lower-case "toLowerCase" + ) + (defn ^:private compile-char-to-text [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] =x (compile ?x)] @@ -356,6 +368,9 @@ "size" (compile-text-size compile ?values special-args) "replace-all" (compile-text-replace-all compile ?values special-args) "trim" (compile-text-trim compile ?values special-args) + "char" (compile-text-char compile ?values special-args) + "upper-case" (compile-text-upper-case compile ?values special-args) + "lower-case" (compile-text-lower-case compile ?values special-args) ) ;; "bit" diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj index 1cb4a6150..eaac37a6a 100644 --- a/luxc/src/lux/compiler/js/rt.clj +++ b/luxc/src/lux/compiler/js/rt.clj @@ -1264,6 +1264,17 @@ "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');" "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);" "})") + "textChar" (str "(function textChar(text,idx) {" + "var result = text.charAt(idx);" + (str "if(result === '') {" + (str "return " (make-some "result") ";") + "}" + "else {" + (str "return " const-none ";") + "}") + "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');" + "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);" + "})") }) (def LuxRT "LuxRT") diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj index e75e09f1b..cfbaf3810 100644 --- a/luxc/src/lux/compiler/jvm/cache.clj +++ b/luxc/src/lux/compiler/jvm/cache.clj @@ -19,7 +19,8 @@ (:import (java.io File BufferedOutputStream FileOutputStream) - (java.lang.reflect Field))) + (java.lang.reflect Field) + )) ;; [Utils] (defn ^:private read-file [^File file] @@ -30,12 +31,6 @@ (.read reader buffer 0 length) buffer))) -(defn ^:private clean-file [^File file] - "(-> File (,))" - (doseq [^File f (seq (.listFiles file)) - :when (not (.isDirectory f))] - (.delete f))) - (defn ^:private get-field [^String field-name ^Class class] "(-> Text Class Object)" (-> class ^Field (.getField field-name) (.get nil))) @@ -43,20 +38,24 @@ ;; [Resources] (def module-class-file (str &/module-class-name ".class")) +(defn ^:private delete-all-module-files [^File file] + (doseq [^File f (seq (.listFiles file)) + :when (not (.isDirectory f))] + (.delete f))) + +(defn ^:private module-path [module] + (str @&&core/!output-dir + java.io.File/separator + (.replace ^String (&host/->module-class module) "/" java.io.File/separator))) + (defn cached? [module] "(-> Text Bool)" - (.exists (new File (str @&&core/!output-dir - java.io.File/separator - (.replace ^String (&host/->module-class module) "/" java.io.File/separator) - java.io.File/separator - module-class-file)))) + (.exists (new File (str (module-path module) java.io.File/separator &&core/lux-module-descriptor-name)))) (defn delete [module] "(-> Text (Lux Null))" (fn [state] - (do (clean-file (new File (str @&&core/!output-dir - java.io.File/separator - (.replace ^String (&host/->module-class module) "/" java.io.File/separator)))) + (do (delete-all-module-files (new File (module-path module))) (return* state nil)))) (defn ^:private module-dirs @@ -85,30 +84,19 @@ corrected-dir-module))) (filter outdated?))] (doseq [^String f outdated-modules] - (clean-file (new File (str output-dir-prefix f)))) + (delete-all-module-files (new File (str output-dir-prefix f)))) nil)) -(defn ^:private install-all-classes-in-module [!classes module* ^String module-path] - (let [classes+bytecode (for [^File file (seq (.listFiles (File. module-path))) - :when (not (.isDirectory file)) - :let [file-name (.getName file)] - :when (not= module-class-file file-name)] - [(second (re-find #"^(.*)\.class$" file-name)) - (read-file file)]) - _ (doseq [[class-name bytecode] classes+bytecode] - (swap! !classes assoc (str module* "." class-name) bytecode))] - (map first classes+bytecode))) - -(defn ^:private assume-async-result - "(-> (Error Compiler) (Lux Null))" - [result] - (fn [_] - (|case result - (&/$Left error) - (&/$Left error) - - (&/$Right compiler) - (return* compiler nil)))) +(defn ^:private install-all-defs-in-module [!classes module* ^String module-path] + (let [file-name+content (for [^File file (seq (.listFiles (File. module-path))) + :when (not (.isDirectory file)) + :let [file-name (.getName file)] + :when (not= module-class-file file-name)] + [(second (re-find #"^(.*)\.class$" file-name)) + (read-file file)]) + _ (doseq [[file-name content] file-name+content] + (swap! !classes assoc (str module* "." file-name) content))] + (map first file-name+content))) (defn ^:private parse-tag-groups [^String tags-section] (if (= "" tags-section) @@ -225,7 +213,7 @@ class-name (str module* "." &/module-class-name) ^Class module-class (do (swap! !classes assoc class-name (read-file (new File (str module-path java.io.File/separator module-class-file)))) (&&/load-class! loader class-name)) - installed-classes (install-all-classes-in-module !classes module* module-path) + installed-classes (install-all-defs-in-module !classes module* module-path) valid-cache? (and (= module-hash (get-field &/hash-field module-class)) (= &/compiler-version (get-field &/compiler-field module-class))) drop-cache! (|do [_ (uninstall-cache module) @@ -240,7 +228,7 @@ (return cache-table*)) drop-cache!)))) -(def !pre-loaded-cache (atom nil)) +(def ^:private !pre-loaded-cache (atom nil)) (defn pre-load-cache! [source-dirs] (|do [:let [fs-cached-modules (enumerate-cached-modules!)] pre-loaded-modules (&/fold% (fn [cache-table module-name] diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 64760bbb6..12a2f83c7 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -283,8 +283,6 @@ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version class-flags current-class nil &&/function-class (into-array String [])) - (-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name) - (doto (.visitEnd))) (-> (.visitField field-flags &/value-field datum-sig nil nil) (doto (.visitEnd))) (.visitSource file-name nil))] @@ -353,8 +351,6 @@ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version class-flags current-class nil "java/lang/Object" (into-array String [])) - (-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name) - (doto (.visitEnd))) (-> (.visitField field-flags &/value-field datum-sig nil nil) (doto (.visitEnd))) (.visitSource file-name nil))] diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index ce0d5f887..cad152f2b 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,15 +178,38 @@ (not (r.= number number))) ## [Values & Syntax] -(do-template [<struct> <to-proc> <radix> <macro> <error> <doc>] +(do-template [<struct> <base> <macro> <error> <char-set> <doc>] [(struct: #export <struct> (Codec Text Nat) (def: (encode value) - (_lux_proc ["jvm" <to-proc>] [(nat-to-int value)])) + (loop [input value + output ""] + (let [digit (assume (_lux_proc ["text" "char"] [<char-set> (n.% <base> input)])) + output' (_lux_proc ["text" "append"] [(_lux_proc ["char" "to-text"] [digit]) + output]) + input' (n./ <base> input)] + (if (n.= +0 input') + output' + (recur input' output'))))) (def: (decode repr) - (_lux_proc ["jvm" "try"] - [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:parseUnsignedLong:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])]))) - (lambda [ex] (#;Left <error>))]))) + (let [input-size (_lux_proc ["text" "size"] [repr])] + (if (n.= +0 input-size) + (#;Left "Empty input.") + (let [input (_lux_proc ["text" "upper-case"] [repr])] + (loop [idx +0 + output +0] + (if (n.< input-size idx) + (let [digit (assume (_lux_proc ["text" "char"] [input idx]))] + (case (_lux_proc ["text" "index"] + [input + (_lux_proc ["char" "to-text"] [digit])]) + #;None + (#;Left <error>) + + (#;Some index) + (recur (n.inc idx) + (|> output (n.* <base>) (n.* index))))) + (#;Right output)))))))) (macro: #export (<macro> tokens state) {#;doc <doc>} @@ -202,13 +225,16 @@ _ (#;Left <error>)))] - [Binary@Codec<Text,Nat> "invokestatic:java.lang.Long:toBinaryString:long" 2 bin "Invalid binary syntax." + [Binary@Codec<Text,Nat> +2 bin "Invalid binary syntax." + "01" (doc "Given syntax for a binary number, generates a Nat." (bin "11001001"))] - [Octal@Codec<Text,Nat> "invokestatic:java.lang.Long:toOctalString:long" 8 oct "Invalid octal syntax." + [Octal@Codec<Text,Nat> +8 oct "Invalid octal syntax." + "01234567" (doc "Given syntax for an octal number, generates a Nat." (oct "615243"))] - [Hex@Codec<Text,Nat> "invokestatic:java.lang.Long:toHexString:long" 16 hex "Invalid hexadecimal syntax." + [Hex@Codec<Text,Nat> +16 hex "Invalid hexadecimal syntax." + "0123456789ABCDEF" (doc "Given syntax for a hexadecimal number, generates a Nat." (hex "deadBEEF"))] ) |