From a7f0b1e2c0f2c7c2f5d3fb0ea6e35e3f5957e1fd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Aug 2018 22:20:43 -0400 Subject: Added a special compiler optimization to pattern-match on characters faster. --- stdlib/source/lux/compiler/default/syntax.lux | 102 +++++++++++++------------- 1 file changed, 52 insertions(+), 50 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index d724a150b..1584321e5 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -410,7 +410,10 @@ (#error.Error error) (#error.Error error))) - (with-expansions [ (as-is (parse current-module aliases source-code//size))] + (with-expansions [ (as-is (parse current-module aliases source-code//size)) + (as-is (recur [(update@ #.column inc where) + (!inc offset/0) + source-code]))] (def: #export (parse current-module aliases source-code//size) (-> Text Aliases Nat (-> Source (Error [Source Code]))) ## The "exec []" is only there to avoid function fusion. @@ -418,51 +421,50 @@ (exec [] (function (recur [where offset/0 source-code]) (<| (!with-char+ source-code//size source-code offset/0 char/0 ) - (`` (case char/0 - ## White-space - (^template [ ] - (^ (char )) - (recur [(update@ inc where) - (!inc offset/0) - source-code])) - ([(~~ (static ..space)) #.column] - [(~~ (static text.carriage-return)) #.column]) - - (^ (char (~~ (static text.new-line)))) + (`` ("lux syntax char case!" char/0 + [## White-space + (~~ (static ..space)) + + + (~~ (static text.carriage-return)) + + + (~~ (static text.new-line)) (recur [(!new-line where) (!inc offset/0) source-code]) ## Form - (^ (char (~~ (static ..open-form)))) + (~~ (static ..open-form)) (parse-form ) ## Tuple - (^ (char (~~ (static ..open-tuple)))) + (~~ (static ..open-tuple)) (parse-tuple ) ## Record - (^ (char (~~ (static ..open-record)))) + (~~ (static ..open-record)) (parse-record ) ## Text - (^ (char (~~ (static ..text-delimiter)))) + (~~ (static ..text-delimiter)) (read-text ) ## Special code - (^ (char (~~ (static ..sigil)))) + (~~ (static ..sigil)) (let [offset/1 (!inc offset/0)] (<| (!with-char+ source-code//size source-code offset/1 char/1 ) - (case char/1 - (^template [ ] - (^ (char )) - (#error.Success [[(update@ #.column (|>> !inc/2) where) - (!inc offset/1) - source-code] - [where (#.Bit )]])) - (["0" #0] - ["1" #1]) + ("lux syntax char case!" char/1 + [(~~ (do-template [ ] + [ + (#error.Success [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) + source-code] + [where (#.Bit )]])] + + ["0" #0] + ["1" #1])) ## Single-line comment - (^ (char (~~ (static ..sigil)))) + (~~ (static ..sigil)) (case ("lux text index" source-code (static text.new-line) offset/1) (#.Some end) (recur [(!new-line where) (!inc end) source-code]) @@ -470,36 +472,36 @@ _ ) - (^ (char (~~ (static ..name-separator)))) - (!parse-short-name current-module where #.Identifier) + (~~ (static ..name-separator)) + (!parse-short-name current-module where #.Identifier)] - _ - (cond (!name-char?|head char/1) ## Tag - (!parse-full-name offset/1 where #.Tag) + ## else + (cond (!name-char?|head char/1) ## Tag + (!parse-full-name offset/1 where #.Tag) - ## else - )))) + ## else + )))) - (^ (char (~~ (static ..name-separator)))) + (~~ (static ..name-separator)) (let [offset/1 (!inc offset/0)] (<| (!with-char+ source-code//size source-code offset/1 char/1 ) (if (!digit? char/1) (parse-rev offset/0 [where (!inc offset/1) source-code]) (!parse-short-name current-module where #.Identifier)))) - (^template [] - (^ (char )) - (!parse-int source-code//size offset/0 where source-code )) - ([(~~ (static ..positive-sign))] - [(~~ (static ..negative-sign))]) + (~~ (static ..positive-sign)) + (!parse-int source-code//size offset/0 where source-code ) - _ - (cond (!digit? char/0) ## Natural number - (parse-nat offset/0 ) - - ## Identifier - (!name-char?|head char/0) - (!parse-full-name offset/0 where #.Identifier) - - ## else - ))))))))) + (~~ (static ..negative-sign)) + (!parse-int source-code//size offset/0 where source-code )] + + ## else + (cond (!digit? char/0) ## Natural number + (parse-nat offset/0 ) + + ## Identifier + (!name-char?|head char/0) + (!parse-full-name offset/0 where #.Identifier) + + ## else + ))))))))) -- cgit v1.2.3