aboutsummaryrefslogtreecommitdiff
path: root/source/lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux')
-rw-r--r--source/lux/codata/stream.lux2
-rw-r--r--source/lux/control/monad.lux15
-rw-r--r--source/lux/data/text.lux2
-rw-r--r--source/lux/host/jvm.lux16
-rw-r--r--source/lux/meta/lux.lux16
-rw-r--r--source/lux/meta/syntax.lux20
6 files changed, 36 insertions, 35 deletions
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 871c50821..728adc174 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -132,4 +132,4 @@
(do List/Monad
[pattern (l;reverse patterns)]
(list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s))))))]]
- (M;wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))
+ (wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index 53ab7301b..c87c4fdc3 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -9,7 +9,8 @@
(;import lux
(.. (functor #as F)
(monoid #as M))
- lux/meta/macro)
+ (lux/meta macro
+ ast))
## [Utils]
(def (foldL f init xs)
@@ -54,7 +55,9 @@
(case tokens
## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
(#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
- (let [body' (foldL (: (-> AST (, AST AST) AST)
+ (let [g!map (symbol$ ["" " map "])
+ g!join (symbol$ ["" " join "])
+ body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
@@ -62,15 +65,13 @@
(` (;let (~ value) (~ body')))
_
- (` (;case ;;_functor
- {#F;map F;map}
- (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;;join))))
+ (` (;|> (~ value) ((~ g!map) (;lambda [(~ var)] (~ body'))) (~ g!join)))
## (` (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;:: ;;_functor) (;;join)))
))))
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons [(` (;case (~ monad)
- {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
+ {#;;_functor {#F;map (~ g!map)} #;;wrap (~ (' wrap)) #;;join (~ g!join)}
(~ body')))
#;Nil])]))
@@ -95,5 +96,5 @@
(do m
[y (f x)
ys (map% m f xs')]
- (;;wrap (#;Cons [y ys])))
+ (wrap (#;Cons [y ys])))
))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index f691be397..81a642698 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -155,7 +155,7 @@
post-idx (index-of "}" in)
[var post] (split post-idx in)
[_ post] (split 1 post)]
- (M;wrap [pre var post])))
+ (wrap [pre var post])))
(def (unravel-template template)
(-> Text (List AST))
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index f136bd73b..4f3d6df8a 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -24,7 +24,7 @@
(form^ (do Parser/Monad
[_ (symbol?^ ["" "finally"])
expr id^]
- (M;wrap expr))))
+ (wrap expr))))
(def catch^
(Parser (, Text Ident AST))
@@ -33,7 +33,7 @@
ex-class local-symbol^
ex symbol^
expr id^]
- (M;wrap [ex-class ex expr]))))
+ (wrap [ex-class ex expr]))))
(def method-decl^
(Parser (, (List Text) Text (List Text) Text))
@@ -42,7 +42,7 @@
name local-symbol^
inputs (tuple^ (*^ local-symbol^))
output local-symbol^]
- (M;wrap [modifiers name inputs output]))))
+ (wrap [modifiers name inputs output]))))
(def field-decl^
(Parser (, (List Text) Text Text))
@@ -50,14 +50,14 @@
[modifiers (*^ local-tag^)
name local-symbol^
class local-symbol^]
- (M;wrap [modifiers name class]))))
+ (wrap [modifiers name class]))))
(def arg-decl^
(Parser (, Text Text))
(form^ (do Parser/Monad
[arg-name local-symbol^
arg-class local-symbol^]
- (M;wrap [arg-name arg-class]))))
+ (wrap [arg-name arg-class]))))
(def method-def^
(Parser (, (List Text) Text (List (, Text Text)) Text AST))
@@ -67,7 +67,7 @@
inputs (tuple^ (*^ arg-decl^))
output local-symbol^
body id^]
- (M;wrap [modifiers name inputs output body]))))
+ (wrap [modifiers name inputs output body]))))
(def method-call^
(Parser (, Text (List Text) (List AST)))
@@ -78,9 +78,9 @@
_ (: (Parser (,))
(if (i= (size arity-classes)
(size arity-args))
- (M;wrap [])
+ (wrap [])
(lambda [_] #;None)))]
- (M;wrap [method arity-classes arity-args])
+ (wrap [method arity-classes arity-args])
)))
## [Syntax]
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 4d6c15bde..d1bc4e219 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -114,7 +114,7 @@
["" name]
(do Lux/Monad
[module-name get-module-name]
- (M;wrap (: Ident [module-name name])))
+ (wrap (: Ident [module-name name])))
_
(:: Lux/Monad (M;wrap ident))))
@@ -131,7 +131,7 @@
(do Lux/Monad
[expansion (macro args)
expansion' (M;map% Lux/Monad macro-expand expansion)]
- (M;wrap (:: List/Monad (M;join expansion'))))
+ (wrap (:: List/Monad (M;join expansion'))))
#;None
(:: Lux/Monad (M;wrap (list syntax)))))
@@ -151,23 +151,23 @@
(do Lux/Monad
[expansion (macro args)
expansion' (M;map% Lux/Monad macro-expand-all expansion)]
- (M;wrap (:: List/Monad (M;join expansion'))))
+ (wrap (:: List/Monad (M;join expansion'))))
#;None
(do Lux/Monad
[parts' (M;map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))]
- (M;wrap (list (form$ (:: List/Monad (M;join parts'))))))))
+ (wrap (list (form$ (:: List/Monad (M;join parts'))))))))
(#;Meta [_ (#;FormS (#;Cons [harg targs]))])
(do Lux/Monad
[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 AST)) targs+))))))))
+ (wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
(#;Meta [_ (#;TupleS members)])
(do Lux/Monad
[members' (M;map% Lux/Monad macro-expand-all members)]
- (M;wrap (list (tuple$ (:: List/Monad (M;join members'))))))
+ (wrap (list (tuple$ (:: List/Monad (M;join members'))))))
_
(:: Lux/Monad (M;wrap (list syntax)))))
@@ -175,7 +175,7 @@
(def #export (gensym prefix state)
(-> Text (Lux AST))
(#;Right [(update@ #;seed (i+ 1) state)
- (symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])]))
+ (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (S;show (get@ #;seed state))))])]))
(def #export (emit datum)
(All [a]
@@ -195,7 +195,7 @@
[token+ (macro-expand token)]
(case token+
(\ (list token'))
- (M;wrap token')
+ (wrap token')
_
(fail "Macro expanded to more than 1 element."))))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index a69a89cb3..f1644cdb5 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -166,7 +166,7 @@
#;None (#;Some [tokens (list)])
(#;Some [tokens' x]) (run-parser (do Parser/Monad
[xs (*^ p)]
- (M;wrap (list& x xs)))
+ (wrap (list& x xs)))
tokens')))
(def #export (+^ p)
@@ -175,7 +175,7 @@
(do Parser/Monad
[x p
xs (*^ p)]
- (M;wrap (list& x xs))))
+ (wrap (list& x xs))))
(def #export (&^ p1 p2)
(All [a b]
@@ -183,7 +183,7 @@
(do Parser/Monad
[x1 p1
x2 p2]
- (M;wrap [x1 x2])))
+ (wrap [x1 x2])))
(def #export (|^ p1 p2 tokens)
(All [a b]
@@ -192,7 +192,7 @@
(#;Some [tokens' x1]) (#;Some [tokens' (#;Left x1)])
#;None (run-parser (do Parser/Monad
[x2 p2]
- (M;wrap (#;Right x2)))
+ (wrap (#;Right x2)))
tokens)))
(def #export (||^ ps tokens)
@@ -230,10 +230,10 @@
(case arg
(\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
parser))]))
- (M;wrap [(symbol$ var-name) parser])
+ (wrap [(symbol$ var-name) parser])
(\ (#;Meta [_ (#;SymbolS var-name)]))
- (M;wrap [(symbol$ var-name) (` id^)])
+ (wrap [(symbol$ var-name) (` id^)])
_
(l;fail "Syntax pattern expects 2-tuples or symbols."))))
@@ -256,10 +256,10 @@
macro-def (: AST
(` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
- (M;wrap (list& macro-def
- (if exported?
- (list (` (_lux_export (~ (symbol$ ["" name])))))
- (list)))))
+ (wrap (list& macro-def
+ (if exported?
+ (list (` (_lux_export (~ (symbol$ ["" name])))))
+ (list)))))
_
(l;fail "Wrong syntax for defsyntax"))))
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-13 12:57:40 +0000