aboutsummaryrefslogtreecommitdiff
path: root/source/lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux')
-rw-r--r--source/lux/control/monad.lux6
-rw-r--r--source/lux/data/id.lux13
-rw-r--r--source/lux/data/list.lux51
-rw-r--r--source/lux/meta/ast.lux2
-rw-r--r--source/lux/meta/macro.lux16
-rw-r--r--source/lux/meta/syntax.lux18
6 files changed, 54 insertions, 52 deletions
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index 8a7974e8b..c87c4fdc3 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -53,15 +53,15 @@
## [Syntax]
(defmacro #export (do tokens state)
(case tokens
- ## (\ (list monad [_ (#;TupleS bindings)] body))
- (#;Cons [monad (#;Cons [[_ (#;TupleS bindings)] (#;Cons [body #;Nil])])])
+ ## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
+ (#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
(let [g!map (symbol$ ["" " map "])
g!join (symbol$ ["" " join "])
body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
- [_ (#;TagS ["" "let"])]
+ (#;Meta [_ (#;TagS ["" "let"])])
(` (;let (~ value) (~ body')))
_
diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux
index d8bb30a3d..3ad6b056b 100644
--- a/source/lux/data/id.lux
+++ b/source/lux/data/id.lux
@@ -13,19 +13,20 @@
## [Types]
(deftype #export (Id a)
- a)
+ (| (#Id a)))
## [Structures]
(defstruct #export Id/Functor (Functor Id)
(def (F;map f fa)
- (f fa)))
+ (let [(#Id a) fa]
+ (#Id (f a)))))
(defstruct #export Id/Monad (Monad Id)
(def M;_functor Id/Functor)
- (def M;wrap id)
- (def M;join id))
+ (def (M;wrap a) (#Id a))
+ (def (M;join mma) (let [(#Id ma) mma] ma)))
(defstruct #export Id/CoMonad (CoMonad Id)
(def CM;_functor Id/Functor)
- (def CM;unwrap id)
- (def CM;split id))
+ (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 97333f570..5a8357251 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -23,13 +23,13 @@
## (#Cons (, a (List a)))))
(deftype #export (PList k v)
- (, (E;Eq k) (List (, k v))))
+ (| (#PList (, (E;Eq k) (List (, k v))))))
## [Constructors]
(def #export (plist eq)
(All [k v]
(-> (E;Eq k) (PList k v)))
- [eq #;Nil])
+ (#PList [eq #;Nil]))
## [Functions]
(def #export (foldL f init xs)
@@ -252,7 +252,8 @@
## true
## [(#;Cons [x xs']) (#;Cons [y ys'])]
-## (and (:: eq (E;= x y)) (= xs' ys'))
+## (and (:: eq (E;= x y))
+## (E;= xs' ys'))
## )))
(defstruct #export List/Monoid (All [a]
@@ -280,7 +281,7 @@
(foldL ++ unit mma))))
(defstruct #export PList/Dict (Dict PList)
- (def (D;get k [eq kvs])
+ (def (D;get k (#PList [eq kvs]))
(loop [kvs kvs]
(case kvs
#;Nil
@@ -291,27 +292,27 @@
(#;Some v')
(recur kvs')))))
- (def (D;put k v [eq kvs])
- [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 [eq kvs])
- [eq (loop [kvs kvs]
- (case kvs
- #;Nil
- kvs
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- kvs'
- (#;Cons [[k' 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')]))))])))
(defstruct #export List/Stack (S;Stack List)
(def S;empty (list))
diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux
index 3d2f30db2..f01f08af1 100644
--- a/source/lux/meta/ast.lux
+++ b/source/lux/meta/ast.lux
@@ -31,7 +31,7 @@
(do-template [<name> <type> <tag>]
[(def #export (<name> x)
(-> <type> AST)
- [_cursor (<tag> x)])]
+ (#;Meta _cursor (<tag> x)))]
[bool$ Bool #;BoolS]
[int$ Int #;IntS]
diff --git a/source/lux/meta/macro.lux b/source/lux/meta/macro.lux
index e6963b3d6..15f3582fa 100644
--- a/source/lux/meta/macro.lux
+++ b/source/lux/meta/macro.lux
@@ -12,18 +12,18 @@
(def #export (defmacro tokens state)
Macro
(case tokens
- (#;Cons [[_ (#;FormS (#;Cons [name args]))] (#;Cons [body #;Nil])])
- (#;Right [state (#;Cons [(` ((~ [["" -1 -1] (#;SymbolS ["lux" "def"])]) ((~ name) (~@ args))
- (~ [["" -1 -1] (#;SymbolS ["lux" "Macro"])])
+ (#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])
+ (#;Right [state (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "def"]))) ((~ name) (~@ args))
+ (~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "Macro"])))
(~ body)))
- (#;Cons [(` ((~ [["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"])]) (~ name)))
+ (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
#;Nil])])])
- (#;Cons [[_ (#;TagS ["" "export"])] (#;Cons [[_ (#;FormS (#;Cons [name args]))] (#;Cons [body #;Nil])])])
- (#;Right [state (#;Cons [(` ((~ [["" -1 -1] (#;SymbolS ["lux" "def"])]) (~ [["" -1 -1] (#;TagS ["" "export"])]) ((~ name) (~@ args))
- (~ [["" -1 -1] (#;SymbolS ["lux" "Macro"])])
+ (#;Cons [(#;Meta [_ (#;TagS ["" "export"])]) (#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])])
+ (#;Right [state (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "def"]))) (~ (#;Meta ["" -1 -1] (#;TagS ["" "export"]))) ((~ name) (~@ args))
+ (~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "Macro"])))
(~ body)))
- (#;Cons [(` ((~ [["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"])]) (~ name)))
+ (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
#;Nil])])])
_
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index db6a5774a..b9834f972 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -73,7 +73,7 @@
[(def #export (<name> tokens)
(Parser <type>)
(case tokens
- (#;Cons [[_ (<tag> x)] tokens'])
+ (#;Cons [(#;Meta [_ (<tag> x)]) tokens'])
(#;Some [tokens' x])
_
@@ -92,7 +92,7 @@
[(def #export (<name> tokens)
(Parser Text)
(case tokens
- (#;Cons [[_ (<tag> ["" x])] tokens'])
+ (#;Cons [(#;Meta [_ (<tag> ["" x])]) tokens'])
(#;Some [tokens' x])
_
@@ -113,7 +113,7 @@
[(def #export (<name> v tokens)
(-> <type> (Parser (,)))
(case tokens
- (#;Cons [[_ (<tag> x)] tokens'])
+ (#;Cons [(#;Meta [_ (<tag> x)]) tokens'])
(if (<eq> v x)
(#;Some [tokens' []])
#;None)
@@ -135,7 +135,7 @@
(All [a]
(-> (Parser a) (Parser a)))
(case tokens
- (#;Cons [[_ (<tag> form)] tokens'])
+ (#;Cons [(#;Meta [_ (<tag> form)]) tokens'])
(case (p form)
(#;Some [#;Nil x]) (#;Some [tokens' x])
_ #;None)
@@ -215,24 +215,24 @@
(defmacro #export (defsyntax tokens)
(let [[exported? tokens] (: (, Bool (List AST))
(case tokens
- (\ (list& [_ (#;TagS ["" "export"])] tokens'))
+ (\ (list& (#;Meta [_ (#;TagS ["" "export"])]) tokens'))
[true tokens']
_
[false tokens]))]
(case tokens
- (\ (list [_ (#;FormS (list& [_ (#;SymbolS ["" name])] args))]
+ (\ (list (#;Meta [_ (#;FormS (list& (#;Meta [_ (#;SymbolS ["" name])]) args))])
body))
(do Lux/Monad
[names+parsers (M;map% Lux/Monad
(: (-> AST (Lux (, AST AST)))
(lambda [arg]
(case arg
- (\ [_ (#;TupleS (list [_ (#;SymbolS var-name)]
- parser))])
+ (\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
+ parser))]))
(wrap [(symbol$ var-name) parser])
- (\ [_ (#;SymbolS var-name)])
+ (\ (#;Meta [_ (#;SymbolS var-name)]))
(wrap [(symbol$ var-name) (` id^)])
_
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 20:40:04 +0000