aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/macro/template.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/default/syntax.lux253
3 files changed, 154 insertions, 107 deletions
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index ad1600856..55000aa31 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -24,8 +24,8 @@
(syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))}
body)
(do @
- [g!locals (|> (//.gensym "local")
- (list.repeat (list.size locals))
+ [g!locals (|> locals
+ (list@map //.gensym)
(monad.seq @))]
(wrap (list (` (.with-expansions [(~+ (|> (list.zip2 locals g!locals)
(list@map (function (_ [name identifier])
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 8cea72d0e..f5166fc25 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -94,7 +94,7 @@
#///statement.phase generate}}]))
(type: Reader
- (-> Source (Error [Source Code])))
+ (-> Source (Either [Source Text] [Source Code])))
(def: (reader current-module aliases [cursor offset source-code])
(-> Module Aliases Source (///analysis.Operation Reader))
@@ -106,7 +106,7 @@
(-> Source Reader (///analysis.Operation [Source Code]))
(function (_ [bundle compiler])
(case (reader source)
- (#error.Failure error)
+ (#error.Failure [source' error])
(#error.Failure error)
(#error.Success [source' output])
diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux
index af538b1a8..d5ea0757e 100644
--- a/stdlib/source/lux/tool/compiler/default/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/default/syntax.lux
@@ -42,7 +42,9 @@
format]
[collection
["." list]
- ["." dictionary (#+ Dictionary)]]]])
+ ["." dictionary (#+ Dictionary)]]]
+ [macro
+ ["." template]]])
## TODO: Optimize how forms, tuples & records are parsed in the end.
## There is repeated-work going on when parsing the white-space before the
@@ -151,7 +153,7 @@
(input-at offset source-code))]))
(type: (Parser a)
- (-> Source (Error [Source a])))
+ (-> Source (Either [Source Text] [Source a])))
(template: (!with-char+ @source-code-size @source-code @offset @char @else @body)
(if (!i/< (:coerce Int @source-code-size)
@@ -165,46 +167,74 @@
(template: (!letE <binding> <computation> <body>)
(case <computation>
- (#error.Success <binding>)
+ (#.Right <binding>)
<body>
- (#error.Failure error)
- (#error.Failure error)))
+ (#.Left error)
+ (#.Left error)))
-(def: close-signal "CLOSE")
+(template: (!horizontal where offset source-code)
+ [(update@ #.column inc where)
+ (!inc offset)
+ source-code])
-(with-expansions [<cannot-close> (as-is (ex.throw cannot-close-composite-expression [closing-char source-code end]))]
- (def: (read-close closing-char source-code//size source-code offset)
- (-> Char Nat Text Offset (Error Offset))
- (loop [end offset]
- (<| (!with-char+ source-code//size source-code end char <cannot-close>
+(template: (!new-line where)
+ ## (-> Cursor Cursor)
+ (let [[where::file where::line where::column] where]
+ [where::file (!inc where::line) 0]))
+
+(template: (!vertical where offset source-code)
+ [(!new-line where)
+ (!inc offset)
+ source-code])
+
+(def: close-signal
+ (template.with-locals [g!close-signal]
+ (template.text [g!close-signal])))
+
+(template: (!cannot-close close-char where offset source-code)
+ (#.Left [[where offset source-code]
+ (ex.construct cannot-close-composite-expression [close-char source-code offset])]))
+
+(with-expansions [<cannot-close> (!cannot-close closing-char where offset source-code)
+ <horizontal> (as-is (!horizontal where offset source-code))]
+ (def: (read-close closing-char source)
+ (-> Char (Parser Any))
+ (loop [[where offset source-code] source]
+ (<| (!with-char+ ("lux text size" source-code) source-code offset char <cannot-close>
(if (!n/= closing-char char)
- (#error.Success (!inc end))
+ (#.Right [<horizontal> []])
(`` ("lux syntax char case!" char
[[(~~ (static ..space))
- (~~ (static text.carriage-return))
- (~~ (static text.new-line))]
- (recur (!inc end))]
+ (~~ (static text.carriage-return))]
+ (recur <horizontal>)
+
+ [(~~ (static text.new-line))]
+ (recur (!vertical where offset source-code))]
## else
<cannot-close>))))))))
(template [<name> <close> <tag> <context>]
- [(`` (def: (<name> parse source)
- (-> (Parser Code) (Parser Code))
- (let [[_ _ source-code] source
- source-code//size ("lux text size" source-code)]
- (loop [source source
- stack (: (List Code) #.Nil)]
- (case (parse source)
- (#error.Success [source' top])
- (recur source' (#.Cons top stack))
-
- (#error.Failure error)
- (let [[where offset _] source]
- (!letE offset' (read-close (char (~~ (static <close>))) source-code//size source-code offset)
- (#error.Success [[(update@ #.column inc where) offset' source-code]
- [where (<tag> (list.reverse stack))]]))))))))]
+ [(with-expansions [<cannot-close> (!cannot-close (`` (char (~~ (static <close>)))) where' offset' source-code')]
+ (def: (<name> parse source)
+ (-> (Parser Code) (Parser Code))
+ (let [[where _ _] source]
+ (loop [source source
+ stack (: (List Code) #.Nil)]
+ (case (parse source)
+ (#.Right [source' top])
+ (recur source' (#.Cons top stack))
+
+ (#.Left [source' error])
+ (if (is? ..close-signal error)
+ (let [[where' offset' source-code'] source']
+ (<| (!with-char source-code' offset' @close <cannot-close>)
+ (if (!n/= (`` (char (~~ (static <close>)))) @close)
+ (#.Right [[where' (!inc offset') source-code']
+ [where (<tag> (list.reverse stack))]])
+ <cannot-close>)))
+ (#.Left [source' error])))))))]
## Form and tuple syntax is mostly the same, differing only in the
## delimiters involved.
@@ -213,44 +243,50 @@
[parse-tuple ..close-tuple #.Tuple "Tuple"]
)
-(def: (parse-record parse source)
- (-> (Parser Code) (Parser Code))
- (let [[_ _ source-code] source
- source-code//size ("lux text size" source-code)]
- (loop [source source
- stack (: (List [Code Code]) #.Nil)]
- (case (parse source)
- (#error.Success [sourceF field])
- (!letE [sourceFV value] (parse sourceF)
- (recur sourceFV (#.Cons [field value] stack)))
-
- (#error.Failure error)
- (let [[where offset _] source]
- (!letE offset' (read-close (`` (char (~~ (static ..close-record)))) source-code//size source-code offset)
- (#error.Success [[(update@ #.column inc where) offset' source-code]
- [where (#.Record (list.reverse stack))]])))))))
-
-(template: (!guarantee-no-new-lines content body)
+(with-expansions [<cannot-close> (!cannot-close (`` (char (~~ (static ..close-record)))) where' offset' source-code')]
+ (def: (parse-record parse source)
+ (-> (Parser Code) (Parser Code))
+ (let [[where _ _] source]
+ (loop [source source
+ stack (: (List [Code Code]) #.Nil)]
+ (case (parse source)
+ (#.Right [sourceF field])
+ (!letE [sourceFV value] (parse sourceF)
+ (recur sourceFV (#.Cons [field value] stack)))
+
+ (#.Left [source' error])
+ (if (is? ..close-signal error)
+ (let [[where' offset' source-code'] source']
+ (<| (!with-char source-code' offset' @close <cannot-close>)
+ (if (!n/= (`` (char (~~ (static ..close-record)))) @close)
+ (#.Right [[where' (!inc offset') source-code']
+ [where (#.Record (list.reverse stack))]])
+ <cannot-close>)))
+ (#.Left [source' error])))))))
+
+(template: (!guarantee-no-new-lines where offset source-code content body)
(case ("lux text index" 0 (static text.new-line) content)
#.None
body
g!_
- (ex.throw ..text-cannot-contain-new-lines content)))
+ (#.Left [[where offset source-code]
+ (ex.construct ..text-cannot-contain-new-lines content)])))
(template: (!read-text where offset source-code)
(case ("lux text index" offset (static ..text-delimiter) source-code)
(#.Some g!end)
(let [g!content (!clip offset g!end source-code)]
- (<| (!guarantee-no-new-lines g!content)
- (#error.Success [[(update@ #.column (n/+ (!n/- offset g!end)) where)
- (!inc g!end)
- source-code]
- [where
- (#.Text g!content)]])))
+ (<| (!guarantee-no-new-lines where offset source-code g!content)
+ (#.Right [[(update@ #.column (n/+ (!n/- offset g!end)) where)
+ (!inc g!end)
+ source-code]
+ [where
+ (#.Text g!content)]])))
_
- (ex.throw unrecognized-input [where "Text" source-code offset])))
+ (#.Left [[where offset source-code]
+ (ex.construct unrecognized-input [where "Text" source-code offset])])))
(def: digit-bottom Nat (!dec (char "0")))
(def: digit-top Nat (!inc (char "9")))
@@ -288,17 +324,23 @@
(!digit? char)))
(template: (!number-output <start> <end> <codec> <tag>)
- (!letE output (:: <codec> decode (!clip <start> <end> source-code))
- (#error.Success [[(update@ #.column (n/+ (!n/- <start> <end>)) where)
- <end>
- source-code]
- [where (<tag> output)]])))
+ (case (:: <codec> decode (!clip <start> <end> source-code))
+ (#.Right output)
+ (#.Right [[(update@ #.column (n/+ (!n/- <start> <end>)) where)
+ <end>
+ source-code]
+ [where (<tag> output)]])
+
+ (#.Left error)
+ (#.Left [[where <start> source-code]
+ error])))
(def: no-exponent Offset 0)
(with-expansions [<int-output> (as-is (!number-output start end int.decimal #.Int))
<frac-output> (as-is (!number-output start end frac.decimal #.Frac))
- <failure> (ex.throw unrecognized-input [where "Frac" source-code offset])]
+ <failure> (#.Left [[where offset source-code]
+ (ex.construct unrecognized-input [where "Frac" source-code offset])])]
(def: (parse-frac source-code//size start [where offset source-code])
(-> Nat Offset (Parser Code))
(loop [end offset
@@ -356,10 +398,10 @@
(parse-signed offset [where (!inc/2 offset) source-code])
(!parse-full-name offset [where (!inc offset) source-code] where #.Identifier)))))
-(with-expansions [<output> (#error.Success [[(update@ #.column (n/+ (!n/- start end)) where)
- end
- source-code]
- (!clip start end source-code)])]
+(with-expansions [<output> (#.Right [[(update@ #.column (n/+ (!n/- start end)) where)
+ end
+ source-code]
+ (!clip start end source-code)])]
(def: (parse-name-part start [where offset source-code])
(-> Offset (Parser Text))
(let [source-code//size ("lux text size" source-code)]
@@ -369,39 +411,42 @@
(recur (!inc end))
<output>))))))
-(template: (!new-line where)
- ## (-> Cursor Cursor)
- (let [[where::file where::line where::column] where]
- [where::file (!inc where::line) 0]))
+(template: (!failure where offset source-code)
+ (#.Left [[where offset source-code]
+ (ex.construct unrecognized-input [where "General" source-code offset])]))
+
+(template: (!end-of-file where offset source-code current-module)
+ (#.Left [[where offset source-code]
+ (ex.construct ..end-of-file current-module)]))
-(with-expansions [<end-of-file> (ex.throw end-of-file current-module)
- <failure> (ex.throw unrecognized-input [where "General" source-code offset/0])
- <close!> (#error.Failure close-signal)
+(with-expansions [<close!> (#.Left [[where offset/0 source-code] ..close-signal])
<consume-1> (as-is [where (!inc offset/0) source-code])
<consume-2> (as-is [where (!inc/2 offset/0) source-code])]
(template: (!parse-half-name @offset @char @module)
(cond (!name-char?|head @char)
(!letE [source' name] (..parse-name-part @offset [where (!inc @offset) source-code])
- (#error.Success [source' [@module name]]))
+ (#.Right [source' [@module name]]))
## else
- <failure>))
+ (!failure where @offset source-code)))
(`` (def: (parse-short-name current-module [where offset/0 source-code])
(-> Text (Parser Name))
- (<| (!with-char source-code offset/0 char/0 <end-of-file>)
+ (<| (!with-char source-code offset/0 char/0
+ (!end-of-file where offset/0 source-code current-module))
(if (!n/= (char (~~ (static ..name-separator))) char/0)
(let [offset/1 (!inc offset/0)]
- (<| (!with-char source-code offset/1 char/1 <end-of-file>)
+ (<| (!with-char source-code offset/1 char/1
+ (!end-of-file where offset/1 source-code current-module))
(!parse-half-name offset/1 char/1 current-module)))
(!parse-half-name offset/0 char/0 ..prelude)))))
(template: (!parse-short-name @current-module @source @where @tag)
(!letE [source' name] (..parse-short-name @current-module @source)
- (#error.Success [source' [@where (@tag name)]])))
+ (#.Right [source' [@where (@tag name)]])))
- (with-expansions [<simple> (as-is (#error.Success [source' ["" simple]]))]
+ (with-expansions [<simple> (as-is (#.Right [source' ["" simple]]))]
(`` (def: (parse-full-name start source)
(-> Offset (Parser Name))
(!letE [source' simple] (..parse-name-part start source)
@@ -410,12 +455,12 @@
(if (!n/= (char (~~ (static ..name-separator))) char/separator)
(let [offset'' (!inc offset')]
(!letE [source'' complex] (..parse-name-part offset'' [where' offset'' source-code'])
- (#error.Success [source'' [simple complex]])))
+ (#.Right [source'' [simple complex]])))
<simple>)))))))
(template: (!parse-full-name @offset @source @where @tag)
(!letE [source' full-name] (..parse-full-name @offset @source)
- (#error.Success [source' [@where (@tag full-name)]])))
+ (#.Right [source' [@where (@tag full-name)]])))
(`` (template: (<<closers>>)
[(~~ (static ..close-form))
@@ -426,20 +471,19 @@
## (grammar: lux-grammar
## [expression ...]
## [form "(" [#* expression] ")"])
-
- (with-expansions [<parse> (as-is (parse current-module aliases source-code//size))
- <horizontal-move> (as-is (recur [(update@ #.column inc where)
- (!inc offset/0)
- source-code]))]
+
+ (with-expansions [<recur> (as-is (parse current-module aliases source-code//size))
+ <horizontal-move> (as-is (recur (!horizontal where offset/0 source-code)))]
(def: #export (parse current-module aliases source-code//size)
(-> Text Aliases Nat (Parser Code))
## The "exec []" is only there to avoid function fusion.
## This is to preserve the loop as much as possible and keep it tight.
(exec []
(function (recur [where offset/0 source-code])
- (<| (!with-char+ source-code//size source-code offset/0 char/0 <end-of-file>)
- ## The space was singled-out for special treatment
- ## because of how common it is.
+ (<| (!with-char+ source-code//size source-code offset/0 char/0
+ (!end-of-file where offset/0 source-code current-module))
+ ## TODO: Add ..space as just another case for "lux syntax char case!" ASAP.
+ ## It"s currently failing for some reason.
(`` (if (!n/= (char (~~ (static ..space))) char/0)
<horizontal-move>
("lux syntax char case!" char/0
@@ -448,19 +492,19 @@
<horizontal-move>
[(~~ (static text.new-line))]
- (recur [(!new-line where) (!inc offset/0) source-code])
+ (recur (!vertical where offset/0 source-code))
## Form
[(~~ (static ..open-form))]
- (parse-form <parse> <consume-1>)
+ (parse-form <recur> <consume-1>)
## Tuple
[(~~ (static ..open-tuple))]
- (parse-tuple <parse> <consume-1>)
+ (parse-tuple <recur> <consume-1>)
## Record
[(~~ (static ..open-record))]
- (parse-record <parse> <consume-1>)
+ (parse-record <recur> <consume-1>)
## Text
[(~~ (static ..text-delimiter))]
@@ -470,7 +514,8 @@
## Special code
[(~~ (static ..sigil))]
(let [offset/1 (!inc offset/0)]
- (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
+ (<| (!with-char+ source-code//size source-code offset/1 char/1
+ (!end-of-file where offset/1 source-code current-module))
("lux syntax char case!" char/1
[[(~~ (static ..name-separator))]
(!parse-short-name current-module <consume-2> where #.Tag)
@@ -479,17 +524,17 @@
[(~~ (static ..sigil))]
(case ("lux text index" (!inc offset/1) (static text.new-line) source-code)
(#.Some end)
- (recur [(!new-line where) (!inc end) source-code])
+ (recur (!vertical where end source-code))
_
- <end-of-file>)
+ (!end-of-file where offset/1 source-code current-module))
(~~ (template [<char> <bit>]
[[<char>]
- (#error.Success [[(update@ #.column (|>> !inc/2) where)
- (!inc offset/1)
- source-code]
- [where (#.Bit <bit>)]])]
+ (#.Right [[(update@ #.column (|>> !inc/2) where)
+ (!inc offset/1)
+ source-code]
+ [where (#.Bit <bit>)]])]
["0" #0]
["1" #1]))]
@@ -499,12 +544,13 @@
(!parse-full-name offset/1 <consume-2> where #.Tag)
## else
- <failure>))))
+ (!failure where offset/0 source-code)))))
## Coincidentally (= name-separator frac-separator)
[(~~ (static ..name-separator))]
(let [offset/1 (!inc offset/0)]
- (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
+ (<| (!with-char+ source-code//size source-code offset/1 char/1
+ (!end-of-file where offset/1 source-code current-module))
(if (!digit? char/1)
(let [offset/2 (!inc offset/1)]
(!parse-rev source-code//size offset/0 where offset/2 source-code))
@@ -512,7 +558,8 @@
[(~~ (static ..positive-sign))
(~~ (static ..negative-sign))]
- (!parse-signed source-code//size offset/0 where source-code <end-of-file>)
+ (!parse-signed source-code//size offset/0 where source-code
+ (!end-of-file where offset/0 source-code current-module))
## Invalid characters at this point...
(~~ (<<closers>>))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 08:01:54 +0000