aboutsummaryrefslogtreecommitdiff
path: root/source/lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux')
-rw-r--r--source/lux/codata/lazy.lux11
-rw-r--r--source/lux/codata/stream.lux2
-rw-r--r--source/lux/control/comonad.lux8
-rw-r--r--source/lux/control/monad.lux2
-rw-r--r--source/lux/data/io.lux15
-rw-r--r--source/lux/data/list.lux6
-rw-r--r--source/lux/data/maybe.lux3
-rw-r--r--source/lux/data/text.lux5
-rw-r--r--source/lux/host/jvm.lux20
-rw-r--r--source/lux/meta/ast.lux46
-rw-r--r--source/lux/meta/lux.lux13
-rw-r--r--source/lux/meta/macro.lux35
-rw-r--r--source/lux/meta/syntax.lux25
13 files changed, 110 insertions, 81 deletions
diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux
index 94968de20..dbb1c13ad 100644
--- a/source/lux/codata/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -7,18 +7,19 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (meta macro)
+ (lux (meta macro
+ ast)
(control (functor #as F #refer #all)
(monad #as M #refer #all))
(data list))
(.. function))
-## Types
+## [Types]
(deftype #export (Lazy a)
(All [b]
(-> (-> a b) b)))
-## Syntax
+## [Syntax]
(defmacro #export (... tokens state)
(case tokens
(\ (list value))
@@ -28,13 +29,13 @@
_
(#;Left "Wrong syntax for ...")))
-## Functions
+## [Functions]
(def #export (! thunk)
(All [a]
(-> (Lazy a) a))
(thunk id))
-## Structs
+## [Structs]
(defstruct #export Lazy/Functor (Functor Lazy)
(def (F;map f ma)
(lambda [k] (ma (. k f)))))
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 3bce9ee77..251d77815 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -128,7 +128,7 @@
(do Lux/Monad
[patterns (map% Lux/Monad macro-expand-1 patterns')
g!s (gensym "s")
- #let [patterns+ (: (List Syntax)
+ #let [patterns+ (: (List AST)
(do List/Monad
[pattern (l;reverse patterns)]
(list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s))))))]]
diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux
index a1168a3cd..e82d079f6 100644
--- a/source/lux/control/comonad.lux
+++ b/source/lux/control/comonad.lux
@@ -11,7 +11,7 @@
lux/data/list
lux/meta/macro)
-## Signatures
+## [Signatures]
(defsig #export (CoMonad w)
(: (F;Functor w)
_functor)
@@ -22,18 +22,18 @@
(-> (w a) (w (w a))))
split))
-## Functions
+## [Functions]
(def #export (extend w f ma)
(All [w a b]
(-> (CoMonad w) (-> (w a) b) (w a) (w b)))
(using w
(map f (split ma))))
-## Syntax
+## [Syntax]
(defmacro #export (be tokens state)
(case tokens
(\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
- (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (let [body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index 4e4786b63..53ab7301b 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -54,7 +54,7 @@
(case tokens
## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
(#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
- (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (let [body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
index e5b265959..f03dbddc6 100644
--- a/source/lux/data/io.lux
+++ b/source/lux/data/io.lux
@@ -7,17 +7,18 @@
## 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 (meta macro
+ ast)
+ (control (functor #as F)
+ (monad #as M)))
(.. list
(text #as T #open ("text:" Text/Monoid))))
-## Types
+## [Types]
(deftype #export (IO a)
(-> (,) a))
-## Syntax
+## [Syntax]
(defmacro #export (io tokens state)
(case tokens
(\ (list value))
@@ -27,7 +28,7 @@
_
(#;Left "Wrong syntax for io")))
-## Structures
+## [Structures]
(defstruct #export IO/Functor (F;Functor IO)
(def (F;map f ma)
(io (f (ma [])))))
@@ -41,7 +42,7 @@
(def (M;join mma)
(mma [])))
-## Functions
+## [Functions]
(def #export (print x)
(-> Text (IO (,)))
(io (_jvm_invokevirtual "java.io.PrintStream" "print" ["java.lang.Object"]
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 1b1711ca7..5b579e243 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -17,7 +17,7 @@
bool)
meta/macro))
-## Types
+## [Types]
## (deftype (List a)
## (| #Nil
## (#Cons (, a (List a)))))
@@ -225,7 +225,7 @@
(#;Some x)
(@ (i+ -1 i) xs'))))
-## Syntax
+## [Syntax]
(defmacro #export (list xs state)
(#;Right [state (#;Cons [(foldL (lambda [tail head]
(` (#;Cons [(~ head) (~ tail)])))
@@ -244,7 +244,7 @@
_
(#;Left "Wrong syntax for list&")))
-## Structures
+## [Structures]
## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a))))
## (def (E;= xs ys)
## (case [xs ys]
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index a6019e256..bba85daf7 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -7,7 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (meta macro)
+ (lux (meta macro
+ ast)
(control (monoid #as m #refer #all)
(functor #as F #refer #all)
(monad #as M #refer #all)))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index d0a6c46d1..3f6f5d085 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -7,7 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (meta macro)
+ (lux (meta macro
+ ast)
(control (monoid #as m)
(eq #as E)
(ord #as O)
@@ -157,7 +158,7 @@
(M;wrap [pre var post])))
(def (unravel-template template)
- (-> Text (List Syntax))
+ (-> Text (List AST))
(case (extract-var template)
(#;Some [pre var post])
(list& (text$ pre) (symbol$ ["" var])
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 2c90b1ba3..f136bd73b 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -14,20 +14,20 @@
(text #as text)
(number (int #open ("i" Int/Eq))))
(meta lux
- macro
+ ast
syntax)))
## [Utils]
## Parsers
(def finally^
- (Parser Syntax)
+ (Parser AST)
(form^ (do Parser/Monad
[_ (symbol?^ ["" "finally"])
expr id^]
(M;wrap expr))))
(def catch^
- (Parser (, Text Ident Syntax))
+ (Parser (, Text Ident AST))
(form^ (do Parser/Monad
[_ (symbol?^ ["" "catch"])
ex-class local-symbol^
@@ -60,7 +60,7 @@
(M;wrap [arg-name arg-class]))))
(def method-def^
- (Parser (, (List Text) Text (List (, Text Text)) Text Syntax))
+ (Parser (, (List Text) Text (List (, Text Text)) Text AST))
(form^ (do Parser/Monad
[modifiers (*^ local-tag^)
name local-symbol^
@@ -70,7 +70,7 @@
(M;wrap [modifiers name inputs output body]))))
(def method-call^
- (Parser (, Text (List Text) (List Syntax)))
+ (Parser (, Text (List Text) (List AST)))
(form^ (do Parser/Monad
[method local-symbol^
arity-classes (tuple^ (*^ local-symbol^))
@@ -89,7 +89,7 @@
(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)])
(emit (list (` (_jvm_try (~ body)
- (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident Syntax) Syntax)
+ (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
(lambda [catch]
(let [[class ex body] catch]
(` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
@@ -102,7 +102,7 @@
(list (` (_jvm_finally (~ finally)))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
- (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax)
+ (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST)
(lambda [member]
(let [[modifiers name inputs output] member]
(` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
@@ -115,18 +115,18 @@
[methods (*^ method-def^)])
(do Lux/Monad
[current-module get-module-name
- #let [fields' (map (: (-> (, (List Text) Text Text) Syntax)
+ #let [fields' (map (: (-> (, (List Text) Text Text) AST)
(lambda [field]
(let [[modifiers name class] field]
(` ((~ (text$ name))
(~ (text$ class))
[(~@ (map text$ modifiers))])))))
fields)
- methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax)
+ methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text AST) AST)
(lambda [methods]
(let [[modifiers name inputs output body] methods]
(` ((~ (text$ name))
- [(~@ (map (: (-> (, Text Text) Syntax)
+ [(~@ (map (: (-> (, Text Text) AST)
(lambda [in]
(let [[left right] in]
(form$ (list (symbol$ ["" left])
diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux
new file mode 100644
index 000000000..f01f08af1
--- /dev/null
+++ b/source/lux/meta/ast.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)
+
+## [Types]
+## (deftype (AST' w)
+## (| (#;BoolS Bool)
+## (#;IntS Int)
+## (#;RealS Real)
+## (#;CharS Char)
+## (#;TextS Text)
+## (#;SymbolS Text Text)
+## (#;TagS Text Text)
+## (#;FormS (List (w (AST' w))))
+## (#;TupleS (List (w (AST' w))))
+## (#;RecordS (List (, (w (AST' w)) (w (AST' w)))))))
+
+## (deftype AST
+## (Meta Cursor (AST' (Meta Cursor))))
+
+## [Utils]
+(def _cursor Cursor ["" -1 -1])
+
+## [Functions]
+(do-template [<name> <type> <tag>]
+ [(def #export (<name> x)
+ (-> <type> AST)
+ (#;Meta _cursor (<tag> x)))]
+
+ [bool$ Bool #;BoolS]
+ [int$ Int #;IntS]
+ [real$ Real #;RealS]
+ [char$ Char #;CharS]
+ [text$ Text #;TextS]
+ [symbol$ Ident #;SymbolS]
+ [tag$ Ident #;TagS]
+ [form$ (List AST) #;FormS]
+ [tuple$ (List AST) #;TupleS]
+ [record$ (List (, AST AST)) #;RecordS]
+ )
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index e1d821ff0..bc859b823 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -7,7 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (.. macro)
+ (.. macro
+ ast)
(lux/control (monoid #as m)
(functor #as F)
(monad #as M #refer (#only do))
@@ -119,7 +120,7 @@
(:: Lux/Monad (M;wrap ident))))
(def #export (macro-expand syntax)
- (-> Syntax (Lux (List Syntax)))
+ (-> AST (Lux (List AST)))
(case syntax
(#;Meta [_ (#;FormS (#;Cons [(#;Meta [_ (#;SymbolS macro-name)]) args]))])
(do Lux/Monad
@@ -139,7 +140,7 @@
(:: Lux/Monad (M;wrap (list syntax)))))
(def #export (macro-expand-all syntax)
- (-> Syntax (Lux (List Syntax)))
+ (-> AST (Lux (List AST)))
(case syntax
(#;Meta [_ (#;FormS (#;Cons [(#;Meta [_ (#;SymbolS macro-name)]) args]))])
(do Lux/Monad
@@ -161,7 +162,7 @@
(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 Syntax)) targs+))))))))
+ (M;wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
(#;Meta [_ (#;TupleS members)])
(do Lux/Monad
@@ -172,7 +173,7 @@
(:: Lux/Monad (M;wrap (list syntax)))))
(def #export (gensym prefix state)
- (-> Text (Lux Syntax))
+ (-> Text (Lux AST))
(#;Right [(update@ #;seed (i+ 1) state)
(symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])]))
@@ -189,7 +190,7 @@
(#;Left msg)))
(def #export (macro-expand-1 token)
- (-> Syntax (Lux Syntax))
+ (-> AST (Lux AST))
(do Lux/Monad
[token+ (macro-expand token)]
(case token+
diff --git a/source/lux/meta/macro.lux b/source/lux/meta/macro.lux
index 22aeaf874..15f3582fa 100644
--- a/source/lux/meta/macro.lux
+++ b/source/lux/meta/macro.lux
@@ -8,47 +8,24 @@
(;import lux)
-## [Utils]
-(def (_meta x)
- (-> (Syntax' (Meta Cursor)) Syntax)
- (#;Meta [["" -1 -1] x]))
-
## [Syntax]
(def #export (defmacro tokens state)
Macro
(case tokens
(#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])
- (#;Right [state (#;Cons [(` ((~ (_meta (#;SymbolS ["lux" "def"]))) ((~ name) (~@ args))
- (~ (_meta (#;SymbolS ["lux" "Macro"])))
+ (#;Right [state (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "def"]))) ((~ name) (~@ args))
+ (~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "Macro"])))
(~ body)))
- (#;Cons [(` ((~ (_meta (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
+ (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
#;Nil])])])
(#;Cons [(#;Meta [_ (#;TagS ["" "export"])]) (#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])])
- (#;Right [state (#;Cons [(` ((~ (_meta (#;SymbolS ["lux" "def"]))) (~ (_meta (#;TagS ["" "export"]))) ((~ name) (~@ args))
- (~ (_meta (#;SymbolS ["lux" "Macro"])))
+ (#;Right [state (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "def"]))) (~ (#;Meta ["" -1 -1] (#;TagS ["" "export"]))) ((~ name) (~@ args))
+ (~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "Macro"])))
(~ body)))
- (#;Cons [(` ((~ (_meta (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
+ (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
#;Nil])])])
_
(#;Left "Wrong syntax for defmacro")))
(_lux_declare-macro defmacro)
-
-## [Functions]
-(do-template [<name> <type> <tag>]
- [(def #export (<name> x)
- (-> <type> Syntax)
- (#;Meta [["" -1 -1] (<tag> x)]))]
-
- [bool$ Bool #;BoolS]
- [int$ Int #;IntS]
- [real$ Real #;RealS]
- [char$ Char #;CharS]
- [text$ Text #;TextS]
- [symbol$ Ident #;SymbolS]
- [tag$ Ident #;TagS]
- [form$ (List Syntax) #;FormS]
- [tuple$ (List Syntax) #;TupleS]
- [record$ (List (, Syntax Syntax)) #;RecordS]
- )
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 972999fcb..beb2c9e7a 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -8,6 +8,7 @@
(;import lux
(.. (macro #as m #refer #all)
+ ast
(lux #as l #refer (#only Lux/Monad gensym)))
(lux (control (functor #as F)
(monad #as M #refer (#only do))
@@ -31,11 +32,11 @@
#;Nil #;Nil
(#;Cons [[x y] pairs']) (list& x y (join-pairs pairs'))))
-## Types
+## [Types]
(deftype #export (Parser a)
- (-> (List Syntax) (Maybe (, (List Syntax) a))))
+ (-> (List AST) (Maybe (, (List AST) a))))
-## Structures
+## [Structures]
(defstruct #export Parser/Functor (F;Functor Parser)
(def (F;map f ma)
(lambda [tokens]
@@ -61,9 +62,9 @@
(#;Some [tokens' ma])
(ma tokens')))))
-## Parsers
+## [Parsers]
(def #export (id^ tokens)
- (Parser Syntax)
+ (Parser AST)
(case tokens
#;Nil #;None
(#;Cons [t tokens']) (#;Some [tokens' t])))
@@ -155,7 +156,7 @@
(def (run-parser p tokens)
(All [a]
- (-> (Parser a) (List Syntax) (Maybe (, (List Syntax) a))))
+ (-> (Parser a) (List AST) (Maybe (, (List AST) a))))
(p tokens))
(def #export (*^ p tokens)
@@ -210,9 +211,9 @@
#;Nil (#;Some [tokens []])
_ #;None))
-## Syntax
+## [Syntax]
(defmacro #export (defsyntax tokens)
- (let [[exported? tokens] (: (, Bool (List Syntax))
+ (let [[exported? tokens] (: (, Bool (List AST))
(case tokens
(\ (list& (#;Meta [_ (#;TagS ["" "export"])]) tokens'))
[true tokens']
@@ -224,7 +225,7 @@
body))
(do Lux/Monad
[names+parsers (M;map% Lux/Monad
- (: (-> Syntax (Lux (, Syntax Syntax)))
+ (: (-> AST (Lux (, AST AST)))
(lambda [arg]
(case arg
(\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
@@ -241,7 +242,7 @@
g!_ (gensym "_")
#let [names (:: List/Functor (F;map first names+parsers))
error-msg (text$ (text:++ "Wrong syntax for " name))
- body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body name+parser]
(let [[name parser] name+parser]
(` (_lux_case ((~ parser) (~ g!tokens))
@@ -251,8 +252,8 @@
(~ g!_)
(l;fail (~ error-msg)))))))
body
- (: (List (, Syntax Syntax)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
- macro-def (: Syntax
+ (: (List (, AST AST)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
+ macro-def (: AST
(` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
(M;wrap (list& macro-def
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-13 12:35:29 +0000