- VarT and ExT types are now treated as java.lang.Object.

- Now wrapping primitive method arguments inside objects, as Lux code always assumes everything is an object.
- Now using a hand-made text lexer, that is less tolerant of escaping-cleanup errors.
- When packaging the contents of dependency JARs inside the output program JAR, the compressed size of the entries is recalculated with (.setCompressedSize -1), in order to avoid errors in the JarOutputStream.

6 files changed, 193 insertions, 60 deletions

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index c4b77cfdd..d431ddb9f 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -62,6 +62,12 @@
     (&/$DataT payload)
     (return payload)
 
+    (&/$VarT id)
+    (return (&/T ["java.lang.Object" (&/|list)]))
+
+    (&/$ExT id)
+    (return (&/T ["java.lang.Object" (&/|list)]))
+
     (&/$NamedT _ type*)
     (ensure-object type*)
 
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 98c734372..88fc2f4ee 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -212,7 +212,7 @@
                                              _
                                              (return exo-type))]
                              (fail (str err "\n"
-                                        'analyse-variant " " idx " " is-last? " " is-last?* " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
+                                        'analyse-variant " " idx " " is-last? " " is-last?* " " (&type/show-type _exo-type) " " (&type/show-type vtype)
                                         " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
                 _cursor &/cursor]
             (if (= 1 num-variant-types)
@@ -378,16 +378,21 @@
       (|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)]
         (|case (&&meta/meta-get &&meta/macro?-tag ?meta)
           (&/$Some _)
-          (|do [macro-expansion (fn [state] (-> ?value (.apply ?args) (.apply state)))
-                :let [[r-prefix r-name] real-name
-                      ;; _ (when (or (= "defclass" r-name)
-                      ;;             ;; (= "@type" r-name)
-                      ;;             )
-                      ;;     (->> (&/|map &/show-ast macro-expansion)
-                      ;;          (&/|interpose "\n")
-                      ;;          (&/fold str "")
-                      ;;          (prn (&/ident->text real-name))))
-                      ]
+          (|do [macro-expansion (fn [state] (try (-> ?value (.apply ?args) (.apply state))
+                                             (catch java.lang.StackOverflowError e
+                                               (|let [[r-prefix r-name] real-name]
+                                                 (do (prn 'find-def [r-prefix r-name])
+                                                   (throw e))))))
+                module-name &/get-module-name
+                ;; :let [[r-prefix r-name] real-name
+                ;;       _ (when (or (= "jvm-import" r-name)
+                ;;                   ;; (= "defclass" r-name)
+                ;;                   )
+                ;;           (->> (&/|map &/show-ast macro-expansion)
+                ;;                (&/|interpose "\n")
+                ;;                (&/fold str "")
+                ;;                (prn (&/ident->text real-name) module-name)))
+                ;;       ]
                 ]
             (&/flat-map% (partial analyse exo-type) macro-expansion))
 
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 5e46694e2..4074efae7 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -310,7 +310,7 @@
     ($Cons [k v] table*)
     (if (.equals ^Object k slot)
       v
-      (|get slot table*))))
+      (recur slot table*))))
 
 (defn |put [slot value table]
   (|case table
@@ -933,7 +933,7 @@
     (pr-str ?value)
 
     [_ ($CharS ?value)]
-    (pr-str ?value)
+    (str "#\"" (pr-str ?value) "\"")
 
     [_ ($TextS ?value)]
     (str "\"" ?value "\"")
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 05080c3ed..67dcfbd5c 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -506,6 +506,73 @@
     _
     (.visitInsn writer Opcodes/ARETURN)))
 
