From 0fcb373ed1cdc2750f02e5535d29569dd8ae5a5b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 17 Mar 2019 22:19:33 -0400 Subject: Minor improvements. --- stdlib/source/lux.lux | 42 +++++++++------------ stdlib/source/lux/macro.lux | 9 +++-- stdlib/source/lux/tool/compiler/default/syntax.lux | 44 +++++++++++----------- .../lux/tool/compiler/phase/analysis/module.lux | 16 +++++--- 4 files changed, 55 insertions(+), 56 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 549d63112..323615249 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5356,37 +5356,31 @@ (-> Type Code) (case type (#Primitive name params) - (` (#Primitive (~ (text$ name)) (~ (untemplate-list (list;map type-to-code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list;map type-to-code params))))) (^template [] ( left right) (` ( (~ (type-to-code left)) (~ (type-to-code right))))) - ([#Sum] [#Product]) - - (#Function in out) - (` (#Function (~ (type-to-code in)) (~ (type-to-code out)))) - - (#Parameter idx) - (` (#Parameter (~ (nat$ idx)))) - - (#Var id) - (` (#Var (~ (nat$ id)))) + ([#.Sum] [#.Product] + [#.Function] + [#.Apply]) - (#Ex id) - (` (#Ex (~ (nat$ id)))) - - (#UnivQ env type) - (let [env' (untemplate-list (list;map type-to-code env))] - (` (#UnivQ (~ env') (~ (type-to-code type))))) + (^template [] + ( id) + (` ( (~ (nat$ id))))) + ([#.Parameter] [#.Var] [#.Ex]) - (#ExQ env type) - (let [env' (untemplate-list (list;map type-to-code env))] - (` (#ExQ (~ env') (~ (type-to-code type))))) + (^template [] + ( env type) + (let [env' (untemplate-list (list;map type-to-code env))] + (` ( (~ env') (~ (type-to-code type)))))) + ([#.UnivQ] [#.ExQ]) - (#Apply arg fun) - (` (#Apply (~ (type-to-code arg)) (~ (type-to-code fun)))) - - (#Named [module name] type) + (#Named [module name] anonymous) + ## TODO: Generate the explicit type definition instead of using + ## the "identifier$" shortcut below. + ## (` (#.Named [(~ (text$ module)) (~ (text$ name))] + ## (~ (type-to-code anonymous)))) (identifier$ [module name]))) (macro: #export (loop tokens) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 2a9c55488..e44efeb6c 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -511,19 +511,20 @@ (#error.Success [compiler definition]) _ - (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))] + (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???")) + separator ($_ text;compose text.new-line " ")] (#error.Failure ($_ text;compose "Unknown definition: " (name;encode name) text.new-line " Current module: " current-module text.new-line (case (get current-module (get@ #.modules compiler)) (#.Some this-module) ($_ text;compose - " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) text.new-line - " Aliases: " (|> this-module (get@ #.module-aliases) (list;map (function (_ [alias real]) ($_ text;compose alias " => " real))) (text.join-with ", ")) text.new-line) + " Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line + " Aliases: " (|> this-module (get@ #.module-aliases) (list;map (function (_ [alias real]) ($_ text;compose alias " => " real))) (text.join-with separator)) text.new-line) _ "") - " All Known modules: " (|> compiler (get@ #.modules) (list;map product.left) (text.join-with ", ")) text.new-line))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list;map product.left) (text.join-with separator)) text.new-line))))))) (def: #export (find-def-type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux index 4743d26ce..8eaf3a558 100644 --- a/stdlib/source/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/lux/tool/compiler/default/syntax.lux @@ -180,8 +180,8 @@ ## else )))))))) -(`` (do-template [ ] - [(def: ( parse source) +(do-template [ ] + [(`` (def: ( parse source) (-> Parser Parser) (let [[_ _ source-code] source source-code//size ("lux text size" source-code)] @@ -193,20 +193,20 @@ (#error.Failure error) (let [[where offset _] source] - (case (read-close (char ) source-code//size source-code offset) + (case (read-close (char (~~ (static ))) source-code//size source-code offset) (#error.Success offset') (#error.Success [[(update@ #.column inc where) offset' source-code] [where ( (list.reverse stack))]]) (#error.Failure error) - (#error.Failure error)))))))] + (#error.Failure error))))))))] - ## Form and tuple syntax is mostly the same, differing only in the - ## delimiters involved. - ## They may have an arbitrary number of arbitrary Code nodes as elements. - [parse-form (~~ (static ..close-form)) #.Form "Form"] - [parse-tuple (~~ (static ..close-tuple)) #.Tuple "Tuple"] - )) + ## Form and tuple syntax is mostly the same, differing only in the + ## delimiters involved. + ## They may have an arbitrary number of arbitrary Code nodes as elements. + [parse-form ..close-form #.Form "Form"] + [parse-tuple ..close-tuple #.Tuple "Tuple"] + ) (def: (parse-record parse source) (-> Parser Parser) @@ -500,27 +500,27 @@ (let [offset/1 (!inc offset/0)] (<| (!with-char+ source-code//size source-code offset/1 char/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])) + [[(~~ (static ..name-separator))] + (!parse-short-name current-module where #.Tag) ## Single-line comment [(~~ (static ..sigil))] - (case ("lux text index" source-code (static text.new-line) offset/1) + (case ("lux text index" source-code (static text.new-line) (!inc offset/1)) (#.Some end) (recur [(!new-line where) (!inc end) source-code]) _ ) - [(~~ (static ..name-separator))] - (!parse-short-name current-module where #.Tag)] + (~~ (do-template [ ] + [[] + (#error.Success [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) + source-code] + [where (#.Bit )]])] + + ["0" #0] + ["1" #1]))] ## else (cond (!name-char?|head char/1) ## Tag diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux index cc7c857a0..0d69f524c 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux @@ -5,11 +5,11 @@ ["ex" exception (#+ exception:)] pipe] [data - ["." text ("#;." equivalence) + ["." text ("#@." equivalence) format] ["." error] [collection - ["." list ("#;." fold functor)] + ["." list ("#@." fold functor)] [dictionary ["." plist]]]] ["." macro]] @@ -86,7 +86,11 @@ [self-name macro.current-module-name] (function (_ state) (#error.Success [(update@ #.modules - (plist.update self-name (update@ #.imports (|>> (#.Cons module)))) + (plist.update self-name (update@ #.imports (function (_ current) + (if (list.any? (text@= module) + current) + current + (#.Cons module current))))) state) []]))))) @@ -236,16 +240,16 @@ (///.throw cannot-declare-tags-for-unnamed-type [tags type])) _ (ensure-undeclared-tags self-name tags) _ (///.assert cannot-declare-tags-for-foreign-type [tags type] - (text;= self-name type-module))] + (text@= self-name type-module))] (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get self-name)) (#.Some module) - (let [namespaced-tags (list;map (|>> [self-name]) tags)] + (let [namespaced-tags (list@map (|>> [self-name]) tags)] (#error.Success [(update@ #.modules (plist.update self-name (|>> (update@ #.tags (function (_ tag-bindings) - (list;fold (function (_ [idx tag] table) + (list@fold (function (_ [idx tag] table) (plist.put tag [idx namespaced-tags exported? type] table)) tag-bindings (list.enumerate tags)))) -- cgit v1.2.3