aboutsummaryrefslogtreecommitdiff
path: root/source/lux/data
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux/data')
-rw-r--r--source/lux/data/bool.lux33
-rw-r--r--source/lux/data/bounded.lux17
-rw-r--r--source/lux/data/char.lux20
-rw-r--r--source/lux/data/dict.lux83
-rw-r--r--source/lux/data/either.lux46
-rw-r--r--source/lux/data/eq.lux14
-rw-r--r--source/lux/data/error.lux34
-rw-r--r--source/lux/data/id.lux28
-rw-r--r--source/lux/data/io.lux51
-rw-r--r--source/lux/data/list.lux250
-rw-r--r--source/lux/data/maybe.lux42
-rw-r--r--source/lux/data/number.lux119
-rw-r--r--source/lux/data/ord.lux44
-rw-r--r--source/lux/data/reader.lux33
-rw-r--r--source/lux/data/show.lux14
-rw-r--r--source/lux/data/state.lux35
-rw-r--r--source/lux/data/text.lux146
-rw-r--r--source/lux/data/writer.lux34
18 files changed, 1043 insertions, 0 deletions
diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux
new file mode 100644
index 000000000..d4f223612
--- /dev/null
+++ b/source/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/source/lux/data/bounded.lux b/source/lux/data/bounded.lux
new file mode 100644
index 000000000..9d2dabde1
--- /dev/null
+++ b/source/lux/data/bounded.lux
@@ -0,0 +1,17 @@
+## 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 (Bounded a)
+ (: a
+ top)
+
+ (: a
+ bottom))
diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux
new file mode 100644
index 000000000..42e57509e
--- /dev/null
+++ b/source/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/source/lux/data/dict.lux b/source/lux/data/dict.lux
new file mode 100644
index 000000000..63a66d49b
--- /dev/null
+++ b/source/lux/data/dict.lux
@@ -0,0 +1,83 @@
+## 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/either.lux b/source/lux/data/either.lux
new file mode 100644
index 000000000..eba6438db
--- /dev/null
+++ b/source/lux/data/either.lux
@@ -0,0 +1,46 @@
+## 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 (list #refer (#exclude partition))))
+
+## [Types]
+## (deftype (Either l r)
+## (| (#;Left l)
+## (#;Right r)))
+
+## [Functions]
+(def #export (either f g e)
+ (All [a b c] (-> (-> a c) (-> b c) (Either a b) c))
+ (case e
+ (#;Left x) (f x)
+ (#;Right x) (g x)))
+
+(do-template [<name> <side> <tag>]
+ [(def #export (<name> es)
+ (All [a b] (-> (List (Either a b)) (List <side>)))
+ (case es
+ #;Nil #;Nil
+ (#;Cons [(<tag> x) es']) (#;Cons [x (<name> es')])
+ (#;Cons [_ es']) (<name> es')))]
+
+ [lefts a #;Left]
+ [rights b #;Right]
+ )
+
+(def #export (partition es)
+ (All [a b] (-> (List (Either a b)) (, (List a) (List b))))
+ (foldL (: (All [a b]
+ (-> (, (List a) (List b)) (Either a b) (, (List a) (List b))))
+ (lambda [tails e]
+ (let [[ltail rtail] tails]
+ (case e
+ (#;Left x) [(#;Cons [x ltail]) rtail]
+ (#;Right x) [ltail (#;Cons [x rtail])]))))
+ [(list) (list)]
+ (reverse es)))
diff --git a/source/lux/data/eq.lux b/source/lux/data/eq.lux
new file mode 100644
index 000000000..be3400208
--- /dev/null
+++ b/source/lux/data/eq.lux
@@ -0,0 +1,14 @@
+## 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 (Eq a)
+ (: (-> a a Bool)
+ =))
diff --git a/source/lux/data/error.lux b/source/lux/data/error.lux
new file mode 100644
index 000000000..cb5c309a6
--- /dev/null
+++ b/source/lux/data/error.lux
@@ -0,0 +1,34 @@
+## 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 (Error a)
+ (| (#Fail Text)
+ (#Ok a)))
+
+## [Structures]
+(defstruct #export Error/Functor (Functor Error)
+ (def (F;map f ma)
+ (case ma
+ (#Fail msg) (#Fail msg)
+ (#Ok datum) (#Ok (f datum)))))
+
+(defstruct #export Error/Monad (Monad Error)
+ (def M;_functor Error/Functor)
+
+ (def (M;wrap a)
+ (#Ok a))
+
+ (def (M;join mma)
+ (case mma
+ (#Fail msg) (#Fail msg)
+ (#Ok ma) ma)))
diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux
new file mode 100644
index 000000000..0e3bdbee6
--- /dev/null
+++ b/source/lux/data/id.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 (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Id a)
+ (| (#Id a)))
+
+## [Structures]
+(defstruct #export Id/Functor (Functor Id)
+ (def (F;map f fa)
+ (let [(#Id a) fa]
+ (#Id (f a)))))
+
+(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)))
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
new file mode 100644
index 000000000..c08023df5
--- /dev/null
+++ b/source/lux/data/io.lux
@@ -0,0 +1,51 @@
+## 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/meta macro)
+ (lux/control (functor #as F)
+ (monad #as M))
+ lux/data/list)
+
+## Types
+(deftype #export (IO a)
+ (-> (,) a))
+
+## Syntax
+(defmacro #export (io tokens state)
+ (case tokens
+ (\ (list value))
+ (let [blank (symbol$ ["" ""])]
+ (#;Right [state (list (` (_lux_lambda (~ blank) (~ blank) (~ value))))]))
+
+ _
+ (#;Left "Wrong syntax for io")))
+
+## Structures
+(defstruct #export IO/Functor (F;Functor IO)
+ (def (F;map f ma)
+ (io (f (ma [])))))
+
+(defstruct #export IO/Monad (M;Monad IO)
+ (def M;_functor IO/Functor)
+
+ (def (M;wrap x)
+ (io x))
+
+ (def (M;join mma)
+ (mma [])))
+
+## Functions
+(def #export (print x)
+ (-> Text (IO (,)))
+ (io (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object]
+ (_jvm_getstatic java.lang.System out) [x])))
+
+(def #export (println x)
+ (-> Text (IO (,)))
+ (print (text:++ x "\n")))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
new file mode 100644
index 000000000..450dee275
--- /dev/null
+++ b/source/lux/data/list.lux
@@ -0,0 +1,250 @@
+## 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 #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all))
+ lux/meta/macro)
+
+## Types
+## (deftype (List a)
+## (| #Nil
+## (#Cons (, a (List a)))))
+
+## Functions
+(def #export (foldL f init xs)
+ (All [a b]
+ (-> (-> a b a) a (List b) a))
+ (case xs
+ #;Nil
+ init
+
+ (#;Cons [x xs'])
+ (foldL f (f init x) xs')))
+
+(def #export (foldR f init xs)
+ (All [a b]
+ (-> (-> b a a) a (List b) a))
+ (case xs
+ #;Nil
+ init
+
+ (#;Cons [x xs'])
+ (f x (foldR f init xs'))))
+
+(def #export (reverse xs)
+ (All [a]
+ (-> (List a) (List a)))
+ (foldL (lambda [tail head] (#;Cons [head tail]))
+ #;Nil
+ xs))
+
+(def #export (filter p xs)
+ (All [a]
+ (-> (-> a Bool) (List a) (List a)))
+ (case xs
+ #;Nil
+ #;Nil
+
+ (#;Cons [x xs'])
+ (if (p x)
+ (#;Cons [x (filter p xs')])
+ (filter p xs'))))
+
+(def #export (partition p xs)
+ (All [a] (-> (-> a Bool) (List a) (, (List a) (List a))))
+ [(filter p xs) (filter (complement p) xs)])
+
+(def #export (as-pairs xs)
+ (All [a] (-> (List a) (List (, a a))))
+ (case xs
+ (\ (#;Cons [x1 (#;Cons [x2 xs'])]))
+ (#;Cons [[x1 x2] (as-pairs xs')])
+
+ _
+ #;Nil))
+
+(do-template [<name> <then> <else>]
+ [(def #export (<name> n xs)
+ (All [a]
+ (-> Int (List a) (List a)))
+ (if (i> n 0)
+ (case xs
+ #;Nil
+ #;Nil
+
+ (#;Cons [x xs'])
+ <then>)
+ <else>))]
+
+ [take (#;Cons [x (take (dec n) xs')]) #;Nil]
+ [drop (drop (dec n) xs') xs]
+ )
+
+(do-template [<name> <then> <else>]
+ [(def #export (<name> p xs)
+ (All [a]
+ (-> (-> a Bool) (List a) (List a)))
+ (case xs
+ #;Nil
+ #;Nil
+
+ (#;Cons [x xs'])
+ (if (p x)
+ <then>
+ <else>)))]
+
+ [take-while (#;Cons [x (take-while p xs')]) #;Nil]
+ [drop-while (drop-while p xs') xs]
+ )
+
+(def #export (split n xs)
+ (All [a]
+ (-> Int (List a) (, (List a) (List a))))
+ (if (i> n 0)
+ (case xs
+ #;Nil
+ [#;Nil #;Nil]
+
+ (#;Cons [x xs'])
+ (let [[tail rest] (split (dec n) xs')]
+ [(#;Cons [x tail]) rest]))
+ [#;Nil xs]))
+
+(def (split-with' p ys xs)
+ (All [a]
+ (-> (-> a Bool) (List a) (List a) (, (List a) (List a))))
+ (case xs
+ #;Nil
+ [ys xs]
+
+ (#;Cons [x xs'])
+ (if (p x)
+ (split-with' p (#;Cons [x ys]) xs')
+ [ys xs])))
+
+(def #export (split-with p xs)
+ (All [a]
+ (-> (-> a Bool) (List a) (, (List a) (List a))))
+ (let [[ys' xs'] (split-with' p #;Nil xs)]
+ [(reverse ys') xs']))
+
+(def #export (repeat n x)
+ (All [a]
+ (-> Int a (List a)))
+ (if (i> n 0)
+ (#;Cons [x (repeat (dec n) x)])
+ #;Nil))
+
+(def #export (iterate f x)
+ (All [a]
+ (-> (-> a (Maybe a)) a (List a)))
+ (case (f x)
+ (#;Some x')
+ (#;Cons [x (iterate f x')])
+
+ #;None
+ (#;Cons [x #;Nil])))
+
+(def #export (some f xs)
+ (All [a b]
+ (-> (-> a (Maybe b)) (List a) (Maybe b)))
+ (case xs
+ #;Nil
+ #;None
+
+ (#;Cons [x xs'])
+ (case (f x)
+ #;None
+ (some f xs')
+
+ (#;Some y)
+ (#;Some y))))
+
+(def #export (interpose sep xs)
+ (All [a]
+ (-> a (List a) (List a)))
+ (case xs
+ #;Nil
+ xs
+
+ (#;Cons [x #;Nil])
+ xs
+
+ (#;Cons [x xs'])
+ (#;Cons [x (#;Cons [sep (interpose sep xs')])])))
+
+(def #export (size list)
+ (-> List Int)
+ (foldL (lambda [acc _] (i+ 1 acc)) 0 list))
+
+(do-template [<name> <init> <op>]
+ [(def #export (<name> p xs)
+ (All [a]
+ (-> (-> a Bool) (List a) Bool))
+ (foldL (lambda [_1 _2] (<op> _1 (p _2))) <init> xs))]
+
+ [every? true and]
+ [any? false or])
+
+(def #export (@ i xs)
+ (All [a]
+ (-> Int (List a) (Maybe a)))
+ (case xs
+ #;Nil
+ #;None
+
+ (#;Cons [x xs'])
+ (if (i= 0 i)
+ (#;Some x)
+ (@ (dec i) xs'))))
+
+## Syntax
+(defmacro #export (list xs state)
+ (#;Right [state (#;Cons [(foldL (lambda [tail head]
+ (` (#;Cons [(~ head) (~ tail)])))
+ (` #;Nil)
+ (reverse xs))
+ #;Nil])]))
+
+(defmacro #export (list& xs state)
+ (case (reverse xs)
+ (#;Cons [last init])
+ (#;Right [state (list (foldL (lambda [tail head]
+ (` (#;Cons [(~ head) (~ tail)])))
+ last
+ init))])
+
+ _
+ (#;Left "Wrong syntax for list&")))
+
+## Structures
+(defstruct #export List/Monoid (All [a]
+ (Monoid (List a)))
+ (def m;unit #;Nil)
+ (def (m;++ xs ys)
+ (case xs
+ #;Nil ys
+ (#;Cons [x xs']) (#;Cons [x (m;++ xs' ys)]))))
+
+(defstruct #export List/Functor (Functor List)
+ (def (F;map f ma)
+ (case ma
+ #;Nil #;Nil
+ (#;Cons [a ma']) (#;Cons [(f a) (F;map f ma')]))))
+
+(defstruct #export List/Monad (Monad List)
+ (def M;_functor List/Functor)
+
+ (def (M;wrap a)
+ (#;Cons [a #;Nil]))
+
+ (def (M;join mma)
+ (using List/Monoid
+ (foldL m;++ m;unit mma))))
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
new file mode 100644
index 000000000..faec53c2e
--- /dev/null
+++ b/source/lux/data/maybe.lux
@@ -0,0 +1,42 @@
+## 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 #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+## (deftype (Maybe a)
+## (| #;None
+## (#;Some a)))
+
+## [Structures]
+(defstruct #export Maybe/Monoid (Monoid Maybe)
+ (def m;unit #;None)
+ (def (m;++ xs ys)
+ (case xs
+ #;None ys
+ (#;Some x) (#;Some x))))
+
+(defstruct #export Maybe/Functor (Functor Maybe)
+ (def (F;map f ma)
+ (case ma
+ #;None #;None
+ (#;Some a) (#;Some (f a)))))
+
+(defstruct #export Maybe/Monad (Monad Maybe)
+ (def M;_functor Maybe/Functor)
+
+ (def (M;wrap x)
+ (#;Some x))
+
+ (def (M;join mma)
+ (case mma
+ #;None #;None
+ (#;Some xs) xs)))
diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux
new file mode 100644
index 000000000..8da674d88
--- /dev/null
+++ b/source/lux/data/number.lux
@@ -0,0 +1,119 @@
+## 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))
+ (lux/data (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])
+ )
+
+## [Structures]
+## Number
+(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
+ [(defstruct #export <name> (Number <type>)
+ (def + <+>)
+ (def - <->)
+ (def * <*>)
+ (def / </>)
+ (def % <%>)
+ (def (from-int x)
+ (<from> x))
+ (def (negate x)
+ (<*> <-1> x))
+ (def (abs x)
+ (if (<<> x <0>)
+ (<*> <-1> x)
+ x))
+ (def (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])
+
+## Eq
+(defstruct #export Int/Eq (E;Eq Int)
+ (def E;= i=))
+
+(defstruct #export Real/Eq (E;Eq Real)
+ (def E;= r=))
+
+## Ord
+## (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>))
+
+(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> <++>]
+ [(defstruct #export <name> (m;Monoid <type>)
+ (def m;unit <unit>)
+ (def m;++ <++>))]
+
+ [ 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)]
+ [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/source/lux/data/ord.lux b/source/lux/data/ord.lux
new file mode 100644
index 000000000..80f2e4fb5
--- /dev/null
+++ b/source/lux/data/ord.lux
@@ -0,0 +1,44 @@
+## 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))
+
+## [Signatures]
+(defsig #export (Ord a)
+ (: (E;Eq a)
+ _eq)
+ (do-template [<name>]
+ [(: (-> a a Bool) <name>)]
+
+ [<] [<=] [>] [>=]))
+
+## [Constructors]
+(def #export (ord$ eq < >)
+ (All [a]
+ (-> (E;Eq a) (-> a a Bool) (-> a a Bool) (Ord a)))
+ (struct
+ (def _eq eq)
+ (def < <)
+ (def (<= x y)
+ (or (< x y)
+ (:: eq (E;= x y))))
+ (def > >)
+ (def (>= x y)
+ (or (> x y)
+ (:: eq (E;= x y))))))
+
+## [Functions]
+(do-template [<name> <op>]
+ [(def #export (<name> ord x y)
+ (All [a]
+ (-> (Ord a) a a a))
+ (if (:: ord (<op> x y)) x y))]
+
+ [max ;;>]
+ [min ;;<])
diff --git a/source/lux/data/reader.lux b/source/lux/data/reader.lux
new file mode 100644
index 000000000..e91687c3a
--- /dev/null
+++ b/source/lux/data/reader.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 #refer (#exclude Reader))
+ (lux/control (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Reader r a)
+ (-> r a))
+
+## [Structures]
+(defstruct #export Reader/Functor (All [r]
+ (Functor (Reader r)))
+ (def (F;map f fa)
+ (lambda [env]
+ (f (fa env)))))
+
+(defstruct #export Reader/Monad (All [r]
+ (Monad (Reader r)))
+ (def M;_functor Reader/Functor)
+
+ (def (M;wrap x)
+ (lambda [env] x))
+
+ (def (M;join mma)
+ (lambda [env]
+ (mma env env))))
diff --git a/source/lux/data/show.lux b/source/lux/data/show.lux
new file mode 100644
index 000000000..f4e1cf762
--- /dev/null
+++ b/source/lux/data/show.lux
@@ -0,0 +1,14 @@
+## 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 (Show a)
+ (: (-> a Text)
+ show))
diff --git a/source/lux/data/state.lux b/source/lux/data/state.lux
new file mode 100644
index 000000000..bc9858a29
--- /dev/null
+++ b/source/lux/data/state.lux
@@ -0,0 +1,35 @@
+## 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 (State s a)
+ (-> s (, s a)))
+
+## [Structures]
+(defstruct #export State/Functor (Functor State)
+ (def (F;map f ma)
+ (lambda [state]
+ (let [[state' a] (ma state)]
+ [state' (f a)]))))
+
+(defstruct #export State/Monad (All [s]
+ (Monad (State s)))
+ (def M;_functor State/Functor)
+
+ (def (M;wrap x)
+ (lambda [state]
+ [state x]))
+
+ (def (M;join mma)
+ (lambda [state]
+ (let [[state' ma] (mma state)]
+ (ma state')))))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
new file mode 100644
index 000000000..a3192a1d5
--- /dev/null
+++ b/source/lux/data/text.lux
@@ -0,0 +1,146 @@
+## 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))
+ (lux/data (eq #as E)
+ (ord #as O)
+ (show #as S)))
+
+## [Functions]
+(def #export (size x)
+ (-> Text Int)
+ (_jvm_i2l (_jvm_invokevirtual java.lang.String length []
+ x [])))
+
+(def #export (@ idx x)
+ (-> Int Text (Maybe Char))
+ (if (and (i< idx (size x))
+ (i>= idx 0))
+ (#;Some (_jvm_invokevirtual java.lang.String charAt [int]
+ x [(_jvm_l2i idx)]))
+ #;None))
+
+(def #export (contains? x y)
+ (-> Text Text Bool)
+ (_jvm_invokevirtual java.lang.String contains [java.lang.CharSequence]
+ x [y]))
+
+(do-template [<name> <method>]
+ [(def #export (<name> x)
+ (-> Text Text)
+ (_jvm_invokevirtual java.lang.String <method> []
+ x []))]
+ [lower-case toLowerCase]
+ [upper-case toUpperCase]
+ [trim trim]
+ )
+
+(def #export (sub' from to x)
+ (-> Int Int Text (Maybe Text))
+ (if (and (i< from to)
+ (i>= from 0)
+ (i<= to (size x)))
+ (_jvm_invokevirtual java.lang.String substring [int int]
+ x [(_jvm_l2i from) (_jvm_l2i to)])
+ #;None))
+
+(def #export (sub from x)
+ (-> Int Text (Maybe Text))
+ (sub' from (size x) x))
+
+(def #export (split at x)
+ (-> Int Text (Maybe (, Text Text)))
+ (if (and (i< at (size x))
+ (i>= at 0))
+ (let [pre (_jvm_invokevirtual java.lang.String substring [int int]
+ x [(_jvm_l2i 0) (_jvm_l2i at)])
+ post (_jvm_invokevirtual java.lang.String substring [int]
+ x [(_jvm_l2i at)])]
+ (#;Some [pre post]))
+ #;None))
+
+(def #export (replace pattern value template)
+ (-> Text Text Text Text)
+ (_jvm_invokevirtual java.lang.String replace [java.lang.CharSequence java.lang.CharSequence]
+ template [pattern value]))
+
+(do-template [<common> <general> <method>]
+ [(def #export (<general> pattern from x)
+ (-> Text Int Text (Maybe Int))
+ (if (and (i< from (size x)) (i>= from 0))
+ (case (_jvm_i2l (_jvm_invokevirtual java.lang.String <method> [java.lang.String int]
+ x [pattern (_jvm_l2i from)]))
+ -1 #;None
+ idx (#;Some idx))
+ #;None))
+
+ (def #export (<common> pattern x)
+ (-> Text Text (Maybe Int))
+ (case (_jvm_i2l (_jvm_invokevirtual java.lang.String <method> [java.lang.String]
+ x [pattern]))
+ -1 #;None
+ idx (#;Some idx)))]
+
+ [index-of index-of' indexOf]
+ [last-index-of last-index-of' lastIndexOf]
+ )
+
+(def #export (starts-with? prefix x)
+ (-> Text Text Bool)
+ (case (index-of prefix x)
+ (#;Some 0)
+ true
+
+ _
+ false))
+
+(def #export (ends-with? postfix x)
+ (-> Text Text Bool)
+ (case (last-index-of postfix x)
+ (#;Some n)
+ (i= (i+ n (size postfix))
+ (size x))
+
+ _
+ false))
+
+## [Structures]
+(defstruct #export Text/Eq (E;Eq Text)
+ (def (E;= x y)
+ (_jvm_invokevirtual java.lang.Object equals [java.lang.Object]
+ x [y])))
+
+(defstruct #export Text/Ord (O;Ord Text)
+ (def O;_eq Text/Eq)
+ (def (O;< x y)
+ (i< (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0))
+ (def (O;<= x y)
+ (i<= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0))
+ (def (O;> x y)
+ (i> (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0))
+ (def (O;>= x y)
+ (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/source/lux/data/writer.lux b/source/lux/data/writer.lux
new file mode 100644
index 000000000..f71492e35
--- /dev/null
+++ b/source/lux/data/writer.lux
@@ -0,0 +1,34 @@
+## 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 #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Writer l a)
+ (, l a))
+
+## [Structures]
+(defstruct #export Writer/Functor (All [l]
+ (Functor (Writer l)))
+ (def (F;map f fa)
+ (let [[log datum] fa]
+ [log (f datum)])))
+
+(defstruct #export (Writer/Monad mon) (All [l]
+ (-> (Monoid l) (Monad (Writer l))))
+ (def M;_functor Writer/Functor)
+
+ (def (M;wrap x)
+ [(:: mon m;unit) x])
+
+ (def (M;join mma)
+ (let [[log1 [log2 a]] mma]
+ [(:: mon (m;++ log1 log2)) a])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 01:08:38 +0000