+(defn ^:private prepare-method-input [idx input method-visitor]
+  "(-> Int [Text GenericClass] MethodVisitor (Lux FrameTag))"
+  (|case input
+    [_ (&/$GenericClass name params)]
+    (case name
+      "boolean" (do (doto method-visitor
+                      (.visitVarInsn Opcodes/ILOAD idx)
+                      &&/wrap-boolean
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+      "byte"    (do (doto method-visitor
+                      (.visitVarInsn Opcodes/ILOAD idx)
+                      &&/wrap-byte
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+      "short"   (do (doto method-visitor
+                      (.visitVarInsn Opcodes/ILOAD idx)
+                      &&/wrap-short
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+      "int"     (do (doto method-visitor
+                      (.visitVarInsn Opcodes/ILOAD idx)
+                      &&/wrap-int
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return Opcodes/INTEGER))
+      "long"    (do (doto method-visitor
+                      (.visitVarInsn Opcodes/LLOAD idx)
+                      &&/wrap-long
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return Opcodes/LONG))
+      "float"   (do (doto method-visitor
+                      (.visitVarInsn Opcodes/FLOAD idx)
+                      &&/wrap-float
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return Opcodes/FLOAT))
+      "double"  (do (doto method-visitor
+                      (.visitVarInsn Opcodes/DLOAD idx)
+                      &&/wrap-double
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return Opcodes/DOUBLE))
+      "char"    (do (doto method-visitor
+                      (.visitVarInsn Opcodes/ILOAD idx)
+                      &&/wrap-char
+                      (.visitVarInsn Opcodes/ASTORE idx))
+                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+      ;; else
+      (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+
+    [_ gclass]
+    (return (&host-generics/gclass->class-name gclass))
+    ))
+
+(defn ^:private prepare-method-inputs [idx inputs method-visitor]
+  "(-> Int (List GenericClass) MethodVisitor (Lux (List FrameTag)))"
+  (|case inputs
+    (&/$Nil)
+    (return &/unit-tag)
+    
+    (&/$Cons input inputs*)
+    (let [!idx (atom idx)]
+      (&/map% (fn [input]
+                (|do [output (prepare-method-input @!idx input method-visitor)
+                      :let [_ (swap! !idx inc)]]
+                  (return output)))
+              inputs))
+    ))
+
 (defn ^:private compile-method-def [compile ^ClassWriter class-writer ?super-class method-def]
   (|case method-def
     (&/$ConstructorMethodAnalysis ?privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
@@ -524,12 +591,11 @@
                     init-types (->> ?ctor-args (&/|map (comp &host-generics/gclass->signature &/|first)) (&/fold str ""))
                     init-sig (str "(" init-types ")" "V")
                     _ (&/|map (partial compile-annotation =method) ?anns)
-                    _ (doto =method
-                        (.visitCode)
-                        (.visitVarInsn Opcodes/ALOAD 0))]
+                    _ (.visitCode =method)]
+              =input-tags (prepare-method-inputs 1 ?inputs =method)
+              :let [_ (.visitVarInsn =method Opcodes/ALOAD 0)]
               _ (->> ?ctor-args (&/|map &/|second) (&/map% compile))
-              :let [_ (doto =method
-                        (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name super-class-name) init-method init-sig))]
+              :let [_ (.visitMethodInsn =method Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name super-class-name) init-method init-sig)]
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
@@ -551,6 +617,7 @@
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
+              =input-tags (prepare-method-inputs 1 ?inputs =method)
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
@@ -571,6 +638,7 @@
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
+              =input-tags (prepare-method-inputs 1 ?inputs =method)
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
@@ -592,6 +660,7 @@
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
+              =input-tags (prepare-method-inputs 0 ?inputs =method)
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 90b1f2bf1..cd41b4be7 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -31,6 +31,7 @@
 
 ;; [Utils]
 (defn ^:private escape-char [escaped]
+  "(-> Text (Lux Text))"
   (cond (.equals ^Object escaped "\\t")  (return "\t")
         (.equals ^Object escaped "\\b")  (return "\b")
         (.equals ^Object escaped "\\n")  (return "\n")
@@ -42,6 +43,18 @@
         (fail (str "[Lexer Error] Unknown escape character: " escaped))))
 
 (defn ^:private escape-char* [escaped]
+  "(-> Text Text)"
+  ;; (prn 'escape-char*
+  ;;      escaped
+  ;;      (cond (.equals ^Object escaped "\\t")  "\t"
+  ;;            (.equals ^Object escaped "\\b")  "\b"
+  ;;            (.equals ^Object escaped "\\n")  "\n"
+  ;;            (.equals ^Object escaped "\\r")  "\r"
+  ;;            (.equals ^Object escaped "\\f")  "\f"
+  ;;            (.equals ^Object escaped "\\\"") "\""
+  ;;            (.equals ^Object escaped "\\\\") "\\"
+  ;;            :else
+  ;;            (assert false (str "[Lexer Error] Unknown escape character: " escaped))))
   (cond (.equals ^Object escaped "\\t")  "\t"
         (.equals ^Object escaped "\\b")  "\b"
         (.equals ^Object escaped "\\n")  "\n"
@@ -52,39 +65,78 @@
         :else
         (assert false (str "[Lexer Error] Unknown escape character: " escaped))))
 
-(defn ^:private escape-unicode [unicode]
+(defn ^:private escape-unicode [^String unicode]
+  "(-> Text Text)"
   (str (char (Integer/valueOf (.substring unicode 2) 16))))
 
-(defn ^:private clean-line [raw-line]
-  (-> raw-line
-      (string/replace #"\\u[0-9a-fA-F]{4}" escape-unicode)
-      (string/replace #"\\." escape-char*)))
+(defn ^:private clean-line [^String raw-line]
+  "(-> Text Text)"
+  (let [line-length (.length raw-line)
+        buffer (new StringBuffer line-length)]
+    (loop [idx 0]
+      (if (< idx line-length)
+        (let [current-char (.charAt raw-line idx)]
+          (if (= \\ current-char)
+            (do (assert (< (+ 1 idx) line-length) (str "[Lexer] Text is too short for escaping: " raw-line " " idx))
+              (case (.charAt raw-line (+ 1 idx))
+                \t (do (.append buffer "\t")
+                     (recur (+ 2 idx)))
+                \b (do (.append buffer "\b")
+                     (recur (+ 2 idx)))
+                \n (do (.append buffer "\n")
+                     (recur (+ 2 idx)))
+                \r (do (.append buffer "\r")
+                     (recur (+ 2 idx)))
+                \f (do (.append buffer "\f")
+                     (recur (+ 2 idx)))
+                \" (do (.append buffer "\"")
+                     (recur (+ 2 idx)))
+                \\ (do (.append buffer "\\")
+                     (recur (+ 2 idx)))
+                \u (do (assert (< (+ 5 idx) line-length) (str "[Lexer] 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] Invalid escaping syntax: " raw-line " " idx))))
+            (do (.append buffer current-char)
+              (recur (+ 1 idx)))))
+        (.toString buffer))))
+  ;; (-> raw-line
+  ;;     (string/replace #"\\u[0-9a-fA-F]{4}" escape-unicode)
+  ;;     (string/replace #"\\." escape-char*))
+  )
 
 (defn ^:private lex-text-body [offset]
-  (|do [[_ eol? ^String pre-quotes] (&reader/read-regex #"^([^\"]*)")
-        post-quotes (if (.endsWith pre-quotes "\\")
-                      (if eol?
-                        (fail "[Lexer Error] Can't leave dangling back-slash \\")
-                        (if (if-let [^String back-slashes (re-find #"\\+$" pre-quotes)]
-                              (odd? (.length back-slashes)))
-                          (|do [_ (&reader/read-regex #"^([\"])")
-                                next-part (lex-text-body offset)]
-                            (return (str "\"" next-part)))
-                          (lex-text-body offset)))
-                      (if eol?
-                        (|do [[_ _ ^String line-prefix] (&reader/read-regex #"^( +|$)")
-                              :let [empty-line? (= "" line-prefix)]
-                              _ (&/assert! (or empty-line?
-                                               (>= (.length line-prefix) offset))
-                                           "Each line of a multi-line text must have an appropriate offset!")
-                              next-part (lex-text-body offset)]
-                          (return (str "\n"
-                                       (if empty-line?
-                                         ""
-                                         (.substring line-prefix offset))
-                                       next-part)))
-                        (return "")))]
-    (return (clean-line (str pre-quotes post-quotes)))))
+  (|do [[_ eol? ^String pre-quotes*] (&reader/read-regex #"^([^\"]*)")
+        [pre-quotes post-quotes] (if (.endsWith pre-quotes* "\\")
+                                   (if eol?
+                                     (fail "[Lexer Error] Can't leave dangling back-slash \\")
+                                     (if (if-let [^String back-slashes (re-find #"\\+$" pre-quotes*)]
+                                           (odd? (.length back-slashes)))
+                                       (|do [_ (&reader/read-regex #"^([\"])")
+                                             next-part (lex-text-body offset)]
+                                         (return (&/T [(.substring pre-quotes* 0 (dec (.length pre-quotes*)))
+                                                       (str "\"" next-part)])))
+                                       (|do [post-quotes* (lex-text-body offset)]
+                                         (return (&/T [pre-quotes* post-quotes*])))))
+                                   (if eol?
+                                     (|do [[_ _ ^String line-prefix] (&reader/read-regex #"^( +|$)")
+                                           :let [empty-line? (= "" line-prefix)]
+                                           _ (&/assert! (or empty-line?
+                                                            (>= (.length line-prefix) offset))
+                                                        "Each line of a multi-line text must have an appropriate offset!")
+                                           next-part (lex-text-body offset)]
+                                       (return (&/T [pre-quotes*
+                                                     (str "\n"
+                                                          (if empty-line?
+                                                            ""
+                                                            (.substring line-prefix offset))
+                                                          next-part)])))
+                                     (return (&/T [pre-quotes* ""]))))
+        :let [cleaned (str (clean-line pre-quotes) post-quotes)
+              ;; _ (println 'cleaned cleaned)
+              ]]
+    (return cleaned)))
 
 (def ^:private lex-text
   (|do [[meta _ _] (&reader/read-text "\"")
diff --git a/src/lux/packager/program.clj b/src/lux/packager/program.clj
index f01212b70..61baecce3 100644
--- a/src/lux/packager/program.clj
+++ b/src/lux/packager/program.clj
@@ -103,12 +103,10 @@
         (let [entry-name (.getName entry)]
           (if (and (not (.isDirectory entry))
                    (not (.startsWith entry-name "META-INF/maven/"))
-                   ;; (.endsWith entry-name ".class")
                    (not (contains? seen entry-name)))
-            (let [;; _ (prn 'entry entry-name)
-                  entry-data (read-stream is)]
+            (let [entry-data (read-stream is)]
               (doto out
-                (.putNextEntry entry)
+                (.putNextEntry (doto entry (.setCompressedSize -1)))
                 (.write entry-data 0 (alength entry-data))
                 (.flush)
                 (.closeEntry))
@@ -123,13 +121,16 @@
 (defn package [module]
   "(-> Text Null)"
   (with-open [out (new JarOutputStream (->> &&/output-package (new File) (new FileOutputStream)) (manifest module))]
-    (doseq [$group (.listFiles (new File &&/output-dir))]
-      (write-module! $group out))
-    (write-resources! out)
-    (->> (fetch-available-jars)
-         (filter #(and (not (.endsWith ^String % "luxc.jar"))
-                       (not (.endsWith ^String % "tools.nrepl-0.2.3.jar"))
-                       (not (.endsWith ^String % "clojure-complete-0.2.3.jar"))))
-         (reduce (fn [s ^String j] (add-jar! (new File ^String j) s out))
-                 #{"META-INF/MANIFEST.MF"}))
+    (do (doseq [$group (.listFiles (new File &&/output-dir))]
+          (write-module! $group out))
+      (write-resources! out)
+      (->> (fetch-available-jars)
+           (filter #(and (not (.endsWith ^String % "luxc.jar"))
+                         (not (.endsWith ^String % "tools.nrepl-0.2.3.jar"))
+                         (not (.endsWith ^String % "clojure-complete-0.2.3.jar"))
+                         (not (.endsWith ^String % "clojure-1.6.0.jar"))
+                         (not (.endsWith ^String % "core.match-0.2.1.jar"))))
+           (reduce (fn [s ^String j] (add-jar! (new File ^String j) s out))
+                   #{"META-INF/MANIFEST.MF"}))
+      nil)
     ))