From bb1f029e20a522546907fca47370649a1668c1bf Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 14 Apr 2019 00:49:00 -0400 Subject: Fixed a bug when closing composite syntax (forms, tuples & records) in the presence of comments at the end of the composite. --- stdlib/source/lux/macro/template.lux | 4 +- stdlib/source/lux/tool/compiler/default/init.lux | 4 +- stdlib/source/lux/tool/compiler/default/syntax.lux | 253 ++++++++++++--------- 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 ) (case - (#error.Success ) + (#.Right ) - (#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 [ (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 +(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 closing-char where offset source-code) + (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 (if (!n/= closing-char char) - (#error.Success (!inc end)) + (#.Right [ []]) (`` ("lux syntax char case!" char [[(~~ (static ..space)) - (~~ (static text.carriage-return)) - (~~ (static text.new-line))] - (recur (!inc end))] + (~~ (static text.carriage-return))] + (recur ) + + [(~~ (static text.new-line))] + (recur (!vertical where offset source-code))] ## else )))))))) (template [ ] - [(`` (def: ( 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 ))) source-code//size source-code offset) - (#error.Success [[(update@ #.column inc where) offset' source-code] - [where ( (list.reverse stack))]]))))))))] + [(with-expansions [ (!cannot-close (`` (char (~~ (static )))) where' offset' source-code')] + (def: ( 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 ) + (if (!n/= (`` (char (~~ (static )))) @close) + (#.Right [[where' (!inc offset') source-code'] + [where ( (list.reverse stack))]]) + ))) + (#.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 (`` (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 ) + (if (!n/= (`` (char (~~ (static ..close-record)))) @close) + (#.Right [[where' (!inc offset') source-code'] + [where (#.Record (list.reverse stack))]]) + ))) + (#.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 ) - (!letE output (:: decode (!clip source-code)) - (#error.Success [[(update@ #.column (n/+ (!n/- )) where) - - source-code] - [where ( output)]]))) + (case (:: decode (!clip source-code)) + (#.Right output) + (#.Right [[(update@ #.column (n/+ (!n/- )) where) + + source-code] + [where ( output)]]) + + (#.Left error) + (#.Left [[where source-code] + error]))) (def: no-exponent Offset 0) (with-expansions [ (as-is (!number-output start end int.decimal #.Int)) (as-is (!number-output start end frac.decimal #.Frac)) - (ex.throw unrecognized-input [where "Frac" source-code offset])] + (#.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 [ (#error.Success [[(update@ #.column (n/+ (!n/- start end)) where) - end - source-code] - (!clip start end source-code)])] +(with-expansions [ (#.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)) )))))) -(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 [ (ex.throw end-of-file current-module) - (ex.throw unrecognized-input [where "General" source-code offset/0]) - (#error.Failure close-signal) +(with-expansions [ (#.Left [[where offset/0 source-code] ..close-signal]) (as-is [where (!inc offset/0) source-code]) (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 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 ) + (<| (!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 ) + (<| (!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 [ (as-is (#error.Success [source' ["" simple]]))] + (with-expansions [ (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]]))) ))))))) (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: (<>) [(~~ (static ..close-form)) @@ -426,20 +471,19 @@ ## (grammar: lux-grammar ## [expression ...] ## [form "(" [#* expression] ")"]) - - (with-expansions [ (as-is (parse current-module aliases source-code//size)) - (as-is (recur [(update@ #.column inc where) - (!inc offset/0) - source-code]))] + + (with-expansions [ (as-is (parse current-module aliases source-code//size)) + (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 ) - ## 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) ("lux syntax char case!" char/0 @@ -448,19 +492,19 @@ [(~~ (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-form

) ## Tuple [(~~ (static ..open-tuple))] - (parse-tuple

) + (parse-tuple

) ## Record [(~~ (static ..open-record))] - (parse-record

) + (parse-record

) ## 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 ) + (<| (!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 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 where offset/1 source-code current-module)) (~~ (template [ ] [[] - (#error.Success [[(update@ #.column (|>> !inc/2) where) - (!inc offset/1) - source-code] - [where (#.Bit )]])] + (#.Right [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) + source-code] + [where (#.Bit )]])] ["0" #0] ["1" #1]))] @@ -499,12 +544,13 @@ (!parse-full-name offset/1 where #.Tag) ## else - )))) + (!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 ) + (<| (!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 ) + (!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... (~~ (<>)) -- cgit v1.2.3