aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser/proc/common.clj56
-rw-r--r--luxc/src/lux/base.clj1
-rw-r--r--luxc/src/lux/compiler/js.clj7
-rw-r--r--luxc/src/lux/compiler/js/lux.clj29
-rw-r--r--luxc/src/lux/compiler/js/proc/common.clj25
-rw-r--r--luxc/src/lux/compiler/js/rt.clj11
-rw-r--r--luxc/src/lux/compiler/jvm/cache.clj66
-rw-r--r--luxc/src/lux/compiler/jvm/lux.clj4
-rw-r--r--stdlib/source/lux/data/number.lux42
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"))]
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 20:15:52 +0000