aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/concurrency/actor.lux20
-rw-r--r--stdlib/source/lux/control/effect.lux26
-rw-r--r--stdlib/source/lux/control/exception.lux4
-rw-r--r--stdlib/source/lux/data/coll/ordered.lux3
-rw-r--r--stdlib/source/lux/host.jvm.lux70
-rw-r--r--stdlib/source/lux/macro/poly.lux8
-rw-r--r--stdlib/source/lux/macro/syntax.lux15
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux131
-rw-r--r--stdlib/source/lux/math.lux2
-rw-r--r--stdlib/source/lux/test.lux4
-rw-r--r--stdlib/test/test/lux/macro/syntax.lux6
11 files changed, 155 insertions, 134 deletions
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index de1c9d745..e9a6b5d37 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -149,11 +149,11 @@
(def: method^
(Syntax Method)
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' method:))
+ [_ (s;this (' method:))
vars (s;default (list) (s;tuple (s;some s;local-symbol)))
[name args] (s;form ($_ s;seq
s;local-symbol
- (s;many common;typed-arg)
+ (s;many common;typed-input)
))
return s;any
body s;any]
@@ -166,13 +166,13 @@
(def: stop^
(Syntax Code)
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' stop:))]
+ [_ (s;this (' stop:))]
s;any)))
(def: actor-decl^
(Syntax [(List Text) Text (List [Text Code])])
(s;seq (s;default (list) (s;tuple (s;some s;local-symbol)))
- (s;either (s;form (s;seq s;local-symbol (s;many common;typed-arg)))
+ (s;either (s;form (s;seq s;local-symbol (s;many common;typed-input)))
(s;seq s;local-symbol (:: s;Monad<Syntax> wrap (list))))))
(def: (actor-def-decl [_vars _name _args] return-type)
@@ -190,7 +190,7 @@
(list decl
type)))
-(syntax: #export (actor: [_ex-lev common;export-level]
+(syntax: #export (actor: [_ex-lev common;export]
[(^@ decl [_vars _name _args]) actor-decl^]
state-type
[methods (s;many method^)]
@@ -264,16 +264,16 @@
type (` (-> (~@ (List/map product;right args))
(~ g!actor-name)
(P;Promise (~ return))))]
- (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~@ arg-names) (~ g!self))
+ (` (def: (~@ (common;gen-export _ex-lev)) ((~ (code;symbol ["" name])) (~@ arg-names) (~ g!self))
(~ type)
(let [(~ g!output) (P;promise (~ return))]
(exec (send ((~ (code;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self))
(~ g!output))))))))
methods)]
- (wrap (list& (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!state-name) (~ state-type)))
- (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!protocol-name) (~@ protocol)))
- (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!actor-name) (Actor (~ g!state-name) (~ g!protocol-name))))
- (` (def: (~@ (common;gen-export-level _ex-lev)) (~@ (actor-def-decl decl (` (Behavior (~ g!state-name) (~ g!protocol-name)))))
+ (wrap (list& (` (type: (~@ (common;gen-export _ex-lev)) (~ g!state-name) (~ state-type)))
+ (` (type: (~@ (common;gen-export _ex-lev)) (~ g!protocol-name) (~@ protocol)))
+ (` (type: (~@ (common;gen-export _ex-lev)) (~ g!actor-name) (Actor (~ g!state-name) (~ g!protocol-name))))
+ (` (def: (~@ (common;gen-export _ex-lev)) (~@ (actor-def-decl decl (` (Behavior (~ g!state-name) (~ g!protocol-name)))))
(~ g!behavior)))
g!methods))
)))
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux
index b684d1874..81f976e98 100644
--- a/stdlib/source/lux/control/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -92,7 +92,7 @@
(:: s;Monad<Syntax> wrap (list))
s;any))))
-(syntax: #export (effect: [exp-lvl common;export-level]
+(syntax: #export (effect: [exp-lvl common;export]
[name s;local-symbol]
[ops (s;many op^)])
{#;doc (doc "Define effects by specifying which operations and constants a handler must provide."
@@ -111,12 +111,12 @@
(` ((~ g!tag) (~ g!inputs) (~ g!output)))))
ops)
type-name (code;symbol ["" name])
- type-def (` (type: (~@ (common;gen-export-level exp-lvl))
+ type-def (` (type: (~@ (common;gen-export exp-lvl))
((~ type-name) (~ g!output))
(~@ op-types)))
op-tags (List/map (|>. (get@ #name) [""] code;tag (list) code;tuple)
ops)
- functor-def (` (struct: (~@ (common;gen-export-level exp-lvl)) (~' _) (F;Functor (~ type-name))
+ functor-def (` (struct: (~@ (common;gen-export exp-lvl)) (~' _) (F;Functor (~ type-name))
(def: ((~' map) (~' f) (~' fa))
(case (~' fa)
(^template [(~' <tag>)]
@@ -135,7 +135,7 @@
(format "_")
[""]
code;symbol)))))]
- (` (def: (~@ (common;gen-export-level exp-lvl)) ((~ g!name) (~@ g!params))
+ (` (def: (~@ (common;gen-export exp-lvl)) ((~ g!name) (~@ g!params))
(-> (~@ (get@ #inputs op))
((~ type-name) (~ (get@ #output op))))
((~ g!tag) [(~@ g!params)] ;id)))))
@@ -152,15 +152,15 @@
(def: translation^
(Syntax Translation)
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' =>))]
+ [_ (s;this (' =>))]
(s;seq s;symbol
(s;tuple (s;seq s;any
s;any))))))
-(syntax: #export (handler: [exp-lvl common;export-level]
+(syntax: #export (handler: [exp-lvl common;export]
[name s;local-symbol]
[[effect target-type target-monad] translation^]
- [defs (s;many (common;def *compiler*))])
+ [defs (s;many (common;definition *compiler*))])
{#;doc (doc "Define effect handlers by implementing the operations and values of an effect."
(handler: _
(=> EffA [IO Monad<IO>])
@@ -179,15 +179,15 @@
g!wrap (macro;gensym "wrap")
#let [g!cases (|> defs
(List/map (function [def]
- (let [g!tag (code;tag [e-module (get@ #common;def-name def)])
+ (let [g!tag (code;tag [e-module (get@ #common;definition-name def)])
g!args (List/map (|>. [""] code;symbol)
- (get@ #common;def-args def))
- eff-calc (case (get@ #common;def-type def)
+ (get@ #common;definition-args def))
+ eff-calc (case (get@ #common;definition-type def)
#;None
- (get@ #common;def-value def)
+ (get@ #common;definition-value def)
(#;Some type)
- (` (: (~ type) (~ (get@ #common;def-value def)))))
+ (` (: (~ type) (~ (get@ #common;definition-value def)))))
invocation (case g!args
#;Nil
eff-calc
@@ -201,7 +201,7 @@
((~ g!wrap) ((~ g!cont) (~ g!value)))))
))))
List/join)]]
- (wrap (list (` (struct: (~@ (common;gen-export-level exp-lvl)) (~ (code;symbol ["" name]))
+ (wrap (list (` (struct: (~@ (common;gen-export exp-lvl)) (~ (code;symbol ["" name]))
(;;Handler (~ (code;symbol effect)) (~ target-type))
(def: (~' monad) (~ target-monad))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 222d2e094..6bccbeec8 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -55,13 +55,13 @@
(All [a] (-> Exception Text (Result a)))
(#R;Error (exception message)))
-(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol])
+(syntax: #export (exception: [_ex-lev common;export] [name s;local-symbol])
{#;doc (doc "Define a new exception type."
"It moslty just serves as a way to tag error messages for later catching."
(exception: #export Some-Exception))}
(do @
[current-module macro;current-module-name
#let [g!message (code;symbol ["" "message"])]]
- (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message))
+ (wrap (list (` (def: (~@ (common;gen-export _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message))
Exception
($_ _Text/append_ "[" (~ (code;text current-module)) ";" (~ (code;text name)) "]\t" (~ g!message))))))))
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux
index 4735f38ae..5a9794f85 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered.lux
@@ -100,9 +100,6 @@
[redden #Black #Red (error! error-message)]
)
-(syntax: (as-is ast)
- (wrap (list ast)))
-
(def: (balance-left-add parent self)
(All [a] (-> (Node a) (Node a) (Node a)))
(with-expansions
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index b4dde1157..10acfa13d 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -533,14 +533,14 @@
(-> Text Text (Syntax Code))
(do s;Monad<Syntax>
[#let [dotted-name (format "." field-name)]
- _ (s;this! (code;symbol ["" dotted-name]))]
+ _ (s;this (code;symbol ["" dotted-name]))]
(wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" class-name ":" field-name)))] [])))))
(def: (make-get-var-parser class-name field-name)
(-> Text Text (Syntax Code))
(do s;Monad<Syntax>
[#let [dotted-name (format "." field-name)]
- _ (s;this! (code;symbol ["" dotted-name]))]
+ _ (s;this (code;symbol ["" dotted-name]))]
(wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this])))))
(def: (make-put-var-parser class-name field-name)
@@ -548,7 +548,7 @@
(do s;Monad<Syntax>
[#let [dotted-name (format "." field-name)]
[_ _ value] (: (Syntax [Unit Unit Code])
- (s;form ($_ s;seq (s;this! (' :=)) (s;this! (code;symbol ["" dotted-name])) s;any)))]
+ (s;form ($_ s;seq (s;this (' :=)) (s;this (code;symbol ["" dotted-name])) s;any)))]
(wrap (`' (_lux_proc ["jvm" (~ (code;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)])))))
(def: (pre-walk-replace f input)
@@ -593,7 +593,7 @@
(-> (List TypeParam) Text (List ArgDecl) (Syntax Code))
(do s;Monad<Syntax>
[[_ args] (: (Syntax [Unit (List Code)])
- (s;form ($_ s;seq (s;this! (' .new!)) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+ (s;form ($_ s;seq (s;this (' .new!)) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
#let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]]
(wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))]
[(~@ args)])))))
@@ -603,7 +603,7 @@
(do s;Monad<Syntax>
[#let [dotted-name (format "." method-name "!")]
[_ args] (: (Syntax [Unit (List Code)])
- (s;form ($_ s;seq (s;this! (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+ (s;form ($_ s;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
#let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]]
(wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
[(~@ args)])))))
@@ -614,7 +614,7 @@
(do s;Monad<Syntax>
[#let [dotted-name (format "." method-name "!")]
[_ args] (: (Syntax [Unit (List Code)])
- (s;form ($_ s;seq (s;this! (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+ (s;form ($_ s;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
#let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]]
(wrap (`' (;_lux_proc ["jvm" (~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
[(~' _jvm_this) (~@ args)])))))]
@@ -652,32 +652,32 @@
(Syntax PrivacyModifier)
(let [(^open) s;Monad<Syntax>]
($_ s;alt
- (s;this! (' #public))
- (s;this! (' #private))
- (s;this! (' #protected))
+ (s;this (' #public))
+ (s;this (' #private))
+ (s;this (' #protected))
(wrap []))))
(def: inheritance-modifier^
(Syntax InheritanceModifier)
(let [(^open) s;Monad<Syntax>]
($_ s;alt
- (s;this! (' #final))
- (s;this! (' #abstract))
+ (s;this (' #final))
+ (s;this (' #abstract))
(wrap []))))
(def: bound-kind^
(Syntax BoundKind)
- (s;alt (s;this! (' <))
- (s;this! (' >))))
+ (s;alt (s;this (' <))
+ (s;this (' >))))
(def: (generic-type^ imports type-vars)
(-> ClassImports (List TypeParam) (Syntax GenericType))
($_ s;either
(do s;Monad<Syntax>
- [_ (s;this! (' ?))]
+ [_ (s;this (' ?))]
(wrap (#GenericWildcard #;None)))
(s;tuple (do s;Monad<Syntax>
- [_ (s;this! (' ?))
+ [_ (s;this (' ?))
bound-kind bound-kind^
bound (generic-type^ imports type-vars)]
(wrap (#GenericWildcard (#;Some [bound-kind bound])))))
@@ -704,7 +704,7 @@
## else
(wrap (#GenericClass name (list))))))
(s;form (do s;Monad<Syntax>
- [name (s;this! (' Array))
+ [name (s;this (' Array))
component (generic-type^ imports type-vars)]
(case component
(^template [<class> <name>]
@@ -736,7 +736,7 @@
(wrap [param-name (list)]))
(s;tuple (do s;Monad<Syntax>
[param-name s;local-symbol
- _ (s;this! (' <))
+ _ (s;this (' <))
bounds (s;many (generic-type^ imports (list)))]
(wrap [param-name bounds])))))
@@ -780,7 +780,7 @@
(def: (annotations^' imports)
(-> ClassImports (Syntax (List Annotation)))
(do s;Monad<Syntax>
- [_ (s;this! (' #ann))]
+ [_ (s;this (' #ann))]
(s;tuple (s;some (annotation^ imports)))))
(def: (annotations^ imports)
@@ -792,7 +792,7 @@
(def: (throws-decl'^ imports type-vars)
(-> ClassImports (List TypeParam) (Syntax (List GenericType)))
(do s;Monad<Syntax>
- [_ (s;this! (' #throws))]
+ [_ (s;this (' #throws))]
(s;tuple (s;some (generic-type^ imports type-vars)))))
(def: (throws-decl^ imports type-vars)
@@ -818,14 +818,14 @@
(def: state-modifier^
(Syntax StateModifier)
($_ s;alt
- (s;this! (' #volatile))
- (s;this! (' #final))
+ (s;this (' #volatile))
+ (s;this (' #final))
(:: s;Monad<Syntax> wrap [])))
(def: (field-decl^ imports type-vars)
(-> ClassImports (List TypeParam) (Syntax [MemberDecl FieldDecl]))
(s;either (s;form (do s;Monad<Syntax>
- [_ (s;this! (' #const))
+ [_ (s;this (' #const))
name s;local-symbol
anns (annotations^ imports)
type (generic-type^ imports type-vars)
@@ -863,7 +863,7 @@
strict-fp? (s;this? (' #strict))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars (List/append class-vars method-vars)]
- [_ arg-decls] (s;form (s;seq (s;this! (' new))
+ [_ arg-decls] (s;form (s;seq (s;this (' new))
(arg-decls^ imports total-vars)))
constructor-args (constructor-args^ imports total-vars)
exs (throws-decl^ imports total-vars)
@@ -916,7 +916,7 @@
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
strict-fp? (s;this? (' #strict))
- _ (s;this! (' #static))
+ _ (s;this (' #static))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -934,7 +934,7 @@
(-> ClassImports (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- _ (s;this! (' #abstract))
+ _ (s;this (' #abstract))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -951,7 +951,7 @@
(-> ClassImports (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- _ (s;this! (' #native))
+ _ (s;this (' #native))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -981,17 +981,17 @@
(def: class-kind^
(Syntax ClassKind)
(s;either (do s;Monad<Syntax>
- [_ (s;this! (' #class))]
+ [_ (s;this (' #class))]
(wrap #Class))
(do s;Monad<Syntax>
- [_ (s;this! (' #interface))]
+ [_ (s;this (' #interface))]
(wrap #Interface))
))
(def: import-member-alias^
(Syntax (Maybe Text))
(s;opt (do s;Monad<Syntax>
- [_ (s;this! (' #as))]
+ [_ (s;this (' #as))]
s;local-symbol)))
(def: (import-member-args^ imports type-vars)
@@ -1004,19 +1004,19 @@
(def: primitive-mode^
(Syntax Primitive-Mode)
- (s;alt (s;this! (' #manual))
- (s;this! (' #auto))))
+ (s;alt (s;this (' #manual))
+ (s;this (' #auto))))
(def: (import-member-decl^ imports owner-vars)
(-> ClassImports (List TypeParam) (Syntax ImportMemberDecl))
($_ s;either
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' #enum))
+ [_ (s;this (' #enum))
enum-members (s;some s;local-symbol)]
(wrap (#EnumDecl enum-members))))
(s;form (do s;Monad<Syntax>
[tvars (s;default (list) (type-params^ imports))
- _ (s;this! (' new))
+ _ (s;this (' new))
?alias import-member-alias^
#let [total-vars (List/append owner-vars tvars)]
?prim-mode (s;opt primitive-mode^)
@@ -1034,7 +1034,7 @@
))
(s;form (do s;Monad<Syntax>
[kind (: (Syntax ImportMethodKind)
- (s;alt (s;this! (' #static))
+ (s;alt (s;this (' #static))
(wrap [])))
tvars (s;default (list) (type-params^ imports))
name s;local-symbol
@@ -1224,7 +1224,7 @@
(#OverridenMethod strict-fp? class-decl type-vars arg-decls return-type body exs)
(let [super-replacer (parser->replacer (s;form (do s;Monad<Syntax>
- [_ (s;this! (' .super!))
+ [_ (s;this (' .super!))
args (s;tuple (s;exactly (list;size arg-decls) s;any))
#let [arg-decls' (: (List Text) (map (. (simple-class$ (list)) product;right)
arg-decls))]]
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 869d80de4..fef8945c3 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -309,7 +309,7 @@
type-vars')
))))
-(syntax: #export (poly: [_ex-lev common;export-level]
+(syntax: #export (poly: [_ex-lev common;export]
[[name env inputs] (s;form ($_ s;seq
s;local-symbol
s;local-symbol
@@ -319,7 +319,7 @@
(let [g!inputs (List/map (|>. [""] code;symbol) inputs)
g!name (code;symbol ["" name])
g!env (code;symbol ["" env])]
- (wrap (;list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol]))
+ (wrap (;list (` (syntax: (~@ (common;gen-export _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol]))
g!inputs)))
(do Monad<Lux>
[(~@ (List/join (List/map (;function [g!input] (;list g!input (` (macro;find-type-def (~ g!input)))))
@@ -343,7 +343,7 @@
(#;Some (List/fold (text;replace-once "?") poly args))
#;None))
-(syntax: #export (derived: [_ex-lev common;export-level]
+(syntax: #export (derived: [_ex-lev common;export]
[?name (s;opt s;local-symbol)]
[[poly-func poly-args] (s;form (s;seq s;symbol (s;many s;symbol)))]
[?custom-impl (s;opt s;any)])
@@ -366,7 +366,7 @@
#;None
(` ((~ (code;symbol poly-func)) (~@ (List/map code;symbol poly-args)))))]]
- (wrap (;list (` (def: (~@ (common;gen-export-level _ex-lev))
+ (wrap (;list (` (def: (~@ (common;gen-export _ex-lev))
(~ (code;symbol ["" name]))
{#;struct? true}
(~ impl)))))))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 53ec26009..f5742d6ef 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -123,7 +123,7 @@
_
(#R;Success [tokens false]))))
-(def: #export (this! ast)
+(def: #export (this ast)
{#;doc "Ensures the given Code is the next input."}
(-> Code (Syntax Unit))
(function [tokens]
@@ -410,6 +410,19 @@
(function [inputs]
(run inputs (syntax (rec syntax)))))
+(def: #export (after param subject)
+ (All [p s] (-> (Syntax p) (Syntax s) (Syntax s)))
+ (do Monad<Syntax>
+ [_ param]
+ subject))
+
+(def: #export (before param subject)
+ (All [p s] (-> (Syntax p) (Syntax s) (Syntax s)))
+ (do Monad<Syntax>
+ [output subject
+ _ param]
+ (wrap output)))
+
## [Syntax]
(def: #hidden text.join-with text;join-with)
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 1aa43c7cf..a4b6928c9 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -3,7 +3,7 @@
The goal is to be able to reuse common syntax in macro definitions across libraries."}
lux
(lux (control monad)
- (data (coll [list])
+ (data (coll [list "L/" Functor<List>])
text/format
[ident "Ident/" Eq<Ident>]
[product])
@@ -12,21 +12,21 @@
["s" syntax #+ syntax: Syntax])))
## Exports
-(type: #export Export-Level
+(type: #export Export
#Exported
#Hidden)
-(def: #export export-level
+(def: #export export
{#;doc (doc "A parser for export levels."
"Such as:"
#export
#hidden)}
- (Syntax (Maybe Export-Level))
- (s;opt (s;alt (s;this! (' #export))
- (s;this! (' #hidden)))))
+ (Syntax (Maybe Export))
+ (s;opt (s;alt (s;this (' #export))
+ (s;this (' #hidden)))))
-(def: #export (gen-export-level ?el)
- (-> (Maybe Export-Level) (List Code))
+(def: #export (gen-export ?el)
+ (-> (Maybe Export) (List Code))
(case ?el
#;None
(list)
@@ -38,61 +38,61 @@
(list (' #hidden))))
## Declarations
-(type: #export Decl
- {#decl-name Text
- #decl-args (List Text)})
+(type: #export Declaration
+ {#declaration-name Text
+ #declaration-args (List Text)})
-(def: #export decl
+(def: #export declaration
{#;doc (doc "A parser for declaration syntax."
"Such as:"
quux
(foo bar baz))}
- (Syntax Decl)
+ (Syntax Declaration)
(s;either (s;seq s;local-symbol
(:: s;Monad<Syntax> wrap (list)))
(s;form (s;seq s;local-symbol
(s;many s;local-symbol)))))
## Definitions
-(type: #export Def-Syntax
- {#def-name Text
- #def-type (Maybe Code)
- #def-value Code
- #def-anns (List [Ident Code])
- #def-args (List Text)
+(type: #export Definition
+ {#definition-name Text
+ #definition-type (Maybe Code)
+ #definition-value Code
+ #definition-anns (List [Ident Code])
+ #definition-args (List Text)
})
(def: check^
(Syntax [(Maybe Code) Code])
(s;either (s;form (do s;Monad<Syntax>
- [_ (s;this! (' lux;_lux_:))
+ [_ (s;this (' lux;_lux_:))
type s;any
value s;any]
(wrap [(#;Some type) value])))
(s;seq (:: s;Monad<Syntax> wrap #;None)
s;any)))
-(def: _def-anns-tag^
+(def: _definition-anns-tag^
(Syntax Ident)
(s;tuple (s;seq s;text s;text)))
-(def: (_def-anns^ _)
+(def: (_definition-anns^ _)
(-> Top (Syntax (List [Ident Code])))
- (s;alt (s;this! (' #lux;Nil))
+ (s;alt (s;this (' #lux;Nil))
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' #lux;Cons))
- [head tail] (s;seq (s;tuple (s;seq _def-anns-tag^ s;any))
- (_def-anns^ []))]
+ [_ (s;this (' #lux;Cons))
+ [head tail] (s;seq (s;tuple (s;seq _definition-anns-tag^ s;any))
+ (_definition-anns^ []))]
(wrap [head tail])))
))
(def: (flat-list^ _)
(-> Top (Syntax (List Code)))
(s;either (do s;Monad<Syntax>
- [_ (s;this! (' #lux;Nil))]
+ [_ (s;this (' #lux;Nil))]
(wrap (list)))
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' #lux;Cons))
+ [_ (s;this (' #lux;Cons))
[head tail] (s;tuple (s;seq s;any s;any))
tail (s;local (list tail) (flat-list^ []))]
(wrap (#;Cons head tail))))))
@@ -100,16 +100,16 @@
(def: list-meta^
(Syntax (List Code))
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' #lux;ListA))]
+ [_ (s;this (' #lux;ListA))]
(flat-list^ []))))
(def: text-meta^
(Syntax Text)
(s;form (do s;Monad<Syntax>
- [_ (s;this! (' #lux;TextA))]
+ [_ (s;this (' #lux;TextA))]
s;text)))
-(def: (find-def-args meta-data)
+(def: (find-definition-args meta-data)
(-> (List [Ident Code]) (List Text))
(default (list)
(case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data)
@@ -124,53 +124,64 @@
#;None)
))
-(def: #export (def compiler)
+(def: #export (definition compiler)
{#;doc "A parser that first macro-expands and then analyses the input Code, to ensure it's a definition."}
- (-> Compiler (Syntax Def-Syntax))
+ (-> Compiler (Syntax Definition))
(do s;Monad<Syntax>
- [def-raw s;any
- me-def-raw (s;on compiler
- (macro;macro-expand-all def-raw))]
- (s;local me-def-raw
+ [definition-raw s;any
+ me-definition-raw (s;on compiler
+ (macro;macro-expand-all definition-raw))]
+ (s;local me-definition-raw
(s;form (do @
- [_ (s;this! (' lux;_lux_def))
- def-name s;local-symbol
- [?def-type def-value] check^
- def-anns s;any
- def-anns (s;local (list def-anns)
- (_def-anns^ []))
- #let [def-args (find-def-args def-anns)]]
- (wrap {#def-name def-name
- #def-type ?def-type
- #def-anns def-anns
- #def-value def-value
- #def-args def-args}))))))
-
-(def: #export (typed-def compiler)
+ [_ (s;this (' lux;_lux_def))
+ definition-name s;local-symbol
+ [?definition-type definition-value] check^
+ definition-anns s;any
+ definition-anns (s;local (list definition-anns)
+ (_definition-anns^ []))
+ #let [definition-args (find-definition-args definition-anns)]]
+ (wrap {#definition-name definition-name
+ #definition-type ?definition-type
+ #definition-anns definition-anns
+ #definition-value definition-value
+ #definition-args definition-args}))))))
+
+(def: #export (typed-definition compiler)
{#;doc "A parser for definitions that ensures the input syntax is typed."}
- (-> Compiler (Syntax Def-Syntax))
+ (-> Compiler (Syntax Definition))
(do s;Monad<Syntax>
- [_def (def compiler)
- _ (case (get@ #def-type _def)
+ [_definition (definition compiler)
+ _ (case (get@ #definition-type _definition)
(#;Some _)
(wrap [])
#;None
- (s;fail "Typed def must have a type!")
+ (s;fail "Typed definition must have a type!")
)]
- (wrap _def)))
+ (wrap _definition)))
-(def: #export def-anns
+(type: #export Annotations
+ (List [Ident Code]))
+
+(def: #export empty-annotations
+ Annotations
+ (list))
+
+(def: #export annotations
{#;doc "Parser for the common annotations syntax used by def: statements."}
- (Syntax (List [Ident Code]))
+ (Syntax Annotations)
(s;record (s;some (s;seq s;tag s;any))))
-(def: #export typed-arg
+(def: #export (gen-annotations annotations)
+ (-> Annotations Code)
+ (|> annotations (L/map (product;both code;tag id)) code;record))
+
+(def: #export typed-input
{#;doc "Parser for the common typed-argument syntax used by many macros."}
(Syntax [Text Code])
(s;tuple (s;seq s;local-symbol s;any)))
-(def: #export type-params
+(def: #export type-variables
{#;doc "Parser for the common type var/param used by many macros."}
(Syntax (List Text))
(s;tuple (s;some s;local-symbol)))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index b89747622..64a40867e 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -115,7 +115,7 @@
(s/map code;tag s;tag))
(s;form (s;many s;any))
(s;tuple (s;either (do s;Monad<Syntax>
- [_ (s;this! (' #and))
+ [_ (s;this (' #and))
init-subject (infix^ [])
init-op s;any
init-param (infix^ [])
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 4e63a8b28..b104df4f9 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -131,10 +131,10 @@
(def: config^
(Syntax Test-Config)
(s;alt (do s;Monad<Syntax>
- [_ (s;this! (' #seed))]
+ [_ (s;this (' #seed))]
s;nat)
(do s;Monad<Syntax>
- [_ (s;this! (' #times))]
+ [_ (s;this (' #times))]
s;nat)))
(def: property-test^
diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux
index 0badc67f3..9982dc01b 100644
--- a/stdlib/test/test/lux/macro/syntax.lux
+++ b/stdlib/test/test/lux/macro/syntax.lux
@@ -68,7 +68,7 @@
[(assert <assertion>
(and (is? <Eq> <value> <get> (list (<ctor> <value>)))
(found? (s;this? (<ctor> <value>)) (list (<ctor> <value>)))
- (enforced? (s;this! (<ctor> <value>)) (list (<ctor> <value>)))))]
+ (enforced? (s;this (<ctor> <value>)) (list (<ctor> <value>)))))]
["Can parse Bool syntax." true code;bool bool;Eq<Bool> s;bool]
["Can parse Nat syntax." +123 code;nat number;Eq<Nat> s;nat]
@@ -247,8 +247,8 @@
(assert "Can parse while taking separators into account."
(and (match (list 123 456 789)
(s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789))
- (s;sep-by (s;this! (' "YOLO")) s;int)))
+ (s;sep-by (s;this (' "YOLO")) s;int)))
(match (list 123 456)
(s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789))
- (s;sep-by (s;this! (' "YOLO")) s;int)))))
+ (s;sep-by (s;this (' "YOLO")) s;int)))))
))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 12:38:59 +0000