From 3a760fa6c0f47f7621970b9747779f3edcc96286 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 19 Jul 2015 23:43:37 -0400
Subject: - Added a few more modules. - Added some type-tags to avoid
 reflection inside the compiler.

---
 input/lux/data/bool.lux    | 33 +++++++++++++++++++++++++++++
 input/lux/data/bounded.lux |  9 --------
 input/lux/data/char.lux    | 20 +++++++++++++++++
 input/lux/data/eq.lux      | 12 +----------
 input/lux/data/number.lux  | 53 ++++++++++++++++++++++++++++++++++++++--------
 input/lux/data/ord.lux     | 21 +++++++-----------
 input/lux/data/show.lux    | 13 ------------
 input/lux/data/text.lux    | 19 +++++++++++------
 input/lux/host/java.lux    | 15 +++++++------
 input/lux/meta/lux.lux     |  5 +++--
 input/lux/meta/syntax.lux  | 18 +++++++---------
 input/program.lux          |  4 +++-
 12 files changed, 141 insertions(+), 81 deletions(-)
 create mode 100644 input/lux/data/bool.lux
 create mode 100644 input/lux/data/char.lux

(limited to 'input')

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)
-- 
cgit v1.2.3