- Added more common procedures.

- Fixed some bugs in the type-checking of some common procedures.
- Removed the "_name" field for generated classes.
- Now compiling loops in JS.
- Did some refactoring to the caching machinery.
- Implemented binary, octal and hexadecimal encoding purely in Lux.

8 files changed, 111 insertions, 88 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))]