- Added a few more modules.

- Added some type-tags to avoid reflection inside the compiler.

14 files changed, 170 insertions, 101 deletions

diff --git a/input/lux/data/bool.lux b/input/lux/data/bool.lux
new file mode 100644
index 000000000..d4f223612
--- /dev/null
+++ b/input/lux/data/bool.lux
@@ -0,0 +1,33 @@
+##   Copyright (c) Eduardo Julian. All rights reserved.
+##   The use and distribution terms for this software are covered by the
+##   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+##   which can be found in the file epl-v10.html at the root of this distribution.
+##   By using this software in any fashion, you are agreeing to be bound by
+##   the terms of this license.
+##   You must not remove this notice, or any other, from this software.
+
+(;import lux
+         (lux/control (monoid #as m))
+         (.. (eq #as E)
+             (show #as S)))
+
+## [Structures]
+(defstruct #export Bool/Eq (E;Eq Bool)
+  (def (E;= x y)
+    (if x
+      y
+      (not y))))
+
+(defstruct #export Bool/Show (S;Show Bool)
+  (def (S;show x)
+    (if x "true" "false")))
+
+(do-template [<name> <unit> <op>]
+  [(defstruct #export <name> (m;Monoid Bool)
+     (def m;unit <unit>)
+     (def (m;++ x y)
+       (<op> x y)))]
+
+  [ Or/Monoid false or]
+  [And/Monoid true and]
+  )
diff --git a/input/lux/data/bounded.lux b/input/lux/data/bounded.lux
index 458fbc0df..9d2dabde1 100644
--- a/input/lux/data/bounded.lux
+++ b/input/lux/data/bounded.lux
@@ -15,12 +15,3 @@
 
   (: a
      bottom))
-
-## Structure
-(do-template [<name> <type> <top> <bottom>]
-  [(defstruct #export <name> (Bounded <type>)
-     (def top <top>)
-     (def bottom <bottom>))]
-
-  [ Int/Bounded  Int (_jvm_getstatic java.lang.Long   MAX_VALUE) (_jvm_getstatic java.lang.Long   MIN_VALUE)]
-  [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)])
diff --git a/input/lux/data/char.lux b/input/lux/data/char.lux
new file mode 100644
index 000000000..42e57509e
--- /dev/null
+++ b/input/lux/data/char.lux
@@ -0,0 +1,20 @@
+##   Copyright (c) Eduardo Julian. All rights reserved.
+##   The use and distribution terms for this software are covered by the
+##   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+##   which can be found in the file epl-v10.html at the root of this distribution.
+##   By using this software in any fashion, you are agreeing to be bound by
+##   the terms of this license.
+##   You must not remove this notice, or any other, from this software.
+
+(;import lux
+         (.. (eq #as E)
+             (show #as S)))
+
+## [Structures]
+(defstruct #export Char/Eq (E;Eq Char)
+  (def (E;= x y)
+    (_jvm_ceq x y)))
+
+(defstruct #export Char/Show (S;Show Char)
+  (def (S;show x)
+    ($ text:++ "#\"" (_jvm_invokevirtual java.lang.Object toString [] x []) "\"")))
diff --git a/input/lux/data/eq.lux b/input/lux/data/eq.lux
index 191e6a885..be3400208 100644
--- a/input/lux/data/eq.lux
+++ b/input/lux/data/eq.lux
@@ -8,17 +8,7 @@
 
 (;import lux)
 
-## Signatures
+## [Signatures]
 (defsig #export (Eq a)
   (: (-> a a Bool)
      =))
-
-## Structures
-(defstruct #export Bool/Eq (Eq Bool)
-  (def (= x y)
-    (case (: (, Bool Bool) [x y])
-      (\or [true true] [false false])
-      true
-
-      _
-      false)))
diff --git a/input/lux/data/number.lux b/input/lux/data/number.lux
index e1c10d6b0..8da674d88 100644
--- a/input/lux/data/number.lux
+++ b/input/lux/data/number.lux
@@ -10,7 +10,8 @@
          (lux/control (monoid #as m))
          (lux/data (eq #as E)
                    (ord #as O)
-                   (bounded #as B)))
+                   (bounded #as B)
+                   (show #as S)))
 
 ## Signatures
 (defsig #export (Number n)
@@ -61,11 +62,35 @@
   (def E;= r=))
 
 ## Ord
-(def #export Int/Ord (O;Ord Int)
-  (O;ord$ Int/Eq   i<  i>))
+## (def #export Int/Ord (O;Ord Int)
+##   (O;ord$ Int/Eq  i< i>))
 
-(def #export Real/Ord (O;Ord Real)
-  (O;ord$ Real/Eq r< r>))
+## (def #export Real/Ord (O;Ord Real)
+##   (O;ord$ Real/Eq r< r>))
+
+(do-template [<name> <type> <eq> <lt> <gt>]
+  [(defstruct #export <name> (O;Ord <type>)
+     (def O;_eq <eq>)
+     (def O;< <lt>)
+     (def (O;<= x y)
+       (or (<lt> x y)
+           (using <eq> (E;= x y))))
+     (def O;> <gt>)
+     (def (O;>= x y)
+       (or (<gt> x y)
+           (using <eq> (E;= x y)))))]
+
+  [ Int/Ord  Int  Int/Eq i< i>]
+  [Real/Ord Real Real/Eq r< r>])
+
+## Bounded
+(do-template [<name> <type> <top> <bottom>]
+  [(defstruct #export <name> (B;Bounded <type>)
+     (def B;top <top>)
+     (def B;bottom <bottom>))]
+
+  [ Int/Bounded  Int (_jvm_getstatic java.lang.Long   MAX_VALUE) (_jvm_getstatic java.lang.Long   MIN_VALUE)]
+  [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)])
 
 ## Monoid
 (do-template [<name> <type> <unit> <++>]
@@ -77,8 +102,18 @@
   [ IntMul/Monoid  Int 1   i*]
   [RealAdd/Monoid Real 0.0 r+]
   [RealMul/Monoid Real 1.0 r*]
-  [ IntMax/Monoid  Int (::  B;Int/Bounded B;bottom)  (O;max  Int/Ord)]
-  [ IntMin/Monoid  Int (::  B;Int/Bounded B;top)     (O;min  Int/Ord)]
-  [RealMax/Monoid Real (:: B;Real/Bounded B;bottom)  (O;max Real/Ord)]
-  [RealMin/Monoid Real (:: B;Real/Bounded B;top)     (O;min Real/Ord)]
+  [ IntMax/Monoid  Int (::  Int/Bounded B;bottom)  (O;max  Int/Ord)]
+  [ IntMin/Monoid  Int (::  Int/Bounded B;top)     (O;min  Int/Ord)]
+  [RealMax/Monoid Real (:: Real/Bounded B;bottom)  (O;max Real/Ord)]
+  [RealMin/Monoid Real (:: Real/Bounded B;top)     (O;min Real/Ord)]
+  )
+
+## Show
+(do-template [<name> <type> <body>]
+  [(defstruct #export <name> (S;Show <type>)
+     (def (S;show x)
+       <body>))]
+
+  [ Int/Show  Int (_jvm_invokevirtual java.lang.Object toString [] x [])]
+  [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])]
   )
diff --git a/input/lux/data/ord.lux b/input/lux/data/ord.lux
index 60a6cc0a8..80f2e4fb5 100644
--- a/input/lux/data/ord.lux
+++ b/input/lux/data/ord.lux
@@ -9,20 +9,16 @@
 (;import lux
          (../eq #as E))
 
-## Signatures
+## [Signatures]
 (defsig #export (Ord a)
   (: (E;Eq a)
      _eq)
-  (: (-> a a Bool)
-     <)
-  (: (-> a a Bool)
-     <=)
-  (: (-> a a Bool)
-     >)
-  (: (-> a a Bool)
-     >=))
+  (do-template [<name>]
+    [(: (-> a a Bool) <name>)]
 
-## Constructors
+    [<] [<=] [>] [>=]))
+
+## [Constructors]
 (def #export (ord$ eq < >)
   (All [a]
     (-> (E;Eq a) (-> a a Bool) (-> a a Bool) (Ord a)))
@@ -37,13 +33,12 @@
       (or (> x y)
           (:: eq (E;= x y))))))
 
-## Functions
+## [Functions]
 (do-template [<name> <op>]
   [(def #export (<name> ord x y)
      (All [a]
        (-> (Ord a) a a a))
-     (using ord
-       (if (<op> x y) x y)))]
+     (if (:: ord (<op> x y)) x y))]
 
   [max ;;>]
   [min ;;<])
diff --git a/input/lux/data/show.lux b/input/lux/data/show.lux
index e081b9239..f4e1cf762 100644
--- a/input/lux/data/show.lux
+++ b/input/lux/data/show.lux
@@ -12,16 +12,3 @@
 (defsig #export (Show a)
   (: (-> a Text)
      show))
-
-## Structures
-(do-template [<name> <type> <body>]
-  [(defstruct #export <name> (Show <type>)
-     (def (show x)
-       <body>))]
-
-  [Bool/Show Bool (_jvm_invokevirtual java.lang.Object toString [] x [])]
-  [ Int/Show  Int (_jvm_invokevirtual java.lang.Object toString [] x [])]
-  [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])]
-  [Char/Show Char (let [char (_jvm_invokevirtual java.lang.Object toString [] x [])]
-                    ($ text:++ "#\"" char "\""))]
-  [Text/Show Text x])
diff --git a/input/lux/data/text.lux b/input/lux/data/text.lux
index 5f2203376..a3192a1d5 100644
--- a/input/lux/data/text.lux
+++ b/input/lux/data/text.lux
@@ -7,8 +7,10 @@
 ##   You must not remove this notice, or any other, from this software.
 
 (;import lux
+         (lux/control (monoid #as m))
          (lux/data (eq #as E)
-                   (ord #as O)))
+                   (ord #as O)
+                   (show #as S)))
 
 ## [Functions]
 (def #export (size x)
@@ -24,11 +26,6 @@
                                 x [(_jvm_l2i idx)]))
     #;None))
 
-(def #export (++ x y)
-  (-> Text Text Text)
-  (_jvm_invokevirtual java.lang.String concat [java.lang.String]
-                      x [y]))
-
 (def #export (contains? x y)
   (-> Text Text Bool)
   (_jvm_invokevirtual java.lang.String contains [java.lang.CharSequence]
@@ -137,3 +134,13 @@
     (i>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
                                        x [y]))
          0)))
+
+(defstruct #export Text/Show (S;Show Text)
+  (def (S;show x)
+    x))
+
+(defstruct #export Text/Monoid (m;Monoid Text)
+  (def m;unit "")
+  (def (m;++ x y)
+    (_jvm_invokevirtual java.lang.String concat [java.lang.String]
+                        x [y])))
diff --git a/input/lux/host/java.lux b/input/lux/host/java.lux
index 52391201d..12525d3f2 100644
--- a/input/lux/host/java.lux
+++ b/input/lux/host/java.lux
@@ -7,10 +7,11 @@
 ##   You must not remove this notice, or any other, from this software.
 
 (;import lux
-         (lux (data list
-                    (text #as text))
-              (control (functor #as F)
+         (lux (control (monoid #as m)
+                       (functor #as F)
                        (monad #as M #refer (#only do)))
+              (data list
+                    (text #as text))
               (meta lux
                     macro
                     syntax)))
@@ -124,8 +125,8 @@
 (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
   (do Lux/Monad
     [current-module get-module-name
-     #let [full-name (text;++ (text;replace "/" "." current-module)
-                              name)]]
+     #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module)
+                                                name))]]
     (let [members' (:: List/Functor (F;map (: (-> (, (List Text) Text (List Text) Text) Syntax)
                                               (lambda [member]
                                                 (let [[modifiers name inputs output] member]
@@ -139,8 +140,8 @@
                      [methods (*^ method-def^)])
   (do Lux/Monad
     [current-module get-module-name
-     #let [full-name (text;++ (text;replace "/" "." current-module)
-                              name)
+     #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module)
+                                                name))
            fields' (:: List/Functor (F;map (: (-> (, (List Text) Text Text) Syntax)
                                               (lambda [field]
                                                 (let [[modifiers name class] field]
diff --git a/input/lux/meta/lux.lux b/input/lux/meta/lux.lux
index 1fc739403..db3c700e6 100644
--- a/input/lux/meta/lux.lux
+++ b/input/lux/meta/lux.lux
@@ -13,7 +13,8 @@
                       (monad #as M #refer (#only do)))
          (lux/data list
                    maybe
-                   (show #as S)))
+                   (show #as S)
+                   (number #as N)))
 
 ## [Types]
 ## (deftype (Lux a)
@@ -146,7 +147,7 @@
 (def #export (gensym prefix state)
   (-> Text (Lux Syntax))
   (#;Right [(update@ #;seed inc state)
-            (symbol$ ["__gensym__" (:: S;Int/Show (S;show (get@ #;seed state)))])]))
+            (symbol$ ["__gensym__" (:: N;Int/Show (S;show (get@ #;seed state)))])]))
 
 (def #export (emit datum)
   (All [a]
diff --git a/input/lux/meta/syntax.lux b/input/lux/meta/syntax.lux
index 3c9a9ce2e..1fe85c32f 100644
--- a/input/lux/meta/syntax.lux
+++ b/input/lux/meta/syntax.lux
@@ -11,7 +11,11 @@
              (lux #as l #refer (#only Lux/Monad gensym)))
          (lux (control (functor #as F)
                        (monad #as M #refer (#only do)))
-              (data list)))
+              (data (eq #as E)
+                    (bool #as b)
+                    (char #as c)
+                    (text #as t)
+                    list)))
 
 ## [Utils]
 (def (first xy)
@@ -95,12 +99,6 @@
   [   local-tag^ #;TagS]
   )
 
-(def (bool:= x y)
-  (-> Bool Bool Bool)
-  (if x
-    y
-    (not y)))
-
 (def (ident:= x y)
   (-> Ident Ident Bool)
   (let [[x1 x2] x
@@ -120,11 +118,11 @@
        _
        #;None))]
 
-  [  bool?^ Bool    #;BoolS  bool:=]
+  [  bool?^ Bool    #;BoolS  (:: b;Bool/Eq E;=)]
   [   int?^ Int      #;IntS  i=]
   [  real?^ Real    #;RealS  r=]
-  ## [  char?^ Char    #;CharS  char:=]
-  [  text?^ Text    #;TextS  text:=]
+  [  char?^ Char    #;CharS  (:: c;Char/Eq E;=)]
+  [  text?^ Text    #;TextS  (:: t;Text/Eq E;=)]
   [symbol?^ Ident #;SymbolS ident:=]
   [   tag?^ Ident    #;TagS ident:=]
   )
diff --git a/input/program.lux b/input/program.lux
index 1bdb237b1..984d8610f 100644
--- a/input/program.lux
+++ b/input/program.lux
@@ -13,7 +13,9 @@
                        monad
                        lazy
                        comonad)
-              (data bounded
+              (data bool
+                    bounded
+                    char
                     ## cont
                     dict
                     (either #as e)
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index c13be61c4..9b68fb680 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -7,6 +7,7 @@
 ;;   You must not remove this notice, or any other, from this software.
 
 (ns lux.analyser.module
+  (:refer-clojure :exclude [alias])
   (:require [clojure.string :as string]
             [clojure.core.match :as M :refer [matchv]]
             clojure.core.match.array
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 25451aae0..68c3b7d6c 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -18,31 +18,35 @@
   (:import (org.objectweb.asm Opcodes
                               Label
                               ClassWriter
-                              MethodVisitor)))
+                              MethodVisitor)
+           (java.io File
+                    BufferedOutputStream
+                    FileOutputStream)
+           (java.lang.reflect Field)))
 
 ;; [Utils]
 (defn ^:private write-file [^String file ^bytes data]
-  (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
+  (with-open [stream (BufferedOutputStream. (FileOutputStream. file))]
     (.write stream data)))
 
 (defn ^:private write-output [module name data]
   (let [module* module]
-    (.mkdirs (java.io.File. (str "output/jvm/" module*)))
+    (.mkdirs (File. (str "output/jvm/" module*)))
     (write-file (str "output/jvm/" module* "/" name ".class") data)))
 
 (defn ^:private write-cache [module name data]
   (let [module* (string/replace module #"/" " ")]
-    (.mkdirs (java.io.File. (str "cache/jvm/" module*)))
+    (.mkdirs (File. (str "cache/jvm/" module*)))
     (write-file (str "cache/jvm/" module* "/" name ".class") data)))
 
-(defn ^:private clean-file [^java.io.File file]
+(defn ^:private clean-file [^File file]
   (if (.isDirectory file)
     (do (doseq [f (seq (.listFiles file))]
           (clean-file f))
       (.delete file))
     (.delete file)))
 
-(defn ^:private read-file [file]
+(defn ^:private read-file [^File file]
   (with-open [reader (io/input-stream file)]
     (let [length (.length file)
           buffer (byte-array length)]
@@ -74,11 +78,11 @@
     (return nil)))
 
 (defn cached? [module]
-  (.exists (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class"))))
+  (.exists (File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class"))))
 
 (defn delete-cache [module]
   (fn [state]
-    (do (clean-file (java.io.File. (str "cache/jvm/" (string/replace module #"/" " "))))
+    (do (clean-file (File. (str "cache/jvm/" (string/replace module #"/" " "))))
       (return* state nil))))
 
 (defn ^:private replace-several [content & replacements]
@@ -90,7 +94,7 @@
                  (throw e)))
             content replacement-list)))
 
-(defn ^:private replace-cache [cache-name]
+(defn ^:private replace-cache [^String cache-name]
   (if (.startsWith cache-name "$")
     (replace-several cache-name
                      #"_ASTER_" "*"
@@ -118,16 +122,19 @@
                      #"_PIPE_" "|")
     cache-name))
 
+(defn ^:private get-field [^String field-name ^Class class]
+  (-> class ^Field (.getField field-name) (.get nil)))
+
 (defn load-cache [module module-hash compile-module]
   (|do [loader &/loader
         !classes &/classes]
     (let [module-path (str "cache/jvm/" (string/replace module #"/" " "))
           module* (string/replace module #"/" ".")
           class-name (str module* "._")
-          module-meta (do (swap! !classes assoc class-name (read-file (java.io.File. (str module-path "/_.class"))))
-                        (load-class! loader class-name))]
-      (if (and (= module-hash (-> module-meta (.getField "_hash") (.get nil)))
-               (= version (-> module-meta (.getField "_compiler") (.get nil))))
+          ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class"))))
+                               (load-class! loader class-name))]
+      (if (and (= module-hash (get-field "_hash" module-meta))
+               (= version (get-field "_compiler" module-meta)))
         (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t")
               ;; _ (prn module 'imports imports)
               ]
@@ -137,9 +144,10 @@
                                 (&/|list)
                                 (&/->list imports)))]
             (if (->> loads &/->seq (every? true?))
-              (do (doseq [file (seq (.listFiles (java.io.File. module-path)))
-                          :when (not= "_.class" (.getName file))]
-                    (let [real-name (second (re-find #"^(.*)\.class$" (.getName file)))
+              (do (doseq [^File file (seq (.listFiles (File. module-path)))
+                          :let [file-name (.getName file)]
+                          :when (not= "_.class" file-name)]
+                    (let [real-name (second (re-find #"^(.*)\.class$" file-name))
                           bytecode (read-file file)
                           ;; _ (prn 'load-cache module real-name)
                           ]
@@ -149,18 +157,18 @@
                       ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode)
                       (write-output module real-name bytecode)))
                 ;; (swap! !classes dissoc "__temp__")
-                (let [defs (string/split (-> module-meta (.getField "_defs") (.get nil)) #"\t")]
+                (let [defs (string/split (get-field "_defs" module-meta) #"\t")]
                   (|do [_ (fn [state]
                             (&/run-state (&/map% (fn [_def]
                                                    (let [[_exported? _name _ann] (string/split _def #" ")
                                                          ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann])
                                                          def-class (load-class! loader (str module* ".$" (&/normalize-ident _name)))
-                                                         def-name (-> def-class (.getField "_name") (.get nil))]
+                                                         def-name (get-field "_name" def-class)]
                                                      (|do [_ (case _ann
                                                                "T" (&a-module/define module def-name (&/V "lux;TypeD" nil) &type/Type)
                                                                "M" (|do [_ (&a-module/define module def-name (&/V "lux;ValueD" &type/Macro) &type/Macro)]
                                                                      (&a-module/declare-macro module def-name))
-                                                               "V" (let [def-type (-> def-class (.getField "_meta") (.get nil))]
+                                                               "V" (let [def-type (get-field "_meta" def-class)]
                                                                      (matchv ::M/objects [def-type]
                                                                        [["lux;ValueD" _def-type]]
                                                                        (&a-module/define module def-name def-type _def-type)))
@@ -168,7 +176,7 @@
                                                                (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)]
                                                                  (|do [__type (&a-module/def-type __module __name)]
                                                                    (do ;; (prn '__type [__module __name] (&type/show-type __type))
-                                                                     (&a-module/def-alias module def-name __module __name __type)))))]
+                                                                       (&a-module/def-alias module def-name __module __name __type)))))]
                                                        (if (= "1" _exported?)
                                                          (&a-module/export module def-name)
                                                          (return nil)))