aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/control/parser.lux16
-rw-r--r--stdlib/source/lux/control/parser/code.lux70
-rw-r--r--stdlib/source/lux/control/parser/synthesis.lux40
-rw-r--r--stdlib/source/lux/host.jvm.lux100
-rw-r--r--stdlib/source/lux/host.old.lux92
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux16
6 files changed, 179 insertions, 155 deletions
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
index 84f63c548..9bc53d149 100644
--- a/stdlib/source/lux/control/parser.lux
+++ b/stdlib/source/lux/control/parser.lux
@@ -7,7 +7,7 @@
[codec (#+ Codec)]]
[data
[collection
- ["." list ("#;." functor monoid)]]
+ ["." list ("#@." functor monoid)]]
["." product]
["." error (#+ Error)]]])
@@ -168,7 +168,7 @@
(do ..monad
[min (exactly n p)
extra (some p)]
- (wrap (list;compose min extra))))
+ (wrap (list@compose min extra))))
(def: #export (at-most n p)
{#.doc "Parse at most N times."}
@@ -207,7 +207,7 @@
(#.Some x)
(do @
[xs' (some (..and sep p))]
- (wrap (#.Cons x (list;map product.right xs'))))
+ (wrap (#.Cons x (list@map product.right xs'))))
)))
(def: #export (not p)
@@ -277,6 +277,16 @@
_ (assert "Constraint failed." (test output))]
(wrap output)))
+(def: #export (parses? parser)
+ (All [s a] (-> (Parser s a) (Parser s Bit)))
+ (function (_ input)
+ (case (parser input)
+ (#error.Failure error)
+ (#error.Success [input false])
+
+ (#error.Success [input' _])
+ (#error.Success [input' true]))))
+
(def: #export (codec Codec<a,z> parser)
(All [s a z] (-> (Codec a z) (Parser s a) (Parser s z)))
(function (_ input)
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 56cbe5bc2..1e1287467 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -41,44 +41,42 @@
#.Nil (#error.Failure "There are no tokens to parse!")
(#.Cons [t tokens']) (#error.Success [tokens' t]))))
-(template [<get-name> <type> <tag> <eq> <desc>]
- [(def: #export <get-name>
- {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input Code."))}
- (Parser <type>)
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> x)] tokens'])
- (#error.Success [tokens' x])
-
- _
- (#error.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
-
- [ bit Bit #.Bit bit.equivalence "bit"]
- [ nat Nat #.Nat nat.equivalence "nat"]
- [ int Int #.Int int.equivalence "int"]
- [ rev Rev #.Rev rev.equivalence "rev"]
- [ frac Frac #.Frac frac.equivalence "frac"]
- [ text Text #.Text text.equivalence "text"]
- [identifier Name #.Identifier name.equivalence "identifier"]
- [ tag Name #.Tag name.equivalence "tag"]
+(template [<query> <assertion> <type> <tag> <eq> <desc>]
+ [(with-expansions [<error> (as-is (#error.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+ (def: #export <query>
+ {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input."))}
+ (Parser <type>)
+ (function (_ tokens)
+ (case tokens
+ (#.Cons [[_ (<tag> x)] tokens'])
+ (#error.Success [tokens' x])
+
+ _
+ <error>)))
+
+ (def: #export (<assertion> expected)
+ (-> <type> (Parser Any))
+ (function (_ tokens)
+ (case tokens
+ (#.Cons [[_ (<tag> actual)] tokens'])
+ (if (:: <eq> = expected actual)
+ (#error.Success [tokens' []])
+ <error>)
+
+ _
+ <error>))))]
+
+ [bit bit! Bit #.Bit bit.equivalence "bit"]
+ [nat nat! Nat #.Nat nat.equivalence "nat"]
+ [int int! Int #.Int int.equivalence "int"]
+ [rev rev! Rev #.Rev rev.equivalence "rev"]
+ [frac frac! Frac #.Frac frac.equivalence "frac"]
+ [text text! Text #.Text text.equivalence "text"]
+ [identifier identifier! Name #.Identifier name.equivalence "identifier"]
+ [tag tag! Name #.Tag name.equivalence "tag"]
)
-(def: #export (this? ast)
- {#.doc "Asks if the given Code is the next input."}
- (-> Code (Parser Bit))
- (function (_ tokens)
- (case tokens
- (#.Cons [token tokens'])
- (let [is-it? (code@= ast token)
- remaining (if is-it?
- tokens'
- tokens)]
- (#error.Success [remaining is-it?]))
-
- _
- (#error.Success [tokens #0]))))
-
-(def: #export (this ast)
+(def: #export (this! ast)
{#.doc "Ensures the given Code is the next input."}
(-> Code (Parser Any))
(function (_ tokens)
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux
index f08159848..c36c61601 100644
--- a/stdlib/source/lux/control/parser/synthesis.lux
+++ b/stdlib/source/lux/control/parser/synthesis.lux
@@ -6,7 +6,13 @@
["." exception (#+ exception:)]]
[data
["." error (#+ Error)]
- [text
+ ["." bit]
+ ["." name]
+ [number
+ ["." i64]
+ ["." frac]
+ ["." nat]]
+ ["." text
format]]
[tool
[compiler
@@ -56,8 +62,8 @@
(#.Cons [head tail])
(#error.Success [tail head]))))
-(template [<name> <tag> <type>]
- [(def: #export <name>
+(template [<query> <assertion> <tag> <type> <eq>]
+ [(def: #export <query>
(Parser <type>)
(.function (_ input)
(case input
@@ -65,17 +71,27 @@
(#error.Success [input' x])
_
+ (exception.throw ..cannot-parse input))))
+
+ (def: #export (<assertion> expected)
+ (-> <type> (Parser Any))
+ (.function (_ input)
+ (case input
+ (^ (list& (<tag> actual) input'))
+ (if (:: <eq> = expected actual)
+ (#error.Success [input' []])
+ (exception.throw ..cannot-parse input))
+
+ _
(exception.throw ..cannot-parse input))))]
- [bit /.bit Bit]
- [i64 /.i64 (I64 Any)]
- [f64 /.f64 Frac]
- [text /.text Text]
- [variant /.variant (Variant Synthesis)]
- [local /.variable/local Nat]
- [foreign /.variable/foreign Nat]
- [constant /.constant Name]
- [abstraction /.function/abstraction Abstraction]
+ [bit bit! /.bit Bit bit.equivalence]
+ [i64 i64! /.i64 (I64 Any) i64.equivalence]
+ [f64 f64! /.f64 Frac frac.equivalence]
+ [text text! /.text Text text.equivalence]
+ [local local! /.variable/local Nat nat.equivalence]
+ [foreign foreign! /.variable/foreign Nat nat.equivalence]
+ [constant constant! /.constant Name name.equivalence]
)
(def: #export (tuple parser)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index fa0979cb1..fc96f4367 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -135,8 +135,8 @@
(def: member-separator "::")
(type: BoundKind
- #UpperBound
- #LowerBound)
+ #LowerBound
+ #UpperBound)
(type: #rec GenericType
(#GenericTypeVar Text)
@@ -585,14 +585,14 @@
(-> Text Text (Parser Code))
(do p.monad
[#let [dotted-name (format "::" field-name)]
- _ (s.this (code.identifier ["" dotted-name]))]
+ _ (s.this! (code.identifier ["" dotted-name]))]
(wrap (get-static-field class-name field-name))))
(def: (make-get-var-parser class-name field-name)
(-> Text Text (Parser Code))
(do p.monad
[#let [dotted-name (format "::" field-name)]
- _ (s.this (code.identifier ["" dotted-name]))]
+ _ (s.this! (code.identifier ["" dotted-name]))]
(wrap (get-virtual-field class-name field-name (' _jvm_this)))))
(def: (make-put-var-parser class-name field-name)
@@ -600,7 +600,7 @@
(do p.monad
[#let [dotted-name (format "::" field-name)]
[_ _ value] (: (Parser [Any Any Code])
- (s.form ($_ p.and (s.this (' :=)) (s.this (code.identifier ["" dotted-name])) s.any)))]
+ (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))]
(wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))
(def: (pre-walk-replace f input)
@@ -649,7 +649,7 @@
(-> (List Type-Paramameter) Text (List ArgDecl) (Parser Code))
(do p.monad
[args (: (Parser (List Code))
- (s.form (p.after (s.this (' ::new!))
+ (s.form (p.after (s.this! (' ::new!))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (` ("jvm member invoke constructor" (~ (code.text class-name))
@@ -662,7 +662,7 @@
(do p.monad
[#let [dotted-name (format "::" method-name "!")]
args (: (Parser (List Code))
- (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+ (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name))
@@ -676,7 +676,7 @@
(do p.monad
[#let [dotted-name (format "::" method-name "!")]
args (: (Parser (List Code))
- (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+ (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name))
@@ -718,23 +718,23 @@
(Parser PrivacyModifier)
(let [(^open ".") p.monad]
($_ p.or
- (s.this (' #public))
- (s.this (' #private))
- (s.this (' #protected))
+ (s.this! (' #public))
+ (s.this! (' #private))
+ (s.this! (' #protected))
(wrap []))))
(def: inheritance-modifier^
(Parser InheritanceModifier)
(let [(^open ".") p.monad]
($_ p.or
- (s.this (' #final))
- (s.this (' #abstract))
+ (s.this! (' #final))
+ (s.this! (' #abstract))
(wrap []))))
(def: bound-kind^
(Parser BoundKind)
- (p.or (s.this (' <))
- (s.this (' >))))
+ (p.or (s.this! (' >))
+ (s.this! (' <))))
(def: (assert-no-periods name)
(-> Text (Parser Any))
@@ -745,10 +745,10 @@
(-> Class-Imports (List Type-Paramameter) (Parser GenericType))
($_ p.either
(do p.monad
- [_ (s.this (' ?))]
+ [_ (s.this! (' ?))]
(wrap (#GenericWildcard #.None)))
(s.tuple (do p.monad
- [_ (s.this (' ?))
+ [_ (s.this! (' ?))
bound-kind bound-kind^
bound (generic-type^ imports type-vars)]
(wrap (#GenericWildcard (#.Some [bound-kind bound])))))
@@ -759,7 +759,7 @@
(wrap (#GenericTypeVar name))
(wrap (#GenericClass name (list)))))
(s.form (do p.monad
- [name (s.this (' Array))
+ [name (s.this! (' Array))
component (generic-type^ imports type-vars)]
(case component
(^template [<class> <name>]
@@ -792,7 +792,7 @@
(wrap [param-name (list)]))
(s.tuple (do p.monad
[param-name s.local-identifier
- _ (s.this (' <))
+ _ (s.this! (' <))
bounds (p.many (generic-type^ imports (list)))]
(wrap [param-name bounds])))))
@@ -840,7 +840,7 @@
(def: (annotations^' imports)
(-> Class-Imports (Parser (List Annotation)))
(do p.monad
- [_ (s.this (' #ann))]
+ [_ (s.this! (' #ann))]
(s.tuple (p.some (annotation^ imports)))))
(def: (annotations^ imports)
@@ -852,7 +852,7 @@
(def: (throws-decl'^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Parser (List GenericType)))
(do p.monad
- [_ (s.this (' #throws))]
+ [_ (s.this! (' #throws))]
(s.tuple (p.some (generic-type^ imports type-vars)))))
(def: (throws-decl^ imports type-vars)
@@ -878,14 +878,14 @@
(def: state-modifier^
(Parser StateModifier)
($_ p.or
- (s.this (' #volatile))
- (s.this (' #final))
+ (s.this! (' #volatile))
+ (s.this! (' #final))
(:: p.monad wrap [])))
(def: (field-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration FieldDecl]))
(p.either (s.form (do p.monad
- [_ (s.this (' #const))
+ [_ (s.this! (' #const))
name s.local-identifier
anns (annotations^ imports)
type (generic-type^ imports type-vars)
@@ -920,10 +920,10 @@
(-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- strict-fp? (s.this? (' #strict))
+ strict-fp? (p.parses? (s.this! (' #strict)))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars (list@compose class-vars method-vars)]
- [_ arg-decls] (s.form (p.and (s.this (' new))
+ [_ arg-decls] (s.form (p.and (s.this! (' new))
(arg-decls^ imports total-vars)))
constructor-args (constructor-args^ imports total-vars)
exs (throws-decl^ imports total-vars)
@@ -938,8 +938,8 @@
(-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- strict-fp? (s.this? (' #strict))
- final? (s.this? (' #final))
+ strict-fp? (p.parses? (s.this! (' #strict)))
+ final? (p.parses? (s.this! (' #final)))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars (list@compose class-vars method-vars)]
[name self-name arg-decls] (s.form ($_ p.and
@@ -958,7 +958,7 @@
(def: (overriden-method-def^ imports)
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
- [strict-fp? (s.this? (' #strict))
+ [strict-fp? (p.parses? (s.this! (' #strict)))
owner-class (class-decl^ imports)
method-vars (p.default (list) (type-params^ imports))
#let [total-vars (list@compose (product.right owner-class) method-vars)]
@@ -979,8 +979,8 @@
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- strict-fp? (s.this? (' #strict))
- _ (s.this (' #static))
+ strict-fp? (p.parses? (s.this! (' #strict)))
+ _ (s.this! (' #static))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s.form (p.and s.local-identifier
@@ -998,7 +998,7 @@
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- _ (s.this (' #abstract))
+ _ (s.this! (' #abstract))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s.form (p.and s.local-identifier
@@ -1015,7 +1015,7 @@
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- _ (s.this (' #native))
+ _ (s.this! (' #native))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s.form (p.and s.local-identifier
@@ -1045,42 +1045,42 @@
(def: class-kind^
(Parser Class-Kind)
(p.either (do p.monad
- [_ (s.this (' #class))]
+ [_ (s.this! (' #class))]
(wrap #Class))
(do p.monad
- [_ (s.this (' #interface))]
+ [_ (s.this! (' #interface))]
(wrap #Interface))
))
(def: import-member-alias^
(Parser (Maybe Text))
(p.maybe (do p.monad
- [_ (s.this (' #as))]
+ [_ (s.this! (' #as))]
s.local-identifier)))
(def: (import-member-args^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Parser (List [Bit GenericType])))
- (s.tuple (p.some (p.and (s.this? (' #?)) (generic-type^ imports type-vars)))))
+ (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (generic-type^ imports type-vars)))))
(def: import-member-return-flags^
(Parser [Bit Bit Bit])
- ($_ p.and (s.this? (' #io)) (s.this? (' #try)) (s.this? (' #?))))
+ ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?)))))
(def: primitive-mode^
(Parser Primitive-Mode)
- (p.or (s.this (' #manual))
- (s.this (' #auto))))
+ (p.or (s.this! (' #manual))
+ (s.this! (' #auto))))
(def: (import-member-decl^ imports owner-vars)
(-> Class-Imports (List Type-Paramameter) (Parser Import-Member-Declaration))
($_ p.either
(s.form (do p.monad
- [_ (s.this (' #enum))
+ [_ (s.this! (' #enum))
enum-members (p.some s.local-identifier)]
(wrap (#EnumDecl enum-members))))
(s.form (do p.monad
[tvars (p.default (list) (type-params^ imports))
- _ (s.this (' new))
+ _ (s.this! (' new))
?alias import-member-alias^
#let [total-vars (list@compose owner-vars tvars)]
?prim-mode (p.maybe primitive-mode^)
@@ -1098,7 +1098,7 @@
))
(s.form (do p.monad
[kind (: (Parser ImportMethodKind)
- (p.or (s.this (' #static))
+ (p.or (s.this! (' #static))
(wrap [])))
tvars (p.default (list) (type-params^ imports))
name s.local-identifier
@@ -1120,12 +1120,12 @@
#import-method-return return
}]))))
(s.form (do p.monad
- [static? (s.this? (' #static))
+ [static? (p.parses? (s.this! (' #static)))
name s.local-identifier
?prim-mode (p.maybe primitive-mode^)
gtype (generic-type^ imports owner-vars)
- maybe? (s.this? (' #?))
- setter? (s.this? (' #!))]
+ maybe? (p.parses? (s.this! (' #?)))
+ setter? (p.parses? (s.this! (' #!)))]
(wrap (#FieldAccessDecl {#import-field-mode (maybe.default #AutoPrM ?prim-mode)
#import-field-name name
#import-field-static? static?
@@ -1160,8 +1160,8 @@
(def: (bound-kind$ kind)
(-> BoundKind Code)
(case kind
- #UpperBound (' "<")
- #LowerBound (' ">")))
+ #LowerBound (' ">")
+ #UpperBound (' "<")))
(def: (generic-type$ gtype)
(-> GenericType Code)
@@ -1270,7 +1270,7 @@
(#OverridenMethod strict-fp? class-decl type-vars self-name arg-decls return-type body exs)
(let [super-replacer (parser->replacer (s.form (do p.monad
- [_ (s.this (' ::super!))
+ [_ (s.this! (' ::super!))
args (s.tuple (p.exactly (list.size arg-decls) s.any))
#let [arg-decls' (: (List Text)
(list@map (|>> product.right (simple-class$ (list)))
@@ -1891,7 +1891,7 @@
(syntax: #export (import:
{#let [imports (class-imports *compiler*)]}
- {long-name? (s.this? (' #long))}
+ {long-name? (p.parses? (s.this! (' #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/host.old.lux b/stdlib/source/lux/host.old.lux
index 39fe0034c..4c12d8774 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -521,14 +521,14 @@
(-> Text Text (Parser Code))
(do p.monad
[#let [dotted-name (format "::" field-name)]
- _ (s.this (code.identifier ["" dotted-name]))]
+ _ (s.this! (code.identifier ["" dotted-name]))]
(wrap (`' ((~ (code.text (format "jvm getstatic" ":" class-name ":" field-name))))))))
(def: (make-get-var-parser class-name field-name)
(-> Text Text (Parser Code))
(do p.monad
[#let [dotted-name (format "::" field-name)]
- _ (s.this (code.identifier ["" dotted-name]))]
+ _ (s.this! (code.identifier ["" dotted-name]))]
(wrap (`' ((~ (code.text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this)))))
(def: (make-put-var-parser class-name field-name)
@@ -536,7 +536,7 @@
(do p.monad
[#let [dotted-name (format "::" field-name)]
[_ _ value] (: (Parser [Any Any Code])
- (s.form ($_ p.and (s.this (' :=)) (s.this (code.identifier ["" dotted-name])) s.any)))]
+ (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))]
(wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))
(def: (pre-walk-replace f input)
@@ -581,7 +581,7 @@
(-> (List Type-Paramameter) Text (List ArgDecl) (Parser Code))
(do p.monad
[args (: (Parser (List Code))
- (s.form (p.after (s.this (' ::new!))
+ (s.form (p.after (s.this! (' ::new!))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls'))))
@@ -592,7 +592,7 @@
(do p.monad
[#let [dotted-name (format "::" method-name "!")]
args (: (Parser (List Code))
- (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+ (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
@@ -604,7 +604,7 @@
(do p.monad
[#let [dotted-name (format "::" method-name "!")]
args (: (Parser (List Code))
- (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+ (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
(s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
@@ -644,23 +644,23 @@
(Parser PrivacyModifier)
(let [(^open ".") p.monad]
($_ p.or
- (s.this (' #public))
- (s.this (' #private))
- (s.this (' #protected))
+ (s.this! (' #public))
+ (s.this! (' #private))
+ (s.this! (' #protected))
(wrap []))))
(def: inheritance-modifier^
(Parser InheritanceModifier)
(let [(^open ".") p.monad]
($_ p.or
- (s.this (' #final))
- (s.this (' #abstract))
+ (s.this! (' #final))
+ (s.this! (' #abstract))
(wrap []))))
(def: bound-kind^
(Parser BoundKind)
- (p.or (s.this (' <))
- (s.this (' >))))
+ (p.or (s.this! (' <))
+ (s.this! (' >))))
(def: (assert-no-periods name)
(-> Text (Parser Any))
@@ -671,10 +671,10 @@
(-> Class-Imports (List Type-Paramameter) (Parser GenericType))
($_ p.either
(do p.monad
- [_ (s.this (' ?))]
+ [_ (s.this! (' ?))]
(wrap (#GenericWildcard #.None)))
(s.tuple (do p.monad
- [_ (s.this (' ?))
+ [_ (s.this! (' ?))
bound-kind bound-kind^
bound (generic-type^ imports type-vars)]
(wrap (#GenericWildcard (#.Some [bound-kind bound])))))
@@ -685,7 +685,7 @@
(wrap (#GenericTypeVar name))
(wrap (#GenericClass name (list)))))
(s.form (do p.monad
- [name (s.this (' Array))
+ [name (s.this! (' Array))
component (generic-type^ imports type-vars)]
(case component
(^template [<class> <name>]
@@ -718,7 +718,7 @@
(wrap [param-name (list)]))
(s.tuple (do p.monad
[param-name s.local-identifier
- _ (s.this (' <))
+ _ (s.this! (' <))
bounds (p.many (generic-type^ imports (list)))]
(wrap [param-name bounds])))))
@@ -766,7 +766,7 @@
(def: (annotations^' imports)
(-> Class-Imports (Parser (List Annotation)))
(do p.monad
- [_ (s.this (' #ann))]
+ [_ (s.this! (' #ann))]
(s.tuple (p.some (annotation^ imports)))))
(def: (annotations^ imports)
@@ -778,7 +778,7 @@
(def: (throws-decl'^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Parser (List GenericType)))
(do p.monad
- [_ (s.this (' #throws))]
+ [_ (s.this! (' #throws))]
(s.tuple (p.some (generic-type^ imports type-vars)))))
(def: (throws-decl^ imports type-vars)
@@ -804,14 +804,14 @@
(def: state-modifier^
(Parser StateModifier)
($_ p.or
- (s.this (' #volatile))
- (s.this (' #final))
+ (s.this! (' #volatile))
+ (s.this! (' #final))
(:: p.monad wrap [])))
(def: (field-decl^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration FieldDecl]))
(p.either (s.form (do p.monad
- [_ (s.this (' #const))
+ [_ (s.this! (' #const))
name s.local-identifier
anns (annotations^ imports)
type (generic-type^ imports type-vars)
@@ -846,10 +846,10 @@
(-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- strict-fp? (s.this? (' #strict))
+ strict-fp? (p.parses? (s.this! (' #strict)))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars (list@compose class-vars method-vars)]
- [_ arg-decls] (s.form (p.and (s.this (' new))
+ [_ arg-decls] (s.form (p.and (s.this! (' new))
(arg-decls^ imports total-vars)))
constructor-args (constructor-args^ imports total-vars)
exs (throws-decl^ imports total-vars)
@@ -864,8 +864,8 @@
(-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- strict-fp? (s.this? (' #strict))
- final? (s.this? (' #final))
+ strict-fp? (p.parses? (s.this! (' #strict)))
+ final? (p.parses? (s.this! (' #final)))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars (list@compose class-vars method-vars)]
[name this-name arg-decls] (s.form ($_ p.and
@@ -887,7 +887,7 @@
(def: (overriden-method-def^ imports)
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
- [strict-fp? (s.this? (' #strict))
+ [strict-fp? (p.parses? (s.this! (' #strict)))
owner-class (class-decl^ imports)
method-vars (p.default (list) (type-params^ imports))
#let [total-vars (list@compose (product.right owner-class) method-vars)]
@@ -911,8 +911,8 @@
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- strict-fp? (s.this? (' #strict))
- _ (s.this (' #static))
+ strict-fp? (p.parses? (s.this! (' #strict)))
+ _ (s.this! (' #static))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s.form (p.and s.local-identifier
@@ -930,7 +930,7 @@
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- _ (s.this (' #abstract))
+ _ (s.this! (' #abstract))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s.form (p.and s.local-identifier
@@ -947,7 +947,7 @@
(-> Class-Imports (Parser [Member-Declaration Method-Definition]))
(s.form (do p.monad
[pm privacy-modifier^
- _ (s.this (' #native))
+ _ (s.this! (' #native))
method-vars (p.default (list) (type-params^ imports))
#let [total-vars method-vars]
[name arg-decls] (s.form (p.and s.local-identifier
@@ -977,42 +977,42 @@
(def: class-kind^
(Parser Class-Kind)
(p.either (do p.monad
- [_ (s.this (' #class))]
+ [_ (s.this! (' #class))]
(wrap #Class))
(do p.monad
- [_ (s.this (' #interface))]
+ [_ (s.this! (' #interface))]
(wrap #Interface))
))
(def: import-member-alias^
(Parser (Maybe Text))
(p.maybe (do p.monad
- [_ (s.this (' #as))]
+ [_ (s.this! (' #as))]
s.local-identifier)))
(def: (import-member-args^ imports type-vars)
(-> Class-Imports (List Type-Paramameter) (Parser (List [Bit GenericType])))
- (s.tuple (p.some (p.and (s.this? (' #?)) (generic-type^ imports type-vars)))))
+ (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (generic-type^ imports type-vars)))))
(def: import-member-return-flags^
(Parser [Bit Bit Bit])
- ($_ p.and (s.this? (' #io)) (s.this? (' #try)) (s.this? (' #?))))
+ ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?)))))
(def: primitive-mode^
(Parser Primitive-Mode)
- (p.or (s.this (' #manual))
- (s.this (' #auto))))
+ (p.or (s.this! (' #manual))
+ (s.this! (' #auto))))
(def: (import-member-decl^ imports owner-vars)
(-> Class-Imports (List Type-Paramameter) (Parser Import-Member-Declaration))
($_ p.either
(s.form (do p.monad
- [_ (s.this (' #enum))
+ [_ (s.this! (' #enum))
enum-members (p.some s.local-identifier)]
(wrap (#EnumDecl enum-members))))
(s.form (do p.monad
[tvars (p.default (list) (type-params^ imports))
- _ (s.this (' new))
+ _ (s.this! (' new))
?alias import-member-alias^
#let [total-vars (list@compose owner-vars tvars)]
?prim-mode (p.maybe primitive-mode^)
@@ -1030,7 +1030,7 @@
))
(s.form (do p.monad
[kind (: (Parser ImportMethodKind)
- (p.or (s.this (' #static))
+ (p.or (s.this! (' #static))
(wrap [])))
tvars (p.default (list) (type-params^ imports))
name s.local-identifier
@@ -1052,12 +1052,12 @@
#import-method-return return
}]))))
(s.form (do p.monad
- [static? (s.this? (' #static))
+ [static? (p.parses? (s.this! (' #static)))
name s.local-identifier
?prim-mode (p.maybe primitive-mode^)
gtype (generic-type^ imports owner-vars)
- maybe? (s.this? (' #?))
- setter? (s.this? (' #!))]
+ maybe? (p.parses? (s.this! (' #?)))
+ setter? (p.parses? (s.this! (' #!)))]
(wrap (#FieldAccessDecl {#import-field-mode (maybe.default #AutoPrM ?prim-mode)
#import-field-name name
#import-field-static? static?
@@ -1221,7 +1221,7 @@
(#OverridenMethod strict-fp? class-decl type-vars this-name arg-decls return-type body exs)
(let [super-replacer (parser->replacer (s.form (do p.monad
- [_ (s.this (' ::super!))
+ [_ (s.this! (' ::super!))
args (s.tuple (p.exactly (list.size arg-decls) s.any))
#let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ (list)))
arg-decls))]]
@@ -1797,7 +1797,7 @@
(syntax: #export (import:
{#let [imports (class-imports *compiler*)]}
- {long-name? (s.this? (' #long))}
+ {long-name? (p.parses? (s.this! (' #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/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 069bf1cf0..d57e4bcde 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -17,7 +17,7 @@
(def: #export export
(Parser Bit)
- (p.either (p.after (s.this (' #export)) (p@wrap #1))
+ (p.either (p.after (s.tag! (name-of #export)) (p@wrap #1))
(p@wrap #0)))
(def: #export declaration
@@ -39,7 +39,7 @@
(def: check^
(Parser [(Maybe Code) Code])
(p.either (s.form (do p.monad
- [_ (s.this (' "lux check"))
+ [_ (s.text! "lux check")
type s.any
value s.any]
(wrap [(#.Some type) value])))
@@ -52,9 +52,9 @@
(def: (_definition-anns^ _)
(-> Any (Parser //.Annotations))
- (p.or (s.this (' #.Nil))
+ (p.or (s.tag! (name-of #.Nil))
(s.form (do p.monad
- [_ (s.this (' #.Cons))
+ [_ (s.tag! (name-of #.Cons))
[head tail] (p.and (s.tuple (p.and _definition-anns-tag^ s.any))
(_definition-anns^ []))]
(wrap [head tail])))
@@ -63,10 +63,10 @@
(def: (flat-list^ _)
(-> Any (Parser (List Code)))
(p.either (do p.monad
- [_ (s.this (' #.Nil))]
+ [_ (s.tag! (name-of #.Nil))]
(wrap (list)))
(s.form (do p.monad
- [_ (s.this (' #.Cons))
+ [_ (s.tag! (name-of #.Cons))
[head tail] (s.tuple (p.and s.any s.any))
tail (s.local (list tail) (flat-list^ []))]
(wrap (#.Cons head tail))))))
@@ -78,7 +78,7 @@
(p.after s.any)
s.form
(do p.monad
- [_ (s.this (' <tag>))]
+ [_ (s.tag! (name-of <tag>))]
<then>)))]
[tuple-meta^ (List Code) #.Tuple (flat-list^ [])]
@@ -111,7 +111,7 @@
s.lift)]
(s.local me-definition-raw
(s.form (do @
- [_ (s.this (' "lux def"))
+ [_ (s.text! "lux def")
definition-name s.local-identifier
[?definition-type definition-value] check^
definition-anns s.any
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 15:08:47 +0000