From 1106bef2b23bbe47d190f6c24cdf618711a615c1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 10 May 2019 00:13:38 -0400 Subject: Improvements to parsing machinery. --- stdlib/source/lux/control/parser.lux | 16 +++- stdlib/source/lux/control/parser/code.lux | 70 ++++++++-------- stdlib/source/lux/control/parser/synthesis.lux | 40 ++++++--- stdlib/source/lux/host.jvm.lux | 100 +++++++++++------------ stdlib/source/lux/host.old.lux | 92 ++++++++++----------- stdlib/source/lux/macro/syntax/common/reader.lux | 16 ++-- 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 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 [ ] - [(def: #export - {#.doc (code.text ($_ text@compose "Parses the next " " input Code."))} - (Parser ) - (function (_ tokens) - (case tokens - (#.Cons [[_ ( x)] tokens']) - (#error.Success [tokens' x]) - - _ - (#error.Failure ($_ text@compose "Cannot parse " (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 [ ] + [(with-expansions [ (as-is (#error.Failure ($_ text@compose "Cannot parse " (remaining-inputs tokens))))] + (def: #export + {#.doc (code.text ($_ text@compose "Parses the next " " input."))} + (Parser ) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( x)] tokens']) + (#error.Success [tokens' x]) + + _ + ))) + + (def: #export ( expected) + (-> (Parser Any)) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( actual)] tokens']) + (if (:: = expected actual) + (#error.Success [tokens' []]) + ) + + _ + ))))] + + [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,26 +62,36 @@ (#.Cons [head tail]) (#error.Success [tail head])))) -(template [ ] - [(def: #export +(template [ ] + [(def: #export (Parser ) (.function (_ input) (case input (^ (list& ( x) input')) (#error.Success [input' x]) + _ + (exception.throw ..cannot-parse input)))) + + (def: #export ( expected) + (-> (Parser Any)) + (.function (_ input) + (case input + (^ (list& ( actual) input')) + (if (:: = 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 (` ( (~ (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 [ ] @@ -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 ":" 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 [ ] @@ -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 (' ))] + [_ (s.tag! (name-of ))] )))] [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 -- cgit v1.2.3