aboutsummaryrefslogtreecommitdiff
path: root/source/lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux')
-rw-r--r--source/lux/codata/function.lux26
-rw-r--r--source/lux/codata/lazy.lux (renamed from source/lux/control/lazy.lux)9
-rw-r--r--source/lux/codata/reader.lux (renamed from source/lux/data/reader.lux)0
-rw-r--r--source/lux/codata/state.lux (renamed from source/lux/data/state.lux)0
-rw-r--r--source/lux/codata/stream.lux11
-rw-r--r--source/lux/control/bounded.lux (renamed from source/lux/data/bounded.lux)0
-rw-r--r--source/lux/control/dict.lux21
-rw-r--r--source/lux/control/eq.lux (renamed from source/lux/data/eq.lux)0
-rw-r--r--source/lux/control/number.lux28
-rw-r--r--source/lux/control/ord.lux (renamed from source/lux/data/ord.lux)0
-rw-r--r--source/lux/control/show.lux (renamed from source/lux/data/show.lux)0
-rw-r--r--source/lux/data/bool.lux6
-rw-r--r--source/lux/data/char.lux6
-rw-r--r--source/lux/data/cont.lux41
-rw-r--r--source/lux/data/dict.lux83
-rw-r--r--source/lux/data/id.lux12
-rw-r--r--source/lux/data/list.lux99
-rw-r--r--source/lux/data/maybe.lux20
-rw-r--r--source/lux/data/number/int.lux89
-rw-r--r--source/lux/data/number/real.lux (renamed from source/lux/data/number.lux)78
-rw-r--r--source/lux/data/text.lux9
-rw-r--r--source/lux/data/tuple.lux39
-rw-r--r--source/lux/host/jvm.lux16
-rw-r--r--source/lux/meta/lux.lux42
-rw-r--r--source/lux/meta/syntax.lux10
25 files changed, 452 insertions, 193 deletions
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux
new file mode 100644
index 000000000..3c40df188
--- /dev/null
+++ b/source/lux/codata/function.lux
@@ -0,0 +1,26 @@
+## 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)))
+
+## [Functions]
+(def #export (flip f)
+ (All [a b c]
+ (-> (-> a b c) (-> b a c)))
+ (lambda [y x] (f x y)))
+
+(def #export (. f g)
+ (All [a b c]
+ (-> (-> b c) (-> a b) (-> a c)))
+ (lambda [x] (f (g x))))
+
+## [Structures]
+(defstruct #export Comp/Monoid (All [a] (m;Monoid (-> a a)))
+ (def m;unit id)
+ (def m;++ .))
diff --git a/source/lux/control/lazy.lux b/source/lux/codata/lazy.lux
index 22dac74fe..94968de20 100644
--- a/source/lux/control/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -7,10 +7,11 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/meta macro)
- (.. (functor #as F #refer #all)
- (monad #as M #refer #all))
- (lux/data list))
+ (lux (meta macro)
+ (control (functor #as F #refer #all)
+ (monad #as M #refer #all))
+ (data list))
+ (.. function))
## Types
(deftype #export (Lazy a)
diff --git a/source/lux/data/reader.lux b/source/lux/codata/reader.lux
index e91687c3a..e91687c3a 100644
--- a/source/lux/data/reader.lux
+++ b/source/lux/codata/reader.lux
diff --git a/source/lux/data/state.lux b/source/lux/codata/state.lux
index bc9858a29..bc9858a29 100644
--- a/source/lux/data/state.lux
+++ b/source/lux/codata/state.lux
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 1d6dd1b50..2c854a61c 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -7,14 +7,15 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (control (lazy #as L #refer #all)
- (functor #as F #refer #all)
+ (lux (control (functor #as F #refer #all)
(monad #as M #refer #all)
(comonad #as CM #refer #all))
(meta lux
macro
syntax)
- (data (list #as l #refer (#only list list& List/Monad)))))
+ (data (list #as l #refer (#only list list& List/Monad))
+ (number (int #open ("i" Int/Number Int/Ord))))
+ (codata (lazy #as L #refer #all))))
## [Types]
(deftype #export (Stream a)
@@ -59,7 +60,7 @@
(All [a] (-> Int (Stream a) a))
(let [[h t] (! s)]
(if (i> idx 0)
- (@ (dec idx) t)
+ (@ (i+ -1 idx) t)
h)))
(do-template [<taker> <dropper> <splitter> <det-type> <det-test> <det-step>]
@@ -89,7 +90,7 @@
[(list) xs])))]
[take-while drop-while split-with (-> a Bool) (det x) det]
- [take drop split Int (i> det 0) (dec det)]
+ [take drop split Int (i> det 0) (i+ -1 det)]
)
(def #export (unfold step init)
diff --git a/source/lux/data/bounded.lux b/source/lux/control/bounded.lux
index 9d2dabde1..9d2dabde1 100644
--- a/source/lux/data/bounded.lux
+++ b/source/lux/control/bounded.lux
diff --git a/source/lux/control/dict.lux b/source/lux/control/dict.lux
new file mode 100644
index 000000000..3089ec927
--- /dev/null
+++ b/source/lux/control/dict.lux
@@ -0,0 +1,21 @@
+## 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)
+
+## Signatures
+(defsig #export (Dict d)
+ (: (All [k v]
+ (-> k (d k v) (Maybe v)))
+ get)
+ (: (All [k v]
+ (-> k v (d k v) (d k v)))
+ put)
+ (: (All [k v]
+ (-> k (d k v) (d k v)))
+ remove))
diff --git a/source/lux/data/eq.lux b/source/lux/control/eq.lux
index be3400208..be3400208 100644
--- a/source/lux/data/eq.lux
+++ b/source/lux/control/eq.lux
diff --git a/source/lux/control/number.lux b/source/lux/control/number.lux
new file mode 100644
index 000000000..40906a8a8
--- /dev/null
+++ b/source/lux/control/number.lux
@@ -0,0 +1,28 @@
+## 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)
+ (ord #as O)
+ (bounded #as B)
+ (show #as S)))
+
+## [Signatures]
+(defsig #export (Number n)
+ (do-template [<name>]
+ [(: (-> n n n) <name>)]
+ [+] [-] [*] [/] [%])
+
+ (do-template [<name>]
+ [(: (-> n n) <name>)]
+ [negate] [signum] [abs])
+
+ (: (-> Int n)
+ from-int)
+ )
diff --git a/source/lux/data/ord.lux b/source/lux/control/ord.lux
index 80f2e4fb5..80f2e4fb5 100644
--- a/source/lux/data/ord.lux
+++ b/source/lux/control/ord.lux
diff --git a/source/lux/data/show.lux b/source/lux/control/show.lux
index f4e1cf762..f4e1cf762 100644
--- a/source/lux/data/show.lux
+++ b/source/lux/control/show.lux
diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux
index d4f223612..5f4427a2c 100644
--- a/source/lux/data/bool.lux
+++ b/source/lux/data/bool.lux
@@ -7,9 +7,9 @@
## 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)))
+ (lux/control (monoid #as m)
+ (eq #as E)
+ (show #as S)))
## [Structures]
(defstruct #export Bool/Eq (E;Eq Bool)
diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux
index 5a811c006..b97ec644d 100644
--- a/source/lux/data/char.lux
+++ b/source/lux/data/char.lux
@@ -7,9 +7,9 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (.. (eq #as E)
- (show #as S)
- (text #as T #open ("text:" Text/Monoid))))
+ (lux/control (eq #as E)
+ (show #as S))
+ (.. (text #as T #open ("text:" Text/Monoid))))
## [Structures]
(defstruct #export Char/Eq (E;Eq Char)
diff --git a/source/lux/data/cont.lux b/source/lux/data/cont.lux
new file mode 100644
index 000000000..51c6ece87
--- /dev/null
+++ b/source/lux/data/cont.lux
@@ -0,0 +1,41 @@
+## 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 (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Cont r a)
+ (-> (-> a r) r))
+
+## [Structures]
+(defstruct #export Cont/Functor (All [r]
+ (Functor (Cont r)))
+ (def (F;map f fa)
+ (lambda [k]
+ (k (fa f)))))
+
+(defstruct #export Cont/Monad (All [r]
+ (Monad (Cont r)))
+ (def M;_functor Cont/Functor)
+
+ (def (M;wrap x)
+ (lambda [k]
+ (k x)))
+
+ (def (M;join mma)
+ (lambda [k]
+ (mma (lambda [ma] (ma k))))))
+
+## [Functions]
+(def #export (call/cc body)
+ (All [r a b]
+ (-> (-> (-> a (Cont r b)) (Cont r a)) (Cont r a)))
+ (lambda [k]
+ (body k)))
diff --git a/source/lux/data/dict.lux b/source/lux/data/dict.lux
deleted file mode 100644
index 63a66d49b..000000000
--- a/source/lux/data/dict.lux
+++ /dev/null
@@ -1,83 +0,0 @@
-## 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/data (eq #as E)))
-
-## Signatures
-(defsig #export (Dict d)
- (: (All [k v]
- (-> k (d k v) (Maybe v)))
- get)
- (: (All [k v]
- (-> k v (d k v) (d k v)))
- put)
- (: (All [k v]
- (-> k (d k v) (d k v)))
- remove))
-
-## Types
-(deftype #export (PList k v)
- (| (#PList (, (E;Eq k) (List (, k v))))))
-
-## Constructors
-(def #export (plist eq)
- (All [k v]
- (-> (E;Eq k) (PList k v)))
- (#PList [eq #;Nil]))
-
-## Utils
-(def (pl-get eq k kvs)
- (All [k v]
- (-> (E;Eq k) k (List (, k v)) (Maybe v)))
- (case kvs
- #;Nil
- #;None
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- (#;Some v')
- (pl-get eq k kvs'))))
-
-(def (pl-put eq k v kvs)
- (All [k v]
- (-> (E;Eq k) k v (List (, k v)) (List (, k v))))
- (case kvs
- #;Nil
- (#;Cons [[k v] kvs])
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- (#;Cons [[k v] kvs'])
- (#;Cons [[k' v'] (pl-put eq k v kvs')]))))
-
-(def (pl-remove eq k kvs)
- (All [k v]
- (-> (E;Eq k) k (List (, k v)) (List (, k v))))
- (case kvs
- #;Nil
- kvs
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- kvs'
- (#;Cons [[k' v'] (pl-remove eq k kvs')]))))
-
-## Structs
-(defstruct #export PList/Dict (Dict PList)
- (def (get k plist)
- (let [(#PList [eq kvs]) plist]
- (pl-get eq k kvs)))
-
- (def (put k v plist)
- (let [(#PList [eq kvs]) plist]
- (#PList [eq (pl-put eq k v kvs)])))
-
- (def (remove k plist)
- (let [(#PList [eq kvs]) plist]
- (#PList [eq (pl-remove eq k kvs)]))))
diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux
index 0e3bdbee6..3ad6b056b 100644
--- a/source/lux/data/id.lux
+++ b/source/lux/data/id.lux
@@ -8,7 +8,8 @@
(;import lux
(lux/control (functor #as F #refer #all)
- (monad #as M #refer #all)))
+ (monad #as M #refer #all)
+ (comonad #as CM #refer #all)))
## [Types]
(deftype #export (Id a)
@@ -23,6 +24,9 @@
(defstruct #export Id/Monad (Monad Id)
(def M;_functor Id/Functor)
(def (M;wrap a) (#Id a))
- (def (M;join mma)
- (let [(#Id ma) mma]
- ma)))
+ (def (M;join mma) (let [(#Id ma) mma] ma)))
+
+(defstruct #export Id/CoMonad (CoMonad Id)
+ (def CM;_functor Id/Functor)
+ (def (CM;unwrap wa) (let [(#Id a) wa] a))
+ (def (CM;split wa) (#Id wa)))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 8fd5c2951..8d6296b14 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -7,17 +7,66 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m #refer #all)
- (functor #as F #refer #all)
- (monad #as M #refer #all))
- lux/meta/macro)
+ (lux (control (monoid #as m #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all)
+ (eq #as E)
+ (dict #as D #refer #all))
+ (data/number (int #open ("i" Int/Number Int/Ord Int/Eq)))
+ meta/macro))
## Types
## (deftype (List a)
## (| #Nil
## (#Cons (, a (List a)))))
-## Functions
+(deftype #export (PList k v)
+ (| (#PList (, (E;Eq k) (List (, k v))))))
+
+## [Utils]
+(def (pl-get eq k kvs)
+ (All [k v]
+ (-> (E;Eq k) k (List (, k v)) (Maybe v)))
+ (case kvs
+ #;Nil
+ #;None
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ (#;Some v')
+ (pl-get eq k kvs'))))
+
+(def (pl-put eq k v kvs)
+ (All [k v]
+ (-> (E;Eq k) k v (List (, k v)) (List (, k v))))
+ (case kvs
+ #;Nil
+ (#;Cons [[k v] kvs])
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ (#;Cons [[k v] kvs'])
+ (#;Cons [[k' v'] (pl-put eq k v kvs')]))))
+
+(def (pl-remove eq k kvs)
+ (All [k v]
+ (-> (E;Eq k) k (List (, k v)) (List (, k v))))
+ (case kvs
+ #;Nil
+ kvs
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ kvs'
+ (#;Cons [[k' v'] (pl-remove eq k kvs')]))))
+
+## [Constructors]
+(def #export (plist eq)
+ (All [k v]
+ (-> (E;Eq k) (PList k v)))
+ (#PList [eq #;Nil]))
+
+## [Functions]
(def #export (foldL f init xs)
(All [a b]
(-> (-> a b a) a (List b) a))
@@ -38,6 +87,12 @@
(#;Cons [x xs'])
(f x (foldR f init xs'))))
+(def #export (fold mon xs)
+ (All [a]
+ (-> (m;Monoid a) (List a) a))
+ (using mon
+ (foldL ++ unit xs)))
+
(def #export (reverse xs)
(All [a]
(-> (List a) (List a)))
@@ -83,8 +138,8 @@
<then>)
<else>))]
- [take (#;Cons [x (take (dec n) xs')]) #;Nil]
- [drop (drop (dec n) xs') xs]
+ [take (#;Cons [x (take (i+ -1 n) xs')]) #;Nil]
+ [drop (drop (i+ -1 n) xs') xs]
)
(do-template [<name> <then> <else>]
@@ -113,7 +168,7 @@
[#;Nil #;Nil]
(#;Cons [x xs'])
- (let [[tail rest] (split (dec n) xs')]
+ (let [[tail rest] (split (i+ -1 n) xs')]
[(#;Cons [x tail]) rest]))
[#;Nil xs]))
@@ -139,7 +194,7 @@
(All [a]
(-> Int a (List a)))
(if (i> n 0)
- (#;Cons [x (repeat (dec n) x)])
+ (#;Cons [x (repeat (i+ -1 n) x)])
#;Nil))
(def #export (iterate f x)
@@ -203,7 +258,7 @@
(#;Cons [x xs'])
(if (i= 0 i)
(#;Some x)
- (@ (dec i) xs'))))
+ (@ (i+ -1 i) xs'))))
## Syntax
(defmacro #export (list xs state)
@@ -225,6 +280,17 @@
(#;Left "Wrong syntax for list&")))
## Structures
+## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a))))
+## (def (E;= xs ys)
+## (case [xs ys]
+## [#;Nil #;Nil]
+## true
+
+## [(#;Cons [x xs']) (#;Cons [y ys'])]
+## (and (:: eq (E;= x y))
+## (E;= xs' ys'))
+## )))
+
(defstruct #export List/Monoid (All [a]
(Monoid (List a)))
(def m;unit #;Nil)
@@ -248,3 +314,16 @@
(def (M;join mma)
(using List/Monoid
(foldL ++ unit mma))))
+
+(defstruct #export PList/Dict (Dict PList)
+ (def (D;get k plist)
+ (let [(#PList [eq kvs]) plist]
+ (pl-get eq k kvs)))
+
+ (def (D;put k v plist)
+ (let [(#PList [eq kvs]) plist]
+ (#PList [eq (pl-put eq k v kvs)])))
+
+ (def (D;remove k plist)
+ (let [(#PList [eq kvs]) plist]
+ (#PList [eq (pl-remove eq k kvs)]))))
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index faec53c2e..396ec470a 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -7,9 +7,12 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m #refer #all)
- (functor #as F #refer #all)
- (monad #as M #refer #all)))
+ (.. list)
+ (lux (control (monoid #as m #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all))
+ (meta lux
+ syntax)))
## [Types]
## (deftype (Maybe a)
@@ -40,3 +43,14 @@
(case mma
#;None #;None
(#;Some xs) xs)))
+
+## [Syntax]
+(defsyntax #export (? maybe else)
+ (do Lux/Monad
+ [g!value (gensym "")]
+ (M;wrap (list (` (case (~ maybe)
+ (#;Some (~ g!value))
+ (~ g!value)
+
+ _
+ (~ else)))))))
diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux
new file mode 100644
index 000000000..35c8d34bf
--- /dev/null
+++ b/source/lux/data/number/int.lux
@@ -0,0 +1,89 @@
+## 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 (number #as N)
+ (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (bounded #as B)
+ (show #as S)))
+
+## [Structures]
+## Number
+(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
+ [(defstruct #export <name> (N;Number <type>)
+ (def (N;+ x y) (<+> x y))
+ (def (N;- x y) (<-> x y))
+ (def (N;* x y) (<*> x y))
+ (def (N;/ x y) (</> x y))
+ (def (N;% x y) (<%> x y))
+ (def (N;from-int x)
+ (<from> x))
+ (def (N;negate x)
+ (<*> <-1> x))
+ (def (N;abs x)
+ (if (<<> x <0>)
+ (<*> <-1> x)
+ x))
+ (def (N;signum x)
+ (cond (<=> x <0>) <0>
+ (<<> x <0>) <-1>
+ ## else
+ <1>))
+ )]
+
+ [ Int/Number Int _jvm_ladd _jvm_lsub _jvm_lmul _jvm_ldiv _jvm_lrem _jvm_leq _jvm_llt id 0 1 -1])
+
+## Eq
+(defstruct #export Int/Eq (E;Eq Int)
+ (def (E;= x y) (_jvm_leq x y)))
+
+## Ord
+(do-template [<name> <type> <eq> <=> <lt> <gt>]
+ [(defstruct #export <name> (O;Ord <type>)
+ (def O;_eq <eq>)
+ (def (O;< x y) (<lt> x y))
+ (def (O;<= x y)
+ (or (<lt> x y)
+ (<=> x y)))
+ (def (O;> x y) (<gt> x y))
+ (def (O;>= x y)
+ (or (<gt> x y)
+ (<=> x y))))]
+
+ [ Int/Ord Int Int/Eq _jvm_leq _jvm_llt _jvm_lgt])
+
+## 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")])
+
+## Monoid
+(do-template [<name> <type> <unit> <++>]
+ [(defstruct #export <name> (m;Monoid <type>)
+ (def m;unit <unit>)
+ (def (m;++ x y) (<++> x y)))]
+
+ [ IntAdd/Monoid Int 0 _jvm_ladd]
+ [ IntMul/Monoid Int 1 _jvm_lmul]
+ [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)]
+ [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/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 [])]
+ )
diff --git a/source/lux/data/number.lux b/source/lux/data/number/real.lux
index 8771ef06e..4f9e4fa5f 100644
--- a/source/lux/data/number.lux
+++ b/source/lux/data/number/real.lux
@@ -7,75 +7,57 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m))
- (.. (eq #as E)
- (ord #as O)
- (bounded #as B)
- (show #as S)))
-
-## Signatures
-(defsig #export (Number n)
- (do-template [<name>]
- [(: (-> n n n) <name>)]
- [+] [-] [*] [/] [%])
-
- (: (-> Int n)
- from-int)
-
- (do-template [<name>]
- [(: (-> n n) <name>)]
- [negate] [signum] [abs])
- )
+ (lux/control (number #as N)
+ (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (bounded #as B)
+ (show #as S)))
## [Structures]
## Number
(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
- [(defstruct #export <name> (Number <type>)
- (def + <+>)
- (def - <->)
- (def * <*>)
- (def / </>)
- (def % <%>)
- (def (from-int x)
+ [(defstruct #export <name> (N;Number <type>)
+ (def (N;+ x y) (<+> x y))
+ (def (N;- x y) (<-> x y))
+ (def (N;* x y) (<*> x y))
+ (def (N;/ x y) (</> x y))
+ (def (N;% x y) (<%> x y))
+ (def (N;from-int x)
(<from> x))
- (def (negate x)
+ (def (N;negate x)
(<*> <-1> x))
- (def (abs x)
+ (def (N;abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (signum x)
+ (def (N;signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
<1>))
)]
- [ Int/Number Int i+ i- i* i/ i% i= i< id 0 1 -1]
- [Real/Number Real r+ r- r* r/ r% r= r< _jvm_l2d 0.0 1.0 -1.0])
+ [Real/Number Real _jvm_dadd _jvm_dsub _jvm_dmul _jvm_ddiv _jvm_drem _jvm_deq _jvm_dlt _jvm_l2d 0.0 1.0 -1.0])
## Eq
-(defstruct #export Int/Eq (E;Eq Int)
- (def E;= i=))
-
(defstruct #export Real/Eq (E;Eq Real)
- (def E;= r=))
+ (def (E;= x y) (_jvm_deq x y)))
## Ord
-(do-template [<name> <type> <eq> <lt> <gt>]
+(do-template [<name> <type> <eq> <=> <lt> <gt>]
[(defstruct #export <name> (O;Ord <type>)
(def O;_eq <eq>)
- (def O;< <lt>)
+ (def (O;< x y) (<lt> x y))
(def (O;<= x y)
(or (<lt> x y)
- (:: <eq> (E;= x y))))
- (def O;> <gt>)
+ (<=> x y)))
+ (def (O;> x y) (<gt> x y))
(def (O;>= x y)
(or (<gt> x y)
- (:: <eq> (E;= x y)))))]
+ (<=> x y))))]
- [ Int/Ord Int Int/Eq i< i>]
- [Real/Ord Real Real/Eq r< r>])
+ [Real/Ord Real Real/Eq _jvm_deq _jvm_dlt _jvm_dgt])
## Bounded
(do-template [<name> <type> <top> <bottom>]
@@ -83,21 +65,16 @@
(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> <++>]
[(defstruct #export <name> (m;Monoid <type>)
(def m;unit <unit>)
- (def m;++ <++>))]
+ (def (m;++ x y) (<++> x y)))]
- [ IntAdd/Monoid Int 0 i+]
- [ IntMul/Monoid Int 1 i*]
- [RealAdd/Monoid Real 0.0 r+]
- [RealMul/Monoid Real 1.0 r*]
- [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)]
- [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)]
+ [RealAdd/Monoid Real 0.0 _jvm_dadd]
+ [RealMul/Monoid Real 1.0 _jvm_dmul]
[RealMax/Monoid Real (:: Real/Bounded B;bottom) (O;max Real/Ord)]
[RealMin/Monoid Real (:: Real/Bounded B;top) (O;min Real/Ord)]
)
@@ -108,6 +85,5 @@
(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/source/lux/data/text.lux b/source/lux/data/text.lux
index 6ad9cfd63..c3cb1ecfb 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -7,10 +7,11 @@
## 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)
- (show #as S)))
+ (lux (control (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (show #as S))
+ (data/number (int #open ("i" Int/Number Int/Ord Int/Eq)))))
## [Functions]
(def #export (size x)
diff --git a/source/lux/data/tuple.lux b/source/lux/data/tuple.lux
new file mode 100644
index 000000000..5220ad4ac
--- /dev/null
+++ b/source/lux/data/tuple.lux
@@ -0,0 +1,39 @@
+## 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)
+
+## [Functions]
+(do-template [<name> <type> <output>]
+ [(def #export (<name> xy)
+ (All [a b] (-> (, a b) <type>))
+ (let [[x y] xy]
+ <output>))]
+
+ [first a x]
+ [second b y])
+
+(def #export (curry f)
+ (All [a b c]
+ (-> (-> (, a b) c)
+ (-> a b c)))
+ (lambda [x y]
+ (f [x y])))
+
+(def #export (uncurry f)
+ (All [a b c]
+ (-> (-> a b c)
+ (-> (, a b) c)))
+ (lambda [xy]
+ (let [[x y] xy]
+ (f x y))))
+
+(def #export (swap xy)
+ (All [a b] (-> (, a b) (, b a)))
+ (let [[x y] xy]
+ [y x]))
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 7af043969..2c90b1ba3 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -11,7 +11,8 @@
(functor #as F)
(monad #as M #refer (#only do)))
(data (list #as l #refer #all #open ("" List/Functor))
- (text #as text))
+ (text #as text)
+ (number (int #open ("i" Int/Eq))))
(meta lux
macro
syntax)))
@@ -236,3 +237,16 @@
(emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
[(~@ (map text$ m-classes))]
[(~@ m-args)]))))))
+
+(defsyntax #export (->maybe expr)
+ (do Lux/Monad
+ [g!val (gensym "")]
+ (emit (list (` (;let [(~ g!val) (~ expr)]
+ (;if (null? (~ g!val))
+ #;None
+ (#;Some (~ g!val)))))))))
+
+(defsyntax #export (try$ expr)
+ (emit (list (` (try (#;Right (~ expr))
+ (~ (' (catch java.lang.Exception e
+ (#;Left (.! (getMessage [] []) e))))))))))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 19b7dd9df..13dcae284 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -10,12 +10,11 @@
(.. macro)
(lux/control (monoid #as m)
(functor #as F)
- (monad #as M #refer (#only do)))
+ (monad #as M #refer (#only do))
+ (show #as S))
(lux/data list
- maybe
- (show #as S)
- (number #as N)
- (text #as T #open ("text:" Text/Monoid Text/Eq))))
+ (text #as T #open ("text:" Text/Monoid Text/Eq))
+ (number/int #as I #open ("i" Int/Number))))
## [Types]
## (deftype (Lux a)
@@ -77,20 +76,27 @@
(def (find-macro' modules current-module module name)
(-> (List (, Text (Module Compiler))) Text Text Text
(Maybe Macro))
- (do Maybe/Monad
- [$module (get module modules)
- gdef (|> (: (Module Compiler) $module) (get@ #;defs) (get name))]
- (case (: (, Bool (DefData' Macro)) gdef)
- [exported? (#;MacroD macro')]
- (if (or exported? (text:= module current-module))
- (#;Some macro')
+ (case (get module modules)
+ (#;Some $module)
+ (case (|> (: (Module Compiler) $module) (get@ #;defs) (get name))
+ (#;Some gdef)
+ (case (: (, Bool (DefData' Macro)) gdef)
+ [exported? (#;MacroD macro')]
+ (if (or exported? (text:= module current-module))
+ (#;Some macro')
+ #;None)
+
+ [_ (#;AliasD [r-module r-name])]
+ (find-macro' modules current-module r-module r-name)
+
+ _
#;None)
-
- [_ (#;AliasD [r-module r-name])]
- (find-macro' modules current-module r-module r-name)
_
- #;None)))
+ #;None)
+
+ _
+ #;None))
(def #export (find-macro ident)
(-> Ident (Lux (Maybe Macro)))
@@ -147,8 +153,8 @@
(def #export (gensym prefix state)
(-> Text (Lux Syntax))
- (#;Right [(update@ #;seed inc state)
- (symbol$ ["__gensym__" (:: N;Int/Show (S;show (get@ #;seed state)))])]))
+ (#;Right [(update@ #;seed (i+ 1) state)
+ (symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])]))
(def #export (emit datum)
(All [a]
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 63ab81475..972999fcb 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -10,12 +10,14 @@
(.. (macro #as m #refer #all)
(lux #as l #refer (#only Lux/Monad gensym)))
(lux (control (functor #as F)
- (monad #as M #refer (#only do)))
- (data (eq #as E)
- (bool #as b)
+ (monad #as M #refer (#only do))
+ (eq #as E))
+ (data (bool #as b)
(char #as c)
(text #as t #open ("text:" Text/Monoid Text/Eq))
- list)))
+ list
+ (number (int #open ("i" Int/Eq))
+ (real #open ("r" Real/Eq))))))
## [Utils]
(def (first xy)