aboutsummaryrefslogtreecommitdiff
path: root/source/lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux')
-rw-r--r--source/lux/codata/function.lux4
-rw-r--r--source/lux/codata/stream.lux3
-rw-r--r--source/lux/control/hash.lux14
-rw-r--r--source/lux/data/bool.lux12
-rw-r--r--source/lux/data/list.lux83
-rw-r--r--source/lux/meta/lux.lux34
6 files changed, 90 insertions, 60 deletions
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux
index 3c40df188..7898e998d 100644
--- a/source/lux/codata/function.lux
+++ b/source/lux/codata/function.lux
@@ -10,6 +10,10 @@
(lux/control (monoid #as m)))
## [Functions]
+(def #export (const x y)
+ (All [a b] (-> a (-> b a)))
+ x)
+
(def #export (flip f)
(All [a b c]
(-> (-> a b c) (-> b a c)))
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 2c854a61c..3bce9ee77 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -14,7 +14,8 @@
macro
syntax)
(data (list #as l #refer (#only list list& List/Monad))
- (number (int #open ("i" Int/Number Int/Ord))))
+ (number (int #open ("i" Int/Number Int/Ord)))
+ bool)
(codata (lazy #as L #refer #all))))
## [Types]
diff --git a/source/lux/control/hash.lux b/source/lux/control/hash.lux
new file mode 100644
index 000000000..bfb8e99c0
--- /dev/null
+++ b/source/lux/control/hash.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 (Hash a)
+ (: (-> a Int)
+ hash))
diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux
index 5f4427a2c..92f5486ef 100644
--- a/source/lux/data/bool.lux
+++ b/source/lux/data/bool.lux
@@ -7,9 +7,10 @@
## 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))
+ (codata function)))
## [Structures]
(defstruct #export Bool/Eq (E;Eq Bool)
@@ -31,3 +32,8 @@
[ Or/Monoid false or]
[And/Monoid true and]
)
+
+## [Functions]
+(def #export complement
+ (All [a] (-> (-> a Bool) (-> a Bool)))
+ (. not))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 8d6296b14..2bbbe66cc 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -12,7 +12,8 @@
(monad #as M #refer #all)
(eq #as E)
(dict #as D #refer #all))
- (data/number (int #open ("i" Int/Number Int/Ord Int/Eq)))
+ (data (number (int #open ("i" Int/Number Int/Ord Int/Eq)))
+ bool)
meta/macro))
## Types
@@ -23,43 +24,6 @@
(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]
@@ -316,14 +280,35 @@
(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)]))))
+ (def (D;get k (#PList [eq kvs]))
+ (loop [kvs kvs]
+ (case kvs
+ #;Nil
+ #;None
+
+ (#;Cons [k' v'] kvs')
+ (if (:: eq (E;= k k'))
+ (#;Some v')
+ (recur kvs')))))
+
+ (def (D;put k v (#PList [eq kvs]))
+ (#PList [eq (loop [kvs kvs]
+ (case kvs
+ #;Nil
+ (#;Cons [k v] kvs)
+
+ (#;Cons [k' v'] kvs')
+ (if (:: eq (E;= k k'))
+ (#;Cons [k v] kvs')
+ (#;Cons [k' v'] (recur kvs')))))]))
+
+ (def (D;remove k (#PList [eq kvs]))
+ (#PList [eq (loop [kvs kvs]
+ (case kvs
+ #;Nil
+ kvs
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ kvs'
+ (#;Cons [[k' v'] (recur kvs')]))))])))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 13dcae284..66e4cc341 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -133,19 +133,39 @@
(M;wrap (:: List/Monad (M;join expansion'))))
#;None
+ (:: Lux/Monad (M;wrap (list syntax)))))
+
+ _
+ (:: Lux/Monad (M;wrap (list syntax)))))
+
+(def #export (macro-expand-all syntax)
+ (-> Syntax (Lux (List Syntax)))
+ (case syntax
+ (#;Meta [_ (#;FormS (#;Cons [(#;Meta [_ (#;SymbolS macro-name)]) args]))])
+ (do Lux/Monad
+ [macro-name' (normalize macro-name)
+ ?macro (find-macro macro-name')]
+ (case ?macro
+ (#;Some macro)
+ (do Lux/Monad
+ [expansion (macro args)
+ expansion' (M;map% Lux/Monad macro-expand-all expansion)]
+ (M;wrap (:: List/Monad (M;join expansion'))))
+
+ #;None
(do Lux/Monad
- [parts' (M;map% Lux/Monad macro-expand (list& (symbol$ macro-name) args))]
+ [parts' (M;map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))]
(M;wrap (list (form$ (:: List/Monad (M;join parts'))))))))
(#;Meta [_ (#;FormS (#;Cons [harg targs]))])
(do Lux/Monad
- [harg+ (macro-expand harg)
- targs+ (M;map% Lux/Monad macro-expand targs)]
+ [harg+ (macro-expand-all harg)
+ targs+ (M;map% Lux/Monad macro-expand-all targs)]
(M;wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List Syntax)) targs+))))))))
(#;Meta [_ (#;TupleS members)])
(do Lux/Monad
- [members' (M;map% Lux/Monad macro-expand members)]
+ [members' (M;map% Lux/Monad macro-expand-all members)]
(M;wrap (list (tuple$ (:: List/Monad (M;join members'))))))
_
@@ -234,7 +254,7 @@
(case state
{#;source source #;modules modules
#;envs envs #;types types #;host host
- #;seed seed #;eval? eval?}
+ #;seed seed #;eval? eval? #;expected expected}
(some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
(lambda [env]
(case env
@@ -254,7 +274,7 @@
(let [[v-prefix v-name] name
{#;source source #;modules modules
#;envs envs #;types types #;host host
- #;seed seed #;eval? eval?} state]
+ #;seed seed #;eval? eval? #;expected expected} state]
(case (get v-prefix modules)
#;None
#;None
@@ -289,6 +309,6 @@
_
(let [{#;source source #;modules modules
#;envs envs #;types types #;host host
- #;seed seed #;eval? eval?} state]
+ #;seed seed #;eval? eval? #;expected expected} state]
(#;Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs))))))))
))
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-03 17:23:15 +0000