From d4f1c93801003d68cb15e792f81784be1d488020 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 22 Aug 2018 00:22:23 -0400 Subject: Full parsing of names (for both identifiers and tags). --- stdlib/source/lux/compiler/default.lux | 4 +- stdlib/source/lux/compiler/default/syntax.lux | 261 ++++++++++++++++---------- stdlib/source/lux/interpreter.lux | 2 +- 3 files changed, 169 insertions(+), 98 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index 16c1a2b0e..e9678c87c 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -36,8 +36,6 @@ ## [cache/io]) ) -(def: #export prelude Text "lux") - (def: (read current-module aliases) (-> Text Aliases (analysis.Operation Code)) (function (_ [bundle compiler]) @@ -186,7 +184,7 @@ (-> Configuration (! Any))) (do (:: (get@ #file-system platform) &monad) [compiler (initialize platform configuration translation-bundle) - _ (compile-module platform (set@ #cli.module ..prelude configuration) compiler) + _ (compile-module platform (set@ #cli.module syntax.prelude configuration) compiler) _ (compile-module platform configuration compiler) ## _ (cache/io.clean target ...) ] diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 1ae6a8620..6a52687ec 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -82,6 +82,8 @@ (type: #export Aliases (Dictionary Text Text)) (def: #export no-aliases Aliases (dictionary.new text.Hash)) +(def: #export prelude Text "lux") + (def: digits "0123456789") (def: digits+ (format "_" ..digits)) @@ -623,12 +625,13 @@ (type: (Reader a) (-> Text Aliases (Simple a))) -(do-template [ ] +(do-template [ ] [(template: ( value) - ( value 1))] + ( value ))] - [!inc "lux i64 +"] - [!dec "lux i64 -"] + [!inc "lux i64 +" 1] + [!inc/2 "lux i64 +" 2] + [!dec "lux i64 -" 1] ) (do-template [ ] @@ -743,13 +746,12 @@ _ )))) -(with-expansions [ (#error.Success [tracker - [(update@ #.column (n/+ ("lux i64 -" end start)) where) +(with-expansions [ (#error.Success [[(update@ #.column (n/+ ("lux i64 -" end start)) where) end source-code] - ["" (!clip start end source-code)]])] - (def: (read-name start tracker [where offset source-code]) - (-> Offset (Simple Name)) + (!clip start end source-code)])] + (def: (read-name-part start [where offset source-code]) + (-> Offset Source (Error [Source Text])) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -769,98 +771,167 @@ (let [[where::file where::line where::column] where] [where::file (!inc where::line) 0])) -(template: (!read-name @offset @tracker @source @where @tag) - (case (..read-name @offset @tracker @source) - (#error.Success [tracker' source' name]) - (#error.Success [tracker' source' [@where (@tag name)]]) - - (#error.Error error) - (#error.Error error))) +(with-expansions [ (ex.throw end-of-file current-module) + (ex.throw unrecognized-input where) + (as-is [where ("lux i64 +" offset 1) source-code]) + (as-is [where ("lux i64 +" offset 2) source-code]) + (as-is [where ("lux i64 +" offset 3) source-code])] + + (template: (!with-char @source-code @offset @char @body) + (case ("lux text char" @source-code @offset) + (#.Some @char) + @body + + _ + )) + + (template: (!read-half-name @offset//pre @offset//post @char @module) + (let [@offset//post (!inc @offset//pre)] + (cond (!name-char?|head @char) + (case (..read-name-part @offset//post [where @offset//post source-code]) + (#error.Success [source' name]) + (#error.Success [source' [@module name]]) + + (#error.Error error) + (#error.Error error)) + + ## else + ))) + + (`` (def: (read-short-name current-module [where offset/0 source-code]) + (-> Text Source (Error [Source Name])) + (<| (!with-char source-code offset/0 char/0) + (case char/0 + (^ (char (~~ (static ..name-separator)))) + (let [offset/1 (!inc offset/0)] + (<| (!with-char source-code offset/1 char/1) + (!read-half-name offset/1 offset/2 char/1 current-module))) + + _ + (!read-half-name offset/0 offset/1 char/0 ..prelude))))) + + (template: (!read-short-name @current-module @tracker @source @where @tag) + (case (..read-short-name @current-module @source) + (#error.Success [source' name]) + (#error.Success [@tracker source' [@where (@tag name)]]) + + (#error.Error error) + (#error.Error error))) + + (with-expansions [ (as-is (#error.Success [source' ["" simple]]))] + (`` (def: (read-full-name start source) + (-> Offset Source (Error [Source Name])) + (case (..read-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 (..read-name-part offset'' [where' offset'' source-code']) + (#error.Success [source'' complex]) + (#error.Success [source'' [simple complex]]) + + (#error.Error error) + (#error.Error error))) -(with-expansions [ (as-is [where (!inc offset) source-code]) - (as-is (recur tracker - [where ("lux text size" source-code) source-code]))] + _ + ) + + _ + )) + + (#error.Error error) + (#error.Error error))))) + + (template: (!read-full-name @offset @tracker @source @where @tag) + (case (..read-full-name @offset @source) + (#error.Success [source' full-name]) + (#error.Success [@tracker source' [@where (@tag full-name)]]) + + (#error.Error error) + (#error.Error error))) + (def: (read-code current-module aliases tracker source) (Reader Code) (let [read-code' (read-code current-module aliases)] (loop [tracker tracker [where offset source-code] source] - (case ("lux text char" source-code offset) - (#.Some current) - (`` (case current - ## White-space - (^template [ ] - (^ (char )) - (recur tracker - [(update@ inc where) - (!inc offset) - source-code])) - ([(~~ (static ..white-space)) #.column] - [(~~ (static ..carriage-return)) #.column]) - - (^ (char (~~ (static ..new-line)))) - (recur tracker [(!new-line where) (!inc offset) source-code]) - - ## Form - (^ (char (~~ (static ..open-form)))) - (read-form read-code' tracker ) - - ## Tuple - (^ (char (~~ (static ..open-tuple)))) - (read-tuple read-code' tracker ) - - ## Text - (^ (char (~~ (static ..text-delimiter)))) - (read-text tracker ) - - ## Special code - (^ (char (~~ (static ..sigil)))) - (let [offset' (!inc offset)] - (case ("lux text char" source-code offset') - (#.Some next) - (case next - (^template [ ] - (^ (char )) - (#error.Success [tracker - [(update@ #.column (|>> !leap-bit) where) - (!leap-bit offset) - source-code] - [where (#.Bit )]])) - (["0" #0] - ["1" #1]) - - ## Single-line comment - (^ (char (~~ (static ..sigil)))) - (case ("lux text index" source-code (static ..new-line) offset') - (#.Some end) - (recur tracker [(!new-line where) (!inc end) source-code]) + (<| (!with-char source-code offset char/0) + (`` (case char/0 + ## White-space + (^template [ ] + (^ (char )) + (recur tracker + [(update@ inc where) + (!inc offset) + source-code])) + ([(~~ (static ..white-space)) #.column] + [(~~ (static ..carriage-return)) #.column]) + + (^ (char (~~ (static ..new-line)))) + (recur tracker [(!new-line where) (!inc offset) source-code]) + + ## Form + (^ (char (~~ (static ..open-form)))) + (read-form read-code' tracker ) + + ## Tuple + (^ (char (~~ (static ..open-tuple)))) + (read-tuple read-code' tracker ) + + ## Text + (^ (char (~~ (static ..text-delimiter)))) + (read-text tracker ) + + ## Special code + (^ (char (~~ (static ..sigil)))) + (let [offset' (!inc offset)] + (<| (!with-char source-code offset' char/1) + (case char/1 + (^template [ ] + (^ (char )) + (#error.Success [tracker + [(update@ #.column (|>> !leap-bit) where) + (!leap-bit offset) + source-code] + [where (#.Bit )]])) + (["0" #0] + ["1" #1]) + + ## Single-line comment + (^ (char (~~ (static ..sigil)))) + (case ("lux text index" source-code (static ..new-line) offset') + (#.Some end) + (recur tracker [(!new-line where) (!inc end) source-code]) + + _ + ) + + (^ (char (~~ (static ..name-separator)))) + (!read-short-name current-module tracker where #.Identifier) + + _ + (cond (!name-char?|head char/1) ## Tag + (!read-full-name offset tracker where #.Tag) + + ## else + )))) + + (^ (char (~~ (static ..name-separator)))) + (!read-short-name current-module tracker where #.Identifier) + + _ + (cond (!digit? char/0) ## Natural number + (read-nat offset tracker ) + + ## Identifier + (!name-char?|head char/0) + (!read-full-name offset tracker where #.Identifier) - _ - ) - - _ - (cond (!name-char?|head next) ## Tag - (!read-name offset tracker where #.Tag) - - ## else - (ex.throw unrecognized-input where))) - - _ - (ex.throw end-of-file current-module))) - - _ - (cond (!digit? current) ## Natural number - (read-nat offset tracker ) - - ## Identifier - (!name-char?|head current) - (!read-name offset tracker where #.Identifier) - - ## else - (ex.throw unrecognized-input where)))) - - _ - (ex.throw end-of-file current-module)))))) + ## else + )))))))) ## [where offset source-code] (def: #export (read current-module aliases source) @@ -880,3 +951,5 @@ ## (#error.Success [[offset' remaining] [where' output]]) ## (#error.Success [[where' offset' remaining] output]))) + +## (yolo) diff --git a/stdlib/source/lux/interpreter.lux b/stdlib/source/lux/interpreter.lux index 36cef324d..df475475a 100644 --- a/stdlib/source/lux/interpreter.lux +++ b/stdlib/source/lux/interpreter.lux @@ -68,7 +68,7 @@ (do Monad [state (default.initialize platform configuration) state (default.compile-module platform - (set@ #cli.module default.prelude configuration) + (set@ #cli.module syntax.prelude configuration) (set@ [#extension.state #statement.analysis #statement.state #extension.state -- cgit v1.2.3