aboutsummaryrefslogtreecommitdiff
path: root/input
diff options
context:
space:
mode:
Diffstat (limited to 'input')
-rw-r--r--input/lux/data/bool.lux33
-rw-r--r--input/lux/data/bounded.lux9
-rw-r--r--input/lux/data/char.lux20
-rw-r--r--input/lux/data/eq.lux12
-rw-r--r--input/lux/data/number.lux53
-rw-r--r--input/lux/data/ord.lux21
-rw-r--r--input/lux/data/show.lux13
-rw-r--r--input/lux/data/text.lux19
-rw-r--r--input/lux/host/java.lux15
-rw-r--r--input/lux/meta/lux.lux5
-rw-r--r--input/lux/meta/syntax.lux18
-rw-r--r--input/program.lux4
12 files changed, 141 insertions, 81 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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 06:34:52 +0000