aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/concurrency/actor.lux6
-rw-r--r--stdlib/source/lux/control/effect.lux2
-rw-r--r--stdlib/source/lux/host.lux92
-rw-r--r--stdlib/source/lux/macro.lux2
-rw-r--r--stdlib/source/lux/macro/syntax.lux77
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux20
-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.lux28
9 files changed, 117 insertions, 116 deletions
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index 650065a0e..e55386d9d 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -133,7 +133,7 @@
(wrap (#;Right new-server))))
))))
#end (lambda [_ server] (exec (io;run (poison server))
- (:: Monad<Promise> wrap [])))})))]
+ (:: Monad<Promise> wrap [])))})))]
(update@ #obituary (: (-> (P;Promise [(Maybe Text) (Actor ($ +0) ($ +1)) (List ($ +1))])
(P;Promise [(Maybe Text) ($ +0) (List ($ +1))]))
(lambda [process]
@@ -154,7 +154,7 @@
(def: method^
(Syntax Method)
(s;form (do s;Monad<Syntax>
- [_ (s;symbol! ["" "method:"])
+ [_ (s;sample! (' method:))
vars (s;default (list) (s;tuple (s;some s;local-symbol)))
[name args] (s;form ($_ s;seq
s;local-symbol
@@ -171,7 +171,7 @@
(def: stop^
(Syntax AST)
(s;form (do s;Monad<Syntax>
- [_ (s;symbol! ["" "stop:"])]
+ [_ (s;sample! (' stop:))]
s;any)))
(def: actor-decl^
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux
index bf98b9391..2b81ad543 100644
--- a/stdlib/source/lux/control/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -217,7 +217,7 @@
(def: translation^
(Syntax Translation)
(s;form (do s;Monad<Syntax>
- [_ (s;symbol! ["" "=>"])]
+ [_ (s;sample! (' =>))]
(s;seq s;symbol
(s;tuple (s;seq s;any
s;any))))))
diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.lux
index 7c0180ec1..ededaa0a4 100644
--- a/stdlib/source/lux/host.lux
+++ b/stdlib/source/lux/host.lux
@@ -561,14 +561,14 @@
(-> Text Text (Syntax AST))
(do s;Monad<Syntax>
[#let [dotted-name (format "." field-name)]
- _ (s;symbol! ["" dotted-name])]
+ _ (s;sample! (ast;symbol ["" dotted-name]))]
(wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" class-name ":" field-name)))] [])))))
(def: (make-get-var-parser class-name field-name)
(-> Text Text (Syntax AST))
(do s;Monad<Syntax>
[#let [dotted-name (format "." field-name)]
- _ (s;symbol! ["" dotted-name])]
+ _ (s;sample! (ast;symbol ["" dotted-name]))]
(wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this])))))
(def: (make-put-var-parser class-name field-name)
@@ -576,7 +576,7 @@
(do s;Monad<Syntax>
[#let [dotted-name (format "." field-name)]
[_ _ value] (: (Syntax [Unit Unit AST])
- (s;form ($_ s;seq (s;symbol! ["" ":="]) (s;symbol! ["" dotted-name]) s;any)))]
+ (s;form ($_ s;seq (s;sample! (' :=)) (s;sample! (ast;symbol ["" dotted-name])) s;any)))]
(wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)])))))
(def: (pre-walk-replace f input)
@@ -621,7 +621,7 @@
(-> (List TypeParam) Text (List ArgDecl) (Syntax AST))
(do s;Monad<Syntax>
[[_ args] (: (Syntax [Unit (List AST)])
- (s;form ($_ s;seq (s;symbol! ["" ".new!"]) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+ (s;form ($_ s;seq (s;sample! (' .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" (~ (ast;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))]
[(~@ args)])))))
@@ -631,7 +631,7 @@
(do s;Monad<Syntax>
[#let [dotted-name (format "." method-name "!")]
[_ args] (: (Syntax [Unit (List AST)])
- (s;form ($_ s;seq (s;symbol! ["" dotted-name]) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+ (s;form ($_ s;seq (s;sample! (ast;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" (~ (ast;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
[(~@ args)])))))
@@ -642,7 +642,7 @@
(do s;Monad<Syntax>
[#let [dotted-name (format "." method-name "!")]
[_ args] (: (Syntax [Unit (List AST)])
- (s;form ($_ s;seq (s;symbol! ["" dotted-name]) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+ (s;form ($_ s;seq (s;sample! (ast;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" (~ (ast;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
[(~' _jvm_this) (~@ args)])))))]
@@ -680,32 +680,32 @@
(Syntax PrivacyModifier)
(let [(^open) s;Monad<Syntax>]
($_ s;alt
- (s;tag! ["" "public"])
- (s;tag! ["" "private"])
- (s;tag! ["" "protected"])
+ (s;sample! (' #public))
+ (s;sample! (' #private))
+ (s;sample! (' #protected))
(wrap []))))
(def: inheritance-modifier^
(Syntax InheritanceModifier)
(let [(^open) s;Monad<Syntax>]
($_ s;alt
- (s;tag! ["" "final"])
- (s;tag! ["" "abstract"])
+ (s;sample! (' #final))
+ (s;sample! (' #abstract))
(wrap []))))
(def: bound-kind^
(Syntax BoundKind)
- (s;alt (s;symbol! ["" "<"])
- (s;symbol! ["" ">"])))
+ (s;alt (s;sample! (' <))
+ (s;sample! (' >))))
(def: (generic-type^ imports type-vars)
(-> ClassImports (List TypeParam) (Syntax GenericType))
($_ s;either
(do s;Monad<Syntax>
- [_ (s;symbol! ["" "?"])]
+ [_ (s;sample! (' ?))]
(wrap (#GenericWildcard #;None)))
(s;tuple (do s;Monad<Syntax>
- [_ (s;symbol! ["" "?"])
+ [_ (s;sample! (' ?))
bound-kind bound-kind^
bound (generic-type^ imports type-vars)]
(wrap (#GenericWildcard (#;Some [bound-kind bound])))))
@@ -731,7 +731,7 @@
## else
(wrap (#GenericClass name (list))))))
(s;form (do s;Monad<Syntax>
- [name (s;symbol! ["" "Array"])
+ [name (s;sample! (' Array))
component (generic-type^ imports type-vars)]
(case component
(^template [<class> <name>]
@@ -763,7 +763,7 @@
(wrap [param-name (list)]))
(s;tuple (do s;Monad<Syntax>
[param-name s;local-symbol
- _ (s;symbol! ["" "<"])
+ _ (s;sample! (' <))
bounds (s;many (generic-type^ imports (list)))]
(wrap [param-name bounds])))))
@@ -807,7 +807,7 @@
(def: (annotations^' imports)
(-> ClassImports (Syntax (List Annotation)))
(do s;Monad<Syntax>
- [_ (s;tag! ["" "ann"])]
+ [_ (s;sample! (' #ann))]
(s;tuple (s;some (annotation^ imports)))))
(def: (annotations^ imports)
@@ -819,7 +819,7 @@
(def: (throws-decl'^ imports type-vars)
(-> ClassImports (List TypeParam) (Syntax (List GenericType)))
(do s;Monad<Syntax>
- [_ (s;tag! ["" "throws"])]
+ [_ (s;sample! (' #throws))]
(s;tuple (s;some (generic-type^ imports type-vars)))))
(def: (throws-decl^ imports type-vars)
@@ -845,14 +845,14 @@
(def: state-modifier^
(Syntax StateModifier)
($_ s;alt
- (s;tag! ["" "volatile"])
- (s;tag! ["" "final"])
+ (s;sample! (' #volatile))
+ (s;sample! (' #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;tag! ["" "const"])
+ [_ (s;sample! (' #const))
name s;local-symbol
anns (annotations^ imports)
type (generic-type^ imports type-vars)
@@ -887,10 +887,10 @@
(-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- strict-fp? (s;tag? ["" "strict"])
+ strict-fp? (s;sample? (' #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;symbol! ["" "new"])
+ [_ arg-decls] (s;form (s;seq (s;sample! (' new))
(arg-decls^ imports total-vars)))
constructor-args (constructor-args^ imports total-vars)
exs (throws-decl^ imports total-vars)
@@ -905,8 +905,8 @@
(-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- strict-fp? (s;tag? ["" "strict"])
- final? (s;tag? ["" "final"])
+ strict-fp? (s;sample? (' #strict))
+ final? (s;sample? (' #final))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars (List/append class-vars method-vars)]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -923,7 +923,7 @@
(def: (overriden-method-def^ imports)
(-> ClassImports (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
- [strict-fp? (s;tag? ["" "strict"])
+ [strict-fp? (s;sample? (' #strict))
owner-class (class-decl^ imports)
method-vars (s;default (list) (type-params^ imports))
#let [total-vars (List/append (product;right owner-class) method-vars)]
@@ -942,8 +942,8 @@
(-> ClassImports (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- strict-fp? (s;tag? ["" "strict"])
- _ (s;tag! ["" "static"])
+ strict-fp? (s;sample? (' #strict))
+ _ (s;sample! (' #static))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -961,7 +961,7 @@
(-> ClassImports (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- _ (s;tag! ["" "abstract"])
+ _ (s;sample! (' #abstract))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -978,7 +978,7 @@
(-> ClassImports (Syntax [MemberDecl MethodDef]))
(s;form (do s;Monad<Syntax>
[pm privacy-modifier^
- _ (s;tag! ["" "native"])
+ _ (s;sample! (' #native))
method-vars (s;default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s;form (s;seq s;local-symbol
@@ -1008,42 +1008,42 @@
(def: class-kind^
(Syntax ClassKind)
(s;either (do s;Monad<Syntax>
- [_ (s;tag! ["" "class"])]
+ [_ (s;sample! (' #class))]
(wrap #Class))
(do s;Monad<Syntax>
- [_ (s;tag! ["" "interface"])]
+ [_ (s;sample! (' #interface))]
(wrap #Interface))
))
(def: import-member-alias^
(Syntax (Maybe Text))
(s;opt (do s;Monad<Syntax>
- [_ (s;tag! ["" "as"])]
+ [_ (s;sample! (' #as))]
s;local-symbol)))
(def: (import-member-args^ imports type-vars)
(-> ClassImports (List TypeParam) (Syntax (List [Bool GenericType])))
- (s;tuple (s;some (s;seq (s;tag? ["" "?"]) (generic-type^ imports type-vars)))))
+ (s;tuple (s;some (s;seq (s;sample? (' #?)) (generic-type^ imports type-vars)))))
(def: import-member-return-flags^
(Syntax [Bool Bool Bool])
- ($_ s;seq (s;tag? ["" "io"]) (s;tag? ["" "try"]) (s;tag? ["" "?"])))
+ ($_ s;seq (s;sample? (' #io)) (s;sample? (' #try)) (s;sample? (' #?))))
(def: primitive-mode^
(Syntax Primitive-Mode)
- (s;alt (s;tag! ["" "manual"])
- (s;tag! ["" "auto"])))
+ (s;alt (s;sample! (' #manual))
+ (s;sample! (' #auto))))
(def: (import-member-decl^ imports owner-vars)
(-> ClassImports (List TypeParam) (Syntax ImportMemberDecl))
($_ s;either
(s;form (do s;Monad<Syntax>
- [_ (s;tag! ["" "enum"])
+ [_ (s;sample! (' #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;symbol! ["" "new"])
+ _ (s;sample! (' new))
?alias import-member-alias^
#let [total-vars (List/append owner-vars tvars)]
?prim-mode (s;opt primitive-mode^)
@@ -1061,7 +1061,7 @@
))
(s;form (do s;Monad<Syntax>
[kind (: (Syntax ImportMethodKind)
- (s;alt (s;tag! ["" "static"])
+ (s;alt (s;sample! (' #static))
(wrap [])))
tvars (s;default (list) (type-params^ imports))
name s;local-symbol
@@ -1083,12 +1083,12 @@
#import-method-return return
}]))))
(s;form (do s;Monad<Syntax>
- [static? (s;tag? ["" "static"])
+ [static? (s;sample? (' #static))
name s;local-symbol
?prim-mode (s;opt primitive-mode^)
gtype (generic-type^ imports owner-vars)
- maybe? (s;tag? ["" "?"])
- setter? (s;tag? ["" "!"])]
+ maybe? (s;sample? (' #?))
+ setter? (s;sample? (' #!))]
(wrap (#FieldAccessDecl {#import-field-mode (default #AutoPrM ?prim-mode)
#import-field-name name
#import-field-static? static?
@@ -1251,7 +1251,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;symbol! ["" ".super!"])
+ [_ (s;sample! (' .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))]]
@@ -1944,7 +1944,7 @@
(compiler;fail (format "Unknown class: " class-name))))
(syntax: #export (jvm-import [#let [imports (class-imports *compiler*)]]
- [long-name? (s;tag? ["" "long"])]
+ [long-name? (s;sample? (' #long))]
[class-decl (class-decl^ imports)]
[#let [full-class-name (product;left class-decl)
imports (add-import [(short-class-name full-class-name) full-class-name]
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index f9cfce416..b06deedb7 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -13,7 +13,7 @@
(def: omit^
(Syntax Bool)
- (s;tag? ["" "omit"]))
+ (s;sample? (' #omit)))
(do-template [<macro> <func>]
[(syntax: #export (<macro> [? omit^] token)
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index dd7a3ac06..45aaee1bb 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -18,7 +18,7 @@
(struct [list #* "" Functor<List> Fold<List> "List/" Monoid<List>])
[product]
[error #- fail]))
- (.. [ast]))
+ (.. [ast "AST/" Eq<AST>]))
## [Utils]
(def: (join-pairs pairs)
@@ -78,7 +78,7 @@
## [Utils]
(def: (remaining-inputs asts)
(-> (List AST) Text)
- ($_ Text/append " | Remaining input: "
+ ($_ Text/append "\nRemaining input: "
(|> asts (map ast;to-text) (interpose " ") (text;join-with ""))))
## [Syntaxs]
@@ -90,7 +90,7 @@
#;Nil (#;Left "There are no tokens to parse!")
(#;Cons [t tokens']) (#;Right [tokens' t]))))
-(do-template [<get-name> <ask-name> <demand-name> <type> <tag> <eq> <desc>]
+(do-template [<get-name> <type> <tag> <eq> <desc>]
[(def: #export <get-name>
{#;doc (#;TextM ($_ Text/append "Parses the next " <desc> " input AST."))}
(Syntax <type>)
@@ -100,46 +100,47 @@
(#;Right [tokens' x])
_
- (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))
+ (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))]
- (def: #export (<ask-name> v)
- {#;doc (#;TextM ($_ Text/append "Asks if the given " <desc> " is the next input AST."))}
- (-> <type> (Syntax Bool))
- (lambda [tokens]
- (case tokens
- (#;Cons [[_ (<tag> x)] tokens'])
- (let [is-it? (:: <eq> = v x)
- remaining (if is-it?
- tokens'
- tokens)]
- (#;Right [remaining is-it?]))
+ [ bool Bool #;BoolS bool;Eq<Bool> "bool"]
+ [ nat Nat #;NatS number;Eq<Nat> "nat"]
+ [ int Int #;IntS number;Eq<Int> "int"]
+ [ frac Frac #;FracS number;Eq<Frac> "frac"]
+ [ real Real #;RealS number;Eq<Real> "real"]
+ [ char Char #;CharS char;Eq<Char> "char"]
+ [ text Text #;TextS text;Eq<Text> "text"]
+ [symbol Ident #;SymbolS ident;Eq<Ident> "symbol"]
+ [ tag Ident #;TagS ident;Eq<Ident> "tag"]
+ )
- _
- (#;Right [tokens false]))))
+(def: #export (sample? ast)
+ {#;doc "Asks if the given AST is the next input."}
+ (-> AST (Syntax Bool))
+ (lambda [tokens]
+ (case tokens
+ (#;Cons [token tokens'])
+ (let [is-it? (AST/= ast token)
+ remaining (if is-it?
+ tokens'
+ tokens)]
+ (#;Right [remaining is-it?]))
- (def: #export (<demand-name> v)
- {#;doc (#;TextM ($_ Text/append "Ensures the given " <desc> " is the next input AST."))}
- (-> <type> (Syntax Unit))
- (lambda [tokens]
- (case tokens
- (#;Cons [[_ (<tag> x)] tokens'])
- (if (:: <eq> = v x)
- (#;Right [tokens' []])
- (#;Left ($_ Text/append "Expected a " <desc> " but instead got " (ast;to-text [_ (<tag> x)]) (remaining-inputs tokens))))
+ _
+ (#;Right [tokens false]))))
- _
- (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))]
+(def: #export (sample! ast)
+ {#;doc "Ensures the given AST is the next input."}
+ (-> AST (Syntax Unit))
+ (lambda [tokens]
+ (case tokens
+ (#;Cons [token tokens'])
+ (if (AST/= ast token)
+ (#;Right [tokens' []])
+ (#;Left ($_ Text/append "Expected a " (ast;to-text ast) " but instead got " (ast;to-text token)
+ (remaining-inputs tokens))))
- [ bool bool? bool! Bool #;BoolS bool;Eq<Bool> "bool"]
- [ nat nat? nat! Nat #;NatS number;Eq<Nat> "nat"]
- [ int int? int! Int #;IntS number;Eq<Int> "int"]
- [ frac frac? frac! Frac #;FracS number;Eq<Frac> "frac"]
- [ real real? real! Real #;RealS number;Eq<Real> "real"]
- [ char char? char! Char #;CharS char;Eq<Char> "char"]
- [ text text? text! Text #;TextS text;Eq<Text> "text"]
- [symbol symbol? symbol! Ident #;SymbolS ident;Eq<Ident> "symbol"]
- [ tag tag? tag! Ident #;TagS ident;Eq<Ident> "tag"]
- )
+ _
+ (#;Left "There are no tokens to parse!"))))
(def: #export (assert message test)
{#;doc "Fails with the given message if the test is false."}
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 69564fc7d..72faa2ada 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -27,8 +27,8 @@
#export
#hidden)}
(Syntax (Maybe Export-Level))
- (s;opt (s;alt (s;tag! ["" "export"])
- (s;tag! ["" "hidden"]))))
+ (s;opt (s;alt (s;sample! (' #export))
+ (s;sample! (' #hidden)))))
(def: #export (gen-export-level ?el)
(-> (Maybe Export-Level) (List AST))
@@ -70,7 +70,7 @@
(def: check^
(Syntax [(Maybe AST) AST])
(s;either (s;form (do s;Monad<Syntax>
- [_ (s;symbol! ["lux" "_lux_:"])
+ [_ (s;sample! (' lux;_lux_:))
type s;any
value s;any]
(wrap [(#;Some type) value])))
@@ -83,9 +83,9 @@
(def: (_def-anns^ _)
(-> Top (Syntax (List [Ident AST])))
- (s;alt (s;tag! ["lux" "Nil"])
+ (s;alt (s;sample! (' #lux;Nil))
(s;form (do s;Monad<Syntax>
- [_ (s;tag! ["lux" "Cons"])
+ [_ (s;sample! (' #lux;Cons))
[head tail] (s;seq (s;tuple (s;seq _def-anns-tag^ s;any))
(_def-anns^ []))]
(wrap [head tail])))
@@ -94,10 +94,10 @@
(def: (flat-list^ _)
(-> Top (Syntax (List AST)))
(s;either (do s;Monad<Syntax>
- [_ (s;tag! ["lux" "Nil"])]
+ [_ (s;sample! (' #lux;Nil))]
(wrap (list)))
(s;form (do s;Monad<Syntax>
- [_ (s;tag! ["lux" "Cons"])
+ [_ (s;sample! (' #lux;Cons))
[head tail] (s;tuple (s;seq s;any s;any))
tail (s;local (list tail) (flat-list^ []))]
(wrap (#;Cons head tail))))))
@@ -105,13 +105,13 @@
(def: list-meta^
(Syntax (List AST))
(s;form (do s;Monad<Syntax>
- [_ (s;tag! ["lux" "ListM"])]
+ [_ (s;sample! (' #lux;ListM))]
(flat-list^ []))))
(def: text-meta^
(Syntax Text)
(s;form (do s;Monad<Syntax>
- [_ (s;tag! ["lux" "TextM"])]
+ [_ (s;sample! (' #lux;TextM))]
s;text)))
(def: (find-def-args meta-data)
@@ -138,7 +138,7 @@
(compiler;macro-expand-all def-raw))]
(s;local me-def-raw
(s;form (do @
- [_ (s;symbol! ["lux" "_lux_def"])
+ [_ (s;sample! (' lux;_lux_def))
def-name s;local-symbol
[?def-type def-value] check^
def-anns s;any
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 4c7c2e92e..c1d855c8e 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -118,7 +118,7 @@
(s/map ast;tag s;tag))
(s;form (s;many s;any))
(s;tuple (s;either (do s;Monad<Syntax>
- [_ (s;tag! ["" "and"])
+ [_ (s;sample! (' #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 4bebfe10c..e7012f06e 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -136,10 +136,10 @@
(def: config^
(Syntax Test-Config)
(s;alt (do s;Monad<Syntax>
- [_ (s;tag! ["" "seed"])]
+ [_ (s;sample! (' #seed))]
s;nat)
(do s;Monad<Syntax>
- [_ (s;tag! ["" "times"])]
+ [_ (s;sample! (' #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 aaa042fb3..1fabb09ad 100644
--- a/stdlib/test/test/lux/macro/syntax.lux
+++ b/stdlib/test/test/lux/macro/syntax.lux
@@ -70,21 +70,21 @@
## [Tests]
(test: "Simple value syntax."
- (let% [<simple-tests> (do-template [<assertion> <value> <ctor> <Eq> <get> <ask> <demand>]
+ (let% [<simple-tests> (do-template [<assertion> <value> <ctor> <Eq> <get>]
[(assert <assertion>
(and (is? <Eq> <value> <get> (list (<ctor> <value>)))
- (found? (<ask> <value>) (list (<ctor> <value>)))
- (enforced? (<demand> <value>) (list (<ctor> <value>)))))]
+ (found? (s;sample? (<ctor> <value>)) (list (<ctor> <value>)))
+ (enforced? (s;sample! (<ctor> <value>)) (list (<ctor> <value>)))))]
- ["Can parse Bool syntax." true ast;bool bool;Eq<Bool> s;bool s;bool? s;bool!]
- ["Can parse Nat syntax." +123 ast;nat number;Eq<Nat> s;nat s;nat? s;nat!]
- ["Can parse Int syntax." 123 ast;int number;Eq<Int> s;int s;int? s;int!]
- ## ["Can parse Frac syntax." .123 ast;frac number;Eq<Frac> s;frac s;frac? s;frac!]
- ["Can parse Real syntax." 123.0 ast;real number;Eq<Real> s;real s;real? s;real!]
- ["Can parse Char syntax." #"\n" ast;char char;Eq<Char> s;char s;char? s;char!]
- ["Can parse Text syntax." "\n" ast;text text;Eq<Text> s;text s;text? s;text!]
- ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq<Ident> s;symbol s;symbol? s;symbol!]
- ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq<Ident> s;tag s;tag? s;tag!]
+ ["Can parse Bool syntax." true ast;bool bool;Eq<Bool> s;bool]
+ ["Can parse Nat syntax." +123 ast;nat number;Eq<Nat> s;nat]
+ ["Can parse Int syntax." 123 ast;int number;Eq<Int> s;int]
+ ["Can parse Frac syntax." .123 ast;frac number;Eq<Frac> s;frac]
+ ["Can parse Real syntax." 123.0 ast;real number;Eq<Real> s;real]
+ ["Can parse Char syntax." #"\n" ast;char char;Eq<Char> s;char]
+ ["Can parse Text syntax." "\n" ast;text text;Eq<Text> s;text]
+ ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq<Ident> s;symbol]
+ ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq<Ident> s;tag]
)]
($_ seq
<simple-tests>
@@ -252,8 +252,8 @@
(assert "Can parse while taking separators into account."
(and (match (list 123 456 789)
(s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;text "YOLO") (ast;int 789))
- (s;sep-by (s;text! "YOLO") s;int)))
+ (s;sep-by (s;sample! (' "YOLO")) s;int)))
(match (list 123 456)
(s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;int 789))
- (s;sep-by (s;text! "YOLO") s;int)))))
+ (s;sep-by (s;sample! (' "YOLO")) s;int)))))
))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 02:03:11 +0000