aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/compiler/default/syntax.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux197
1 files changed, 80 insertions, 117 deletions
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 69d214371..af7c7ae90 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -146,6 +146,29 @@
[!dec "lux i64 -" 1]
)
+(template: (!clip from to text)
+ ("lux text clip" text from to))
+
+(template: (!i/< reference subject)
+ ("lux int <" subject reference))
+
+(do-template [<name> <extension>]
+ [(template: (<name> param subject)
+ (<extension> subject param))]
+
+ [!n/+ "lux i64 +"]
+ [!n/- "lux i64 -"]
+ )
+
+(template: (!with-char @source-code @offset @char @else @body)
+ (if (!i/< (:coerce Int ("lux text size" @source-code))
+ ## TODO: Get rid of the above "lux text size" call.
+ ## The size should be calculated only once and re-used constantly.
+ (:coerce Int @offset))
+ (let [@char ("lux text char" @source-code @offset)]
+ @body)
+ @else))
+
(do-template [<name> <close> <tag>]
[(def: (<name> parse source)
(-> Parser Parser)
@@ -157,20 +180,16 @@
(#error.Error error)
(let [[where offset source-code] source]
- (case ("lux text char" source-code offset)
- (#.Some char)
- (`` (case char
- (^ (char (~~ (static <close>))))
- (#error.Success [[(update@ #.column inc where)
- (!inc offset)
- source-code]
- [where (<tag> (list.reverse stack))]])
-
- _
- (ex.throw unrecognized-input where)))
-
- _
- (#error.Error error))))))]
+ (<| (!with-char source-code offset char (#error.Error error))
+ (`` (case char
+ (^ (char (~~ (static <close>))))
+ (#error.Success [[(update@ #.column inc where)
+ (!inc offset)
+ source-code]
+ [where (<tag> (list.reverse stack))]])
+
+ _
+ (ex.throw unrecognized-input where))))))))]
## Form and tuple syntax is mostly the same, differing only in the
## delimiters involved.
@@ -191,38 +210,20 @@
(#error.Error error)
(let [[where offset source-code] source]
- (case ("lux text char" source-code offset)
- (#.Some char)
- (`` (case char
- (^ (char (~~ (static ..close-record))))
- (#error.Success [[(update@ #.column inc where)
- (!inc offset)
- source-code]
- [where (#.Record (list.reverse stack))]])
+ (<| (!with-char source-code offset char (#error.Error error))
+ (`` (case char
+ (^ (char (~~ (static ..close-record))))
+ (#error.Success [[(update@ #.column inc where)
+ (!inc offset)
+ source-code]
+ [where (#.Record (list.reverse stack))]])
- _
- (ex.throw unrecognized-input where)))
-
- _
- (#error.Error error))))
+ _
+ (ex.throw unrecognized-input where))))))
(#error.Error error)
(#error.Error error))))
-(template: (!clip from to text)
- ("lux text clip" text from to))
-
-(template: (!i/< reference subject)
- ("lux int <" subject reference))
-
-(do-template [<name> <extension>]
- [(template: (<name> param subject)
- (<extension> subject param))]
-
- [!n/+ "lux i64 +"]
- [!n/- "lux i64 -"]
- )
-
(template: (!guarantee-no-new-lines content body)
(case ("lux text index" content (static text.new-line) 0)
(#.Some g!_)
@@ -294,45 +295,23 @@
(#error.Error error)
(#error.Error error)))
-(def: (parse-nat start [where offset source-code])
- (-> Offset Parser)
- (loop [end offset]
- (case ("lux text char" source-code end)
- (#.Some char)
- (if (!digit?+ char)
- (recur (!inc end))
- (!discrete-output number.Codec<Text,Nat> #.Nat))
-
- _
- (!discrete-output number.Codec<Text,Nat> #.Nat))))
-
-(def: (parse-int start [where offset source-code])
- (-> Offset Parser)
- (loop [end offset]
- (case ("lux text char" source-code end)
- (#.Some char)
- (if (!digit?+ char)
- (recur (!inc end))
- (!discrete-output number.Codec<Text,Int> #.Int))
-
- _
- (!discrete-output number.Codec<Text,Int> #.Int))))
-
-(def: (parse-rev start [where offset source-code])
- (-> Offset Parser)
- (loop [end offset]
- (case ("lux text char" source-code end)
- (#.Some char)
- (if (!digit?+ char)
- (recur (!inc end))
- (!discrete-output number.Codec<Text,Rev> #.Rev))
-
- _
- (!discrete-output number.Codec<Text,Rev> #.Rev))))
+(do-template [<name> <codec> <tag>]
+ [(def: (<name> start [where offset source-code])
+ (-> Offset Parser)
+ (loop [end offset]
+ (<| (!with-char source-code end char (!discrete-output <codec> <tag>))
+ (if (!digit?+ char)
+ (recur (!inc end))
+ (!discrete-output <codec> <tag>)))))]
+
+ [parse-nat number.Codec<Text,Nat> #.Nat]
+ [parse-int number.Codec<Text,Int> #.Int]
+ [parse-rev number.Codec<Text,Rev> #.Rev]
+ )
-(template: (!parse-int offset where source-code)
+(template: (!parse-int offset where source-code @end)
(let [g!offset/1 (!inc offset)]
- (<| (!with-char source-code g!offset/1 g!char/1)
+ (<| (!with-char source-code g!offset/1 g!char/1 @end)
(if (!digit? g!char/1)
(parse-int offset [where (!inc/2 offset) source-code])
(!parse-full-name offset [where (!inc offset) source-code] where #.Identifier)))))
@@ -344,16 +323,12 @@
(def: (parse-name-part start [where offset source-code])
(-> Offset Source (Error [Source Text]))
(loop [end offset]
- (case ("lux text char" source-code end)
- (#.Some char)
- (cond (!name-char? char)
- (recur (!inc end))
+ (<| (!with-char source-code end char <output>)
+ (cond (!name-char? char)
+ (recur (!inc end))
- ## else
- <output>)
-
- _
- <output>))))
+ ## else
+ <output>)))))
(template: (!new-line where)
(let [[where::file where::line where::column] where]
@@ -364,14 +339,6 @@
<consume-1> (as-is [where (!inc offset/0) source-code])
<consume-2> (as-is [where (!inc/2 offset/0) source-code])]
- (template: (!with-char @source-code @offset @char @body)
- (case ("lux text char" @source-code @offset)
- (#.Some @char)
- @body
-
- _
- <end>))
-
(template: (!parse-half-name @offset//pre @offset//post @char @module)
(let [@offset//post (!inc @offset//pre)]
(cond (!name-char?|head @char)
@@ -387,11 +354,11 @@
(`` (def: (parse-short-name current-module [where offset/0 source-code])
(-> Text Source (Error [Source Name]))
- (<| (!with-char source-code offset/0 char/0)
+ (<| (!with-char source-code offset/0 char/0 <end>)
(case char/0
(^ (char (~~ (static ..name-separator))))
(let [offset/1 (!inc offset/0)]
- (<| (!with-char source-code offset/1 char/1)
+ (<| (!with-char source-code offset/1 char/1 <end>)
(!parse-half-name offset/1 offset/2 char/1 current-module)))
_
@@ -411,23 +378,19 @@
(case (..parse-name-part start source)
(#error.Success [source' simple])
(let [[where' offset' source-code'] source']
- (case ("lux text char" source-code' offset')
- (#.Some char/separator)
- (case char/separator
- (^ (char (~~ (static ..name-separator))))
- (let [offset'' (!inc offset')]
- (case (..parse-name-part offset'' [where' offset'' source-code'])
- (#error.Success [source'' complex])
- (#error.Success [source'' [simple complex]])
-
- (#error.Error error)
- (#error.Error error)))
+ (<| (!with-char source-code' offset' char/separator <simple>)
+ (case char/separator
+ (^ (char (~~ (static ..name-separator))))
+ (let [offset'' (!inc offset')]
+ (case (..parse-name-part offset'' [where' offset'' source-code'])
+ (#error.Success [source'' complex])
+ (#error.Success [source'' [simple complex]])
+
+ (#error.Error error)
+ (#error.Error error)))
- _
- <simple>)
-
- _
- <simple>))
+ _
+ <simple>)))
(#error.Error error)
(#error.Error error)))))
@@ -444,7 +407,7 @@
(-> Text Aliases Source (Error [Source Code]))
(let [parse' (parse current-module aliases)]
(loop [[where offset/0 source-code] source]
- (<| (!with-char source-code offset/0 char/0)
+ (<| (!with-char source-code offset/0 char/0 <end>)
(`` (case char/0
## White-space
(^template [<char> <direction>]
@@ -477,7 +440,7 @@
## Special code
(^ (char (~~ (static ..sigil))))
(let [offset/1 (!inc offset/0)]
- (<| (!with-char source-code offset/1 char/1)
+ (<| (!with-char source-code offset/1 char/1 <end>)
(case char/1
(^template [<char> <bit>]
(^ (char <char>))
@@ -509,14 +472,14 @@
(^ (char (~~ (static ..name-separator))))
(let [offset/1 (!inc offset/0)]
- (<| (!with-char source-code offset/1 char/1)
+ (<| (!with-char source-code offset/1 char/1 <end>)
(if (!digit? char/1)
(parse-rev offset/0 [where (!inc offset/1) source-code])
(!parse-short-name current-module <consume-1> where #.Identifier))))
(^template [<sign>]
(^ (char <sign>))
- (!parse-int offset/0 where source-code))
+ (!parse-int offset/0 where source-code <end>))
([(~~ (static ..positive-sign))]
[(~~ (static ..negative-sign))])
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-18 16:01:55 +0000