aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux4
-rw-r--r--source/lux/codata/stream.lux31
-rw-r--r--source/lux/control/comonad.lux19
-rw-r--r--source/lux/control/monad.lux5
-rw-r--r--source/lux/control/ord.lux8
-rw-r--r--source/lux/data/list.lux4
-rw-r--r--source/lux/data/number/int.lux8
-rw-r--r--source/lux/data/number/real.lux8
-rw-r--r--source/lux/data/text.lux2
-rw-r--r--source/lux/data/writer.lux4
-rw-r--r--source/lux/meta/ast.lux10
-rw-r--r--source/lux/meta/lux.lux20
-rw-r--r--source/lux/meta/syntax.lux6
-rw-r--r--src/lux/analyser/case.clj2
14 files changed, 71 insertions, 60 deletions
diff --git a/source/lux.lux b/source/lux.lux
index e155af794..7d00cd077 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -3049,10 +3049,10 @@
(lambda [so-far part]
(case part
[_ (#SymbolS slot)]
- (return (` (get@ (~ (tag$ slot)) (~ so-far))))
+ (return (` (using (~ so-far) (~ (symbol$ slot)))))
(\ [_ (#FormS (@list& [_ (#SymbolS slot)] args))])
- (return (` ((get@ (~ (tag$ slot)) (~ so-far))
+ (return (` ((using (~ so-far) (~ (symbol$ slot)))
(~@ args))))
_
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 96de64fd4..1306e3d8b 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -9,11 +9,13 @@
(comonad #as CM #refer #all))
(meta lux
syntax)
- (data (list #as l #refer (#only @list @list& List/Monad))
+ (data (list #as l #refer (#only @list @list& List/Monad) #open ("" List/Fold))
(number (int #open ("i" Int/Number Int/Ord)))
bool)
(codata (lazy #as L #refer #all))))
+(open List/Monad "list:")
+
## [Types]
(deftype #export (Stream a)
(Lazy (, a (Stream a))))
@@ -117,15 +119,22 @@
(def _functor Stream/Functor)
(def unwrap head)
(def (split wa)
- (:: Stream/Functor (F;map repeat wa))))
+ (let [[head tail] (! wa)]
+ (... [wa (split tail)]))))
## [Pattern-matching]
-(defsyntax #export (\stream body [patterns' (+^ id^)])
- (do Lux/Monad
- [patterns (map% Lux/Monad macro-expand-1 patterns')
- g!s (gensym "s")
- #let [patterns+ (: (List AST)
- (do List/Monad
- [pattern (l;reverse patterns)]
- (: (List AST) (@list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))))]]
- (wrap (@list g!s (` (;let [(~@ patterns+)] (~ body)))))))
+(defsyntax #export (\stream body [patterns (+^ id^)])
+ (case (l;reverse patterns)
+ (\ (@list& last prevs))
+ (do Lux/Monad
+ [prevs (map% Lux/Monad macro-expand-1 prevs)
+ g!s (gensym "s")
+ body+ (foldL (lambda [inner outer]
+ (` (let [[(~ outer) (~ g!s)] (! (~ g!s))]
+ (~ inner))))
+ (` (let [(~ last) (~ g!s)] (~ body)))
+ prevs)]
+ (wrap (@list g!s body+)))
+
+ _
+ (fail "Wrong syntax for \\stream")))
diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux
index 7ea3b58a9..2543f34da 100644
--- a/source/lux/control/comonad.lux
+++ b/source/lux/control/comonad.lux
@@ -28,22 +28,25 @@
## [Syntax]
(defmacro #export (be tokens state)
(case tokens
- (\ (@list comonad [_ (#;TupleS bindings)] body))
- (let [body' (foldL (: (-> AST (, AST AST) AST)
+ (#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil)))
+ (let [g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])])
+ g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])])
+ body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
[_ (#;TagS ["" "let"])]
- (` (;let (~ value) (~ body')))
+ (` (let (~ value) (~ body')))
_
- (` (extend (;lambda [(~ var)] (~ body'))
- (~ value)))))))
+ (` (|> (~ value) (~ g!split) ((~ g!map) (lambda [(~ var)] (~ body')))))
+ ))))
body
(reverse (as-pairs bindings)))]
- (#;Right [state (@list (` (;case (~ comonad)
- {#;return ;return #;bind ;bind}
- (~ body'))))]))
+ (#;Right [state (#;Cons (` (case (~ comonad)
+ {#_functor {#F;map (~ g!map)} #unwrap (~ (' unwrap)) #split (~ g!split)}
+ (~ body')))
+ #;Nil)]))
_
(#;Left "Wrong syntax for be")))
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index 0c7827c34..e5c5989cf 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -83,7 +83,7 @@
(-> (Monad M) (List (M a)) (M (List a))))
(case xs
#;Nil
- (:: monad (;;wrap #;Nil))
+ (:: monad (wrap #;Nil))
(#;Cons x xs')
(do monad
@@ -95,10 +95,9 @@
(def #export (map% monad f xs)
(All [M a b]
(-> (Monad M) (-> a (M b)) (List a) (M (List b))))
- ## (seq% monad (:: monad ;;_functor (F;map f xs)))
(case xs
#;Nil
- (:: monad (;;wrap #;Nil))
+ (:: monad (wrap #;Nil))
(#;Cons x xs')
(do monad
diff --git a/source/lux/control/ord.lux b/source/lux/control/ord.lux
index 987356d22..cb77e7042 100644
--- a/source/lux/control/ord.lux
+++ b/source/lux/control/ord.lux
@@ -24,11 +24,11 @@
(def < <)
(def (<= x y)
(or (< x y)
- (:: eq (E;= x y))))
+ (:: eq (= x y))))
(def > >)
(def (>= x y)
(or (> x y)
- (:: eq (E;= x y))))))
+ (:: eq (= x y))))))
## [Functions]
(do-template [<name> <op>]
@@ -37,5 +37,5 @@
(-> (Ord a) a a a))
(if (:: ord (<op> x y)) x y))]
- [max ;;>]
- [min ;;<])
+ [max >]
+ [min <])
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index e538007bf..7b9d4a60b 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -242,7 +242,7 @@
true
[(#;Cons x xs') (#;Cons y ys')]
- (and (:: eq (E;= x y))
+ (and (:: eq (= x y))
(= xs' ys'))
[_ _]
@@ -284,7 +284,7 @@
(using ord
(let [pre (filter (>= x) xs')
post (filter (< x) xs')
- ++ (:: List/Monoid m;++)]
+ ++ (:: List/Monoid ++)]
($ ++ (sort ord pre) (@list x) (sort ord post))))))
## [Syntax]
diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux
index ea58cac17..1e71b8a5a 100644
--- a/source/lux/data/number/int.lux
+++ b/source/lux/data/number/int.lux
@@ -60,8 +60,8 @@
## Enum
(defstruct #export Int/Enum (EN;Enum Int)
(def _ord Int/Ord)
- (def succ (lambda [n] (:: Int/Number (N;+ n 1))))
- (def pred (lambda [n] (:: Int/Number (N;- n 1)))))
+ (def succ (lambda [n] (:: Int/Number (+ n 1))))
+ (def pred (lambda [n] (:: Int/Number (- n 1)))))
## Bounded
(do-template [<name> <type> <top> <bottom>]
@@ -79,8 +79,8 @@
[ 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)]
+ [ IntMax/Monoid Int (:: Int/Bounded bottom) (O;max Int/Ord)]
+ [ IntMin/Monoid Int (:: Int/Bounded top) (O;min Int/Ord)]
)
## Show
diff --git a/source/lux/data/number/real.lux b/source/lux/data/number/real.lux
index 7301f2932..7d5243385 100644
--- a/source/lux/data/number/real.lux
+++ b/source/lux/data/number/real.lux
@@ -60,8 +60,8 @@
## Enum
(defstruct Real/Enum (EN;Enum Real)
(def _ord Real/Ord)
- (def succ (lambda [n] (:: Real/Number (N;+ n 1.0))))
- (def pred (lambda [n] (:: Real/Number (N;- n 1.0)))))
+ (def succ (lambda [n] (:: Real/Number (+ n 1.0))))
+ (def pred (lambda [n] (:: Real/Number (- n 1.0)))))
## Bounded
(do-template [<name> <type> <top> <bottom>]
@@ -79,8 +79,8 @@
[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)]
+ [RealMax/Monoid Real (:: Real/Bounded bottom) (O;max Real/Ord)]
+ [RealMin/Monoid Real (:: Real/Bounded top) (O;min Real/Ord)]
)
## Show
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index bbcb42d71..744a22f2e 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -174,7 +174,7 @@
(case tokens
(#;Cons [_ (#;TextS template)] #;Nil)
(let [++ (symbol$ ["" ""])]
- (#;Right state (#;Cons (` (;let [(~ ++) (;:: Text/Monoid m;++)]
+ (#;Right state (#;Cons (` (;let [(~ ++) (get@ #m;++ Text/Monoid)]
(;$ (~ ++) (~@ (unravel-template template)))))
#;Nil)))
diff --git a/source/lux/data/writer.lux b/source/lux/data/writer.lux
index bf26eac9a..3bf99c1ad 100644
--- a/source/lux/data/writer.lux
+++ b/source/lux/data/writer.lux
@@ -24,8 +24,8 @@
(def _functor Writer/Functor)
(def (wrap x)
- [(:: mon m;unit) x])
+ [(:: mon unit) x])
(def (join mma)
(let [[log1 [log2 a]] mma]
- [(:: mon (m;++ log1 log2)) a])))
+ [(:: mon (++ log1 log2)) a])))
diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux
index 6d9271847..a9bc8b588 100644
--- a/source/lux/meta/ast.lux
+++ b/source/lux/meta/ast.lux
@@ -58,7 +58,7 @@
(case ast
(\template [<tag> <struct>]
[[_ (<tag> value)]
- (:: <struct> (S;show value))])
+ (:: <struct> (show value))])
[[#;BoolS Bool/Show]
[#;IntS Int/Show]
[#;RealS Real/Show]
@@ -67,7 +67,7 @@
(\template [<tag> <prefix>]
[[_ (<tag> ident)]
- (text:++ <prefix> (:: Ident/Show (S;show ident)))])
+ (text:++ <prefix> (:: Ident/Show (show ident)))])
[[#;SymbolS ""] [#;TagS "#"]]
(\template [<tag> <open> <close>]
@@ -84,7 +84,7 @@
(case [x y]
(\template [<tag> <struct>]
[[[_ (<tag> x')] [_ (<tag> y')]]
- (:: <struct> (E;= x' y'))])
+ (:: <struct> (= x' y'))])
[[#;BoolS Bool/Eq]
[#;IntS Int/Eq]
[#;RealS Real/Eq]
@@ -95,7 +95,7 @@
(\template [<tag>]
[[[_ (<tag> xs')] [_ (<tag> ys')]]
- (and (:: Int/Eq (E;= (size xs') (size ys')))
+ (and (:: Int/Eq (= (size xs') (size ys')))
(foldL (lambda [old [x' y']]
(and old (= x' y')))
true
@@ -103,7 +103,7 @@
[[#;FormS] [#;TupleS]]
[[_ (#;RecordS xs')] [_ (#;RecordS ys')]]
- (and (:: Int/Eq (E;= (size xs') (size ys')))
+ (and (:: Int/Eq (= (size xs') (size ys')))
(foldL (lambda [old [[xl' xr'] [yl' yr']]]
(and old (= xl' yl') (= xr' yr')))
true
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 66f1a554b..b9e07083f 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -113,7 +113,7 @@
(wrap [module-name name]))
_
- (:: Lux/Monad (M;wrap ident))))
+ (:: Lux/Monad (wrap ident))))
(def #export (macro-expand syntax)
(-> AST (Lux (List AST)))
@@ -127,13 +127,13 @@
(do Lux/Monad
[expansion (macro args)
expansion' (M;map% Lux/Monad macro-expand expansion)]
- (wrap (:: List/Monad (M;join expansion'))))
+ (wrap (:: List/Monad (join expansion'))))
#;None
- (:: Lux/Monad (M;wrap (@list syntax)))))
+ (:: Lux/Monad (wrap (@list syntax)))))
_
- (:: Lux/Monad (M;wrap (@list syntax)))))
+ (:: Lux/Monad (wrap (@list syntax)))))
(def #export (macro-expand-all syntax)
(-> AST (Lux (List AST)))
@@ -147,31 +147,31 @@
(do Lux/Monad
[expansion (macro args)
expansion' (M;map% Lux/Monad macro-expand-all expansion)]
- (wrap (:: List/Monad (M;join expansion'))))
+ (wrap (:: List/Monad (join expansion'))))
#;None
(do Lux/Monad
[parts' (M;map% Lux/Monad macro-expand-all (@list& (symbol$ macro-name) args))]
- (wrap (@list (form$ (:: List/Monad (M;join parts'))))))))
+ (wrap (@list (form$ (:: List/Monad (join parts'))))))))
[_ (#;FormS (#;Cons [harg targs]))]
(do Lux/Monad
[harg+ (macro-expand-all harg)
targs+ (M;map% Lux/Monad macro-expand-all targs)]
- (wrap (@list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
+ (wrap (@list (form$ (list:++ harg+ (:: List/Monad (join (: (List (List AST)) targs+))))))))
[_ (#;TupleS members)]
(do Lux/Monad
[members' (M;map% Lux/Monad macro-expand-all members)]
- (wrap (@list (tuple$ (:: List/Monad (M;join members'))))))
+ (wrap (@list (tuple$ (:: List/Monad (join members'))))))
_
- (:: Lux/Monad (M;wrap (@list syntax)))))
+ (:: Lux/Monad (wrap (@list syntax)))))
(def #export (gensym prefix state)
(-> Text (Lux AST))
(#;Right [(update@ #;seed (i+ 1) state)
- (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (S;show (get@ #;seed state))))])]))
+ (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (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 d47780798..3b9149a74 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -128,11 +128,11 @@
_
(#;Some [tokens false])))]
- [ bool?^ Bool #;BoolS (:: b;Bool/Eq E;=)]
+ [ bool?^ Bool #;BoolS (:: b;Bool/Eq =)]
[ int?^ Int #;IntS i=]
[ real?^ Real #;RealS r=]
- [ char?^ Char #;CharS (:: c;Char/Eq E;=)]
- [ text?^ Text #;TextS (:: t;Text/Eq E;=)]
+ [ char?^ Char #;CharS (:: c;Char/Eq =)]
+ [ text?^ Text #;TextS (:: t;Text/Eq =)]
[symbol?^ Ident #;SymbolS ident:=]
[ tag?^ Ident #;TagS ident:=]
)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index c6806a627..325b6cdd8 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -113,7 +113,7 @@
(adjust-type* up ?type)
_
- (assert false (prn 'adjust-type* (&type/show-type type)))
+ (assert false (prn-str 'adjust-type* (&type/show-type type)))
))
(defn adjust-type [type]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 08:00:09 +0000