From f0c5b0eae885b73de243cb463b017a20cb47646d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 27 Jun 2022 01:24:36 -0400 Subject: Extensible un-quoting. --- stdlib/source/documentation/lux/locale.lux | 22 +- .../source/documentation/lux/locale/language.lux | 13 +- .../source/documentation/lux/locale/territory.lux | 13 +- stdlib/source/documentation/lux/macro.lux | 155 +++---- stdlib/source/documentation/lux/macro/code.lux | 22 +- stdlib/source/documentation/lux/macro/local.lux | 21 +- stdlib/source/documentation/lux/macro/syntax.lux | 40 +- .../documentation/lux/macro/syntax/check.lux | 13 +- .../documentation/lux/macro/syntax/declaration.lux | 26 +- .../documentation/lux/macro/syntax/definition.lux | 31 +- .../documentation/lux/macro/syntax/export.lux | 13 +- .../documentation/lux/macro/syntax/input.lux | 20 +- .../lux/macro/syntax/type/variable.lux | 20 +- stdlib/source/documentation/lux/macro/template.lux | 100 ++-- stdlib/source/library/lux.lux | 508 +++++++++++++-------- 15 files changed, 545 insertions(+), 472 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/documentation/lux/locale.lux b/stdlib/source/documentation/lux/locale.lux index 806194704..b03601d73 100644 --- a/stdlib/source/documentation/lux/locale.lux +++ b/stdlib/source/documentation/lux/locale.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -13,21 +13,19 @@ [\\library ["[0]" /]]) -(documentation: /.Locale - "A description of a locale; with territory, (optional) language, and (optional) text-encoding.") - -(documentation: /.locale - "" - [(locale language territory encoding)]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Locale - ..locale - ($.default /.code) + [($.default /.code) ($.default /.hash) - ($.default /.equivalence)] + ($.default /.equivalence) + + ($.documentation /.Locale + "A description of a locale; with territory, (optional) language, and (optional) text-encoding.") + + ($.documentation /.locale + "" + [(locale language territory encoding)])] [/language.documentation /territory.documentation])) diff --git a/stdlib/source/documentation/lux/locale/language.lux b/stdlib/source/documentation/lux/locale/language.lux index 1960e7fb9..cc0f4e7be 100644 --- a/stdlib/source/documentation/lux/locale/language.lux +++ b/stdlib/source/documentation/lux/locale/language.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,9 +10,6 @@ [\\library ["[0]" /]]) -(documentation: /.Language - "An ISO 639 language.") - (def items/~ (list.together (list ($.default /.uncoded) @@ -625,8 +622,7 @@ (.List $.Module) (`` ($.module /._ "" - [..Language - ($.default /.name) + [($.default /.name) ($.default /.code) ($.default /.equivalence) ($.default /.hash) @@ -656,5 +652,8 @@ ..items/w ..items/x ..items/y - ..items/z] + ..items/z + + ($.documentation /.Language + "An ISO 639 language.")] []))) diff --git a/stdlib/source/documentation/lux/locale/territory.lux b/stdlib/source/documentation/lux/locale/territory.lux index 2b83e0aa0..232f18038 100644 --- a/stdlib/source/documentation/lux/locale/territory.lux +++ b/stdlib/source/documentation/lux/locale/territory.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,9 +10,6 @@ [\\library ["[0]" /]]) -(documentation: /.Territory - "An ISO 3166 territory.") - (def items/ab (list.together (list ($.default /.afghanistan) @@ -304,8 +301,7 @@ (.List $.Module) (`` ($.module /._ "" - [..Territory - ($.default /.name) + [($.default /.name) ($.default /.short_code) ($.default /.long_code) ($.default /.numeric_code) @@ -317,5 +313,8 @@ ..items/hijkl ..items/mno ..items/pqrs - ..items/tuvwxyz] + ..items/tuvwxyz + + ($.documentation /.Territory + "An ISO 3166 territory.")] []))) diff --git a/stdlib/source/documentation/lux/macro.lux b/stdlib/source/documentation/lux/macro.lux index e3a659da5..7e6c34963 100644 --- a/stdlib/source/documentation/lux/macro.lux +++ b/stdlib/source/documentation/lux/macro.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char symbol) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] @@ -15,97 +15,86 @@ [\\library ["[0]" /]]) -(documentation: /.single_expansion - (format "Given code that requires applying a macro, does it once and returns the result." - \n "Otherwise, returns the code as-is.") - [(single_expansion syntax)]) - -(documentation: /.expansion - (format "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left." - \n "Otherwise, returns the code as-is.") - [(expansion syntax)]) +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.documentation /.single_expansion + (format "Given code that requires applying a macro, does it once and returns the result." + \n "Otherwise, returns the code as-is.") + [(single_expansion syntax)]) -(documentation: /.full_expansion - "Expands all macro-calls everywhere recursively, until only primitive/base code remains." - [(full_expansion syntax)]) + ($.documentation /.expansion + (format "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left." + \n "Otherwise, returns the code as-is.") + [(expansion syntax)]) -(documentation: /.symbol - (format "Generates a unique name as a Code node (ready to be used in code templates)." - \n "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.") - [(symbol prefix)]) + ($.documentation /.full_expansion + "Expands all macro-calls everywhere recursively, until only primitive/base code remains." + [(full_expansion syntax)]) -(documentation: /.wrong_syntax_error - "A generic error message for macro syntax failures.") + ($.documentation /.symbol + (format "Generates a unique name as a Code node (ready to be used in code templates)." + \n "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.") + [(symbol prefix)]) -(documentation: /.with_symbols - "Creates new symbols and offers them to the body expression." - [(def synchronized - (syntax (_ [lock any - body any]) - (with_symbols [g!lock g!body g!_] - (in (list (` (let [(~ g!lock) (~ lock) - (~ g!_) ("jvm monitorenter" (~ g!lock)) - (~ g!body) (~ body) - (~ g!_) ("jvm monitorexit" (~ g!lock))] - (~ g!body))))))))]) + ($.documentation /.wrong_syntax_error + "A generic error message for macro syntax failures.") -(documentation: /.one_expansion - "Works just like expand, except that it ensures that the output is a single Code token." - [(one_expansion token)]) + ($.documentation /.with_symbols + "Creates new symbols and offers them to the body expression." + [(def synchronized + (syntax (_ [lock any + body any]) + (with_symbols [g!lock g!body g!_] + (in (list (` (let [(~ g!lock) (~ lock) + (~ g!_) ("jvm monitorenter" (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) ("jvm monitorexit" (~ g!lock))] + (~ g!body))))))))]) -(documentation: /.log_single_expansion! - (format "Performs a macro-expansion and logs the resulting code." - \n "You can either use the resulting code, or omit them." - \n "By omitting them, this macro produces nothing (just like the lux.comment macro).") - [(log_single_expansion! - (def (foo bar baz) - (-> Int Int Int) - (int.+ bar baz))) - (log_single_expansion! "omit" - (def (foo bar baz) - (-> Int Int Int) - (int.+ bar baz)))]) + ($.documentation /.one_expansion + "Works just like expand, except that it ensures that the output is a single Code token." + [(one_expansion token)]) -(documentation: /.log_expansion! - (format "Performs a macro-expansion and logs the resulting code." - \n "You can either use the resulting code, or omit them." - \n "By omitting them, this macro produces nothing (just like the lux.comment macro).") - [(log_expansion! - (def (foo bar baz) - (-> Int Int Int) - (int.+ bar baz))) - (log_expansion! "omit" - (def (foo bar baz) - (-> Int Int Int) - (int.+ bar baz)))]) + ($.documentation /.log_single_expansion! + (format "Performs a macro-expansion and logs the resulting code." + \n "You can either use the resulting code, or omit them." + \n "By omitting them, this macro produces nothing (just like the lux.comment macro).") + [(log_single_expansion! + (def (foo bar baz) + (-> Int Int Int) + (int.+ bar baz))) + (log_single_expansion! "omit" + (def (foo bar baz) + (-> Int Int Int) + (int.+ bar baz)))]) -(documentation: /.log_full_expansion! - (format "Performs a macro-expansion and logs the resulting code." - \n "You can either use the resulting code, or omit them." - \n "By omitting them, this macro produces nothing (just like the lux.comment macro).") - [(log_full_expansion! - (def (foo bar baz) - (-> Int Int Int) - (int.+ bar baz))) - (log_full_expansion! "omit" - (def (foo bar baz) - (-> Int Int Int) - (int.+ bar baz)))]) + ($.documentation /.log_expansion! + (format "Performs a macro-expansion and logs the resulting code." + \n "You can either use the resulting code, or omit them." + \n "By omitting them, this macro produces nothing (just like the lux.comment macro).") + [(log_expansion! + (def (foo bar baz) + (-> Int Int Int) + (int.+ bar baz))) + (log_expansion! "omit" + (def (foo bar baz) + (-> Int Int Int) + (int.+ bar baz)))]) -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..single_expansion - ..expansion - ..full_expansion - ..symbol - ..wrong_syntax_error - ..with_symbols - ..one_expansion - ..log_single_expansion! - ..log_expansion! - ..log_full_expansion!] + ($.documentation /.log_full_expansion! + (format "Performs a macro-expansion and logs the resulting code." + \n "You can either use the resulting code, or omit them." + \n "By omitting them, this macro produces nothing (just like the lux.comment macro).") + [(log_full_expansion! + (def (foo bar baz) + (-> Int Int Int) + (int.+ bar baz))) + (log_full_expansion! "omit" + (def (foo bar baz) + (-> Int Int Int) + (int.+ bar baz)))])] [/code.documentation /local.documentation /syntax.documentation diff --git a/stdlib/source/documentation/lux/macro/code.lux b/stdlib/source/documentation/lux/macro/code.lux index 707d7f754..df50d5049 100644 --- a/stdlib/source/documentation/lux/macro/code.lux +++ b/stdlib/source/documentation/lux/macro/code.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char local global) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,20 +10,11 @@ [\\library ["[0]" /]]) -(documentation: /.local - "Produces a local symbol (an symbol with no module prefix).") - -(documentation: /.replaced - "" - [(replaced original substitute ast)]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..local - ..replaced - ($.default /.bit) + [($.default /.bit) ($.default /.nat) ($.default /.int) ($.default /.rev) @@ -35,5 +26,12 @@ ($.default /.tuple) ($.default /.equivalence) - ($.default /.format)] + ($.default /.format) + + ($.documentation /.local + "Produces a local symbol (an symbol with no module prefix).") + + ($.documentation /.replaced + "" + [(replaced original substitute ast)])] [])) diff --git a/stdlib/source/documentation/lux/macro/local.lux b/stdlib/source/documentation/lux/macro/local.lux index a6256aa92..e71a685fb 100644 --- a/stdlib/source/documentation/lux/macro/local.lux +++ b/stdlib/source/documentation/lux/macro/local.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] @@ -10,19 +10,18 @@ [\\library ["[0]" /]]) -(documentation: /.push - (format "Installs macros in the compiler-state, with the given names." - \n "Yields code that can be placed either as expression or as declarations." - \n "This code un-installs the macros." - \n "NOTE: Always use this code once to clean-up..") - [(push macros)]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..push - ($.default /.unknown_module) + [($.default /.unknown_module) ($.default /.cannot_shadow_definition) - ($.default /.unknown_definition)] + ($.default /.unknown_definition) + + ($.documentation /.push + (format "Installs macros in the compiler-state, with the given names." + \n "Yields code that can be placed either as expression or as declarations." + \n "This code un-installs the macros." + \n "NOTE: Always use this code once to clean-up..") + [(push macros)])] [])) diff --git a/stdlib/source/documentation/lux/macro/syntax.lux b/stdlib/source/documentation/lux/macro/syntax.lux index f9d795e37..fc7675a8c 100644 --- a/stdlib/source/documentation/lux/macro/syntax.lux +++ b/stdlib/source/documentation/lux/macro/syntax.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] @@ -18,30 +18,28 @@ [\\library ["[0]" /]]) -(documentation: /.syntax - (format \n "A more advanced way to define macros than 'macro'." - \n "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." - \n "The macro body is also (implicitly) run in the Meta monad, to save some typing." - \n "Also, the compiler state can be accessed through a special binding.") - [(def .public object - (syntax (_ lux_state [.let [imports (class_imports lux_state)] - .let [class_vars (list)] - super (opt (super_class_decl^ imports class_vars)) - interfaces (tuple (some (super_class_decl^ imports class_vars))) - constructor_args (constructor_args^ imports class_vars) - methods (some (overriden_method_def^ imports))]) - (let [def_code (all text#composite "anon-class:" - (spaced (list (super_class_decl$ (maybe.else object_super_class super)) - (with_brackets (spaced (list#each super_class_decl$ interfaces))) - (with_brackets (spaced (list#each constructor_arg$ constructor_args))) - (with_brackets (spaced (list#each (method_def$ id) methods))))))] - (in (list (` ((~ (code.text def_code)))))))))]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..syntax] + [($.documentation /.syntax + (format \n "A more advanced way to define macros than 'macro'." + \n "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." + \n "The macro body is also (implicitly) run in the Meta monad, to save some typing." + \n "Also, the compiler state can be accessed through a special binding.") + [(def .public object + (syntax (_ lux_state [.let [imports (class_imports lux_state)] + .let [class_vars (list)] + super (opt (super_class_decl^ imports class_vars)) + interfaces (tuple (some (super_class_decl^ imports class_vars))) + constructor_args (constructor_args^ imports class_vars) + methods (some (overriden_method_def^ imports))]) + (let [def_code (all text#composite "anon-class:" + (spaced (list (super_class_decl$ (maybe.else object_super_class super)) + (with_brackets (spaced (list#each super_class_decl$ interfaces))) + (with_brackets (spaced (list#each constructor_arg$ constructor_args))) + (with_brackets (spaced (list#each (method_def$ id) methods))))))] + (in (list (` ((~ (code.text def_code)))))))))])] [/check.documentation /declaration.documentation /definition.documentation diff --git a/stdlib/source/documentation/lux/macro/syntax/check.lux b/stdlib/source/documentation/lux/macro/syntax/check.lux index b0298cbd3..c96bf0cde 100644 --- a/stdlib/source/documentation/lux/macro/syntax/check.lux +++ b/stdlib/source/documentation/lux/macro/syntax/check.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,15 +10,14 @@ [\\library ["[0]" /]]) -(documentation: /.Check - "A type annotation for an expression.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Check - ($.default /.equivalence) + [($.default /.equivalence) ($.default /.format) - ($.default /.parser)] + ($.default /.parser) + + ($.documentation /.Check + "A type annotation for an expression.")] [])) diff --git a/stdlib/source/documentation/lux/macro/syntax/declaration.lux b/stdlib/source/documentation/lux/macro/syntax/declaration.lux index 9698cc9af..fd9fe1a58 100644 --- a/stdlib/source/documentation/lux/macro/syntax/declaration.lux +++ b/stdlib/source/documentation/lux/macro/syntax/declaration.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,21 +10,19 @@ [\\library ["[0]" /]]) -(documentation: /.Declaration - "A declaration for either a constant or a function.") - -(documentation: /.parser - "A parser for declaration syntax." - ["Such as:" - quux - (foo bar baz)]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Declaration - ..parser - ($.default /.equivalence) - ($.default /.format)] + [($.default /.equivalence) + ($.default /.format) + + ($.documentation /.Declaration + "A declaration for either a constant or a function.") + + ($.documentation /.parser + "A parser for declaration syntax." + ["Such as:" + quux + (foo bar baz)])] [])) diff --git a/stdlib/source/documentation/lux/macro/syntax/definition.lux b/stdlib/source/documentation/lux/macro/syntax/definition.lux index ba2faeb9b..cf4b3225f 100644 --- a/stdlib/source/documentation/lux/macro/syntax/definition.lux +++ b/stdlib/source/documentation/lux/macro/syntax/definition.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except Definition) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,25 +10,22 @@ [\\library ["[0]" /]]) -(documentation: /.Definition - "Syntax for a constant definition.") - -(documentation: /.parser - "A reader that first macro-expands and then analyses the input Code, to ensure it is a definition." - [(parser compiler)]) - -(documentation: /.typed - "Only works for typed definitions." - [(typed compiler)]) - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Definition - ..parser - ..typed - ($.default /.equivalence) + [($.default /.equivalence) ($.default /.lacks_type) - ($.default /.format)] + ($.default /.format) + + ($.documentation /.Definition + "Syntax for a constant definition.") + + ($.documentation /.parser + "A reader that first macro-expands and then analyses the input Code, to ensure it is a definition." + [(parser compiler)]) + + ($.documentation /.typed + "Only works for typed definitions." + [(typed compiler)])] [])) diff --git a/stdlib/source/documentation/lux/macro/syntax/export.lux b/stdlib/source/documentation/lux/macro/syntax/export.lux index 2873623fd..6d23bc8b9 100644 --- a/stdlib/source/documentation/lux/macro/syntax/export.lux +++ b/stdlib/source/documentation/lux/macro/syntax/export.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,14 +10,13 @@ [\\library ["[0]" /]]) -(documentation: /.parser - "" - [(parser un_exported)]) - (.def .public documentation (.List $.Module) ($.module /._ "Syntax for marking a definition as an export." - [..parser - ($.default /.default_policy)] + [($.default /.default_policy) + + ($.documentation /.parser + "" + [(parser un_exported)])] [])) diff --git a/stdlib/source/documentation/lux/macro/syntax/input.lux b/stdlib/source/documentation/lux/macro/syntax/input.lux index 9e24666c0..77a6b7cac 100644 --- a/stdlib/source/documentation/lux/macro/syntax/input.lux +++ b/stdlib/source/documentation/lux/macro/syntax/input.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,18 +10,16 @@ [\\library ["[0]" /]]) -(documentation: /.Input - "The common typed-argument syntax used by many macros.") - -(documentation: /.parser - "Parser for the common typed-argument syntax used by many macros.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Input - ..parser - ($.default /.equivalence) - ($.default /.format)] + [($.default /.equivalence) + ($.default /.format) + + ($.documentation /.Input + "The common typed-argument syntax used by many macros.") + + ($.documentation /.parser + "Parser for the common typed-argument syntax used by many macros.")] [])) diff --git a/stdlib/source/documentation/lux/macro/syntax/type/variable.lux b/stdlib/source/documentation/lux/macro/syntax/type/variable.lux index 9c88e9856..c29df1817 100644 --- a/stdlib/source/documentation/lux/macro/syntax/type/variable.lux +++ b/stdlib/source/documentation/lux/macro/syntax/type/variable.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except char) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text ["%" \\format (.only format)]] @@ -10,18 +10,16 @@ [\\library ["[0]" /]]) -(documentation: /.Variable - "A variable's name.") - -(documentation: /.parser - "Parser for the common type variable/parameter used by many macros.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..Variable - ..parser - ($.default /.equivalence) - ($.default /.format)] + [($.default /.equivalence) + ($.default /.format) + + ($.documentation /.Variable + "A variable's name.") + + ($.documentation /.parser + "Parser for the common type variable/parameter used by many macros.")] [])) diff --git a/stdlib/source/documentation/lux/macro/template.lux b/stdlib/source/documentation/lux/macro/template.lux index 3b4733cce..e75bbfbd9 100644 --- a/stdlib/source/documentation/lux/macro/template.lux +++ b/stdlib/source/documentation/lux/macro/template.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except let symbol) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]] @@ -10,62 +10,56 @@ [\\library ["[0]" /]]) -(documentation: /.spliced - "" - [(spliced [a b c d]) - "=>" - a - b - c - d]) +(.def .public documentation + (.List $.Module) + ($.module /._ + "Utilities commonly used while templating." + [($.default /.irregular_arguments) -(documentation: /.amount - "" - [(amount [a b c d]) - "=>" - 4]) + ($.documentation /.spliced + "" + [(spliced [a b c d]) + "=>" + a + b + c + d]) -(documentation: /.with_locals - "Creates names for local bindings aliased by the names you choose." - [(with_locals [my_var] - (let [my_var 123] - (text [my_var]))) - "=>" - "__gensym__my_var506"]) + ($.documentation /.amount + "" + [(amount [a b c d]) + "=>" + 4]) -(documentation: /.text - "A text literal made by concatenating pieces of code." - [(text [#0 123 +456 +789.0 "abc" .def ..ghi]) - "=>" - "#0123+456+789.0abcdefghi"]) + ($.documentation /.with_locals + "Creates names for local bindings aliased by the names you choose." + [(with_locals [my_var] + (let [my_var 123] + (text [my_var]))) + "=>" + "__gensym__my_var506"]) -(documentation: /.symbol - (format "An symbol made by concatenating pieces of code." - \n "The (optional) module part and the short part are specified independently.") - [(symbol ["abc" .def ..ghi]) - "=>" - abcdefghi] - [(symbol [.def] ["abc" .def ..ghi]) - "=>" - .abcdefghi]) + ($.documentation /.text + "A text literal made by concatenating pieces of code." + [(text [#0 123 +456 +789.0 "abc" .def ..ghi]) + "=>" + "#0123+456+789.0abcdefghi"]) -(documentation: /.let - "Lexically-bound templates." - [(let [(!square ) - [(* )]] - (def (square root) - (-> Nat Nat) - (!square root)))]) + ($.documentation /.symbol + (format "An symbol made by concatenating pieces of code." + \n "The (optional) module part and the short part are specified independently.") + [(symbol ["abc" .def ..ghi]) + "=>" + abcdefghi] + [(symbol [.def] ["abc" .def ..ghi]) + "=>" + .abcdefghi]) -(.def .public documentation - (.List $.Module) - ($.module /._ - "Utilities commonly used while templating." - [..spliced - ..amount - ..with_locals - ..text - ..symbol - ..let - ($.default /.irregular_arguments)] + ($.documentation /.let + "Lexically-bound templates." + [(let [(!square ) + [(* )]] + (def (square root) + (-> Nat Nat) + (!square root)))])] [])) diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index d9060f2c3..cfbf864f1 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -682,12 +682,7 @@ ... Base functions & macros ("lux def" meta#in ("lux type check" - {#UnivQ {#End} - {#Function {#Parameter 1} - {#Function Lux - {#Apply {#Product Lux - {#Parameter 1}} - {#Apply Text Either}}}}} + {#UnivQ {#End} {#Function {#Parameter 1} {#Apply {#Parameter 1} Meta}}} ([_ val] ([_ state] {#Right [state val]}))) @@ -695,12 +690,7 @@ ("lux def" failure ("lux type check" - {#UnivQ {#End} - {#Function Text - {#Function Lux - {#Apply {#Product Lux - {#Parameter 1}} - {#Apply Text Either}}}}} + {#UnivQ {#End} {#Function Text {#Apply {#Parameter 1} Meta}}} ([_ msg] ([_ state] {#Left msg}))) @@ -1664,6 +1654,251 @@ (-> Text Code) (with_location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) +(def'' .public UnQuote + Type + {#Primitive "#Macro/UnQuote" {#End}}) + +(def'' .public (unquote it) + (-> Macro UnQuote) + ("lux type as" UnQuote it)) + +(def'' .public (unquote_macro it) + (-> UnQuote Macro') + ("lux type as" Macro' it)) + +(def'' .private (list#one f xs) + (All (_ a b) + (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) + ({{#End} + {#None} + + {#Item x xs'} + ({{#None} + (list#one f xs') + + {#Some y} + {#Some y}} + (f x))} + xs)) + +(def'' .private (in_env name state) + (-> Text Lux ($' Maybe Type)) + (let' [[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + (list#one ("lux type check" + (-> Scope ($' Maybe Type)) + (function' [env] + (let' [[..#name _ + ..#inner _ + ..#locals [..#counter _ ..#mappings locals] + ..#captured _] env] + (list#one ("lux type check" + (-> (Tuple Text (Tuple Type Any)) ($' Maybe Type)) + (function' [it] + (let' [[bname [type _]] it] + (if (text#= name bname) + {#Some type} + {#None})))) + locals)))) + scopes))) + +(def'' .private (definition_value name state) + (-> Symbol ($' Meta (Tuple Type Any))) + (let' [[v_module v_name] name + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + ({{#None} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Some [..#definitions definitions + ..#module_hash _ + ..#module_aliases _ + ..#imports _ + ..#module_state _]} + ({{#None} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Some definition} + ({{#Alias real_name} + (definition_value real_name state) + + {#Definition [exported? def_type def_value]} + {#Right [state [def_type def_value]]} + + {#Type [exported? type labels]} + {#Right [state [..Type type]]} + + {#Tag _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Slot _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} + definition)} + (plist#value v_name definitions))} + (plist#value v_module modules)))) + +(def'' .private (global_value global lux) + (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) + (let' [[module short] global] + ({{#Right [lux' type,value]} + {#Right [lux' {#Some type,value}]} + + {#Left error} + {#Right [lux {#None}]}} + ({"" ({{#None} + (definition_value global lux) + + {#Some _} + {#Left (text#composite "Not a global value: " (symbol#encoded global))}} + (in_env short lux)) + + _ + (definition_value global lux)} + module)))) + +(def'' .private (bit#and left right) + (-> Bit Bit Bit) + (if left + right + #0)) + +(def'' .private (symbol#= left right) + (-> Symbol Symbol Bit) + (let' [[moduleL shortL] left + [moduleR shortR] right] + (all bit#and + (text#= moduleL moduleR) + (text#= shortL shortR)))) + +(def'' .private (every? ?) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + (list#mix (function' [_2 _1] (if _1 (? _2) #0)) #1)) + +(def'' .private (zipped_2 xs ys) + (All (_ a b) + (-> ($' List a) ($' List b) ($' List (Tuple a b)))) + ({{#Item x xs'} + ({{#Item y ys'} + (partial_list [x y] (zipped_2 xs' ys')) + + _ + (list)} + ys) + + _ + (list)} + xs)) + +(def'' .private (type#= left right) + (-> Type Type Bit) + ({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}] + (all bit#and + (text#= nameL nameR) + ("lux i64 =" (list#size parametersL) (list#size parametersR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 parametersL parametersR))) + + [{#Sum leftL rightL} {#Sum leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Product leftL rightL} {#Product leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Function leftL rightL} {#Function leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Apply leftL rightL} {#Apply leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Parameter idL} {#Parameter idR}] + ("lux i64 =" idL idR) + + [{#Var idL} {#Var idR}] + ("lux i64 =" idL idR) + + [{#Ex idL} {#Ex idR}] + ("lux i64 =" idL idR) + + [{#UnivQ envL bodyL} {#UnivQ envR bodyR}] + (all bit#and + ("lux i64 =" (list#size envL) (list#size envR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 envL envR)) + (type#= bodyL bodyR)) + + [{#ExQ envL bodyL} {#ExQ envR bodyR}] + (all bit#and + ("lux i64 =" (list#size envL) (list#size envR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 envL envR)) + (type#= bodyL bodyR)) + + [{#Named nameL anonL} {#Named nameR anonR}] + (all bit#and + (symbol#= nameL nameR) + (type#= anonL anonR)) + + _ + #0} + [left right])) + +(def''' .private (one_expansion it) + (-> ($' Meta ($' List Code)) ($' Meta Code)) + (do meta#monad + [it it] + ({{#Item it {#End}} + (in it) + + _ + (failure "Must expand to a single element.")} + it))) + +(def''' .private (untemplated_form @form untemplated replace? subst elements) + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (do meta#monad + [output (spliced replace? (untemplated replace? subst) elements) + .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Form"]) output)))]] + (in [@form output']))) + +(def'' .private (current_module_name state) + ($' Meta Text) + ({[..#info info ..#source source ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + ({{#Some module_name} + {#Right [state module_name]} + + _ + {#Left "Cannot get the module name without a module!"}} + current_module)} + state)) + +(def''' .private (normal name) + (-> Symbol ($' Meta Symbol)) + ({["" name] + (do meta#monad + [module_name ..current_module_name] + (in [module_name name])) + + _ + (meta#in name)} + name)) + (def''' .private (untemplated replace? subst token) (-> Bit Text Code ($' Meta Code)) ({[_ [_ {#Bit value}]] @@ -1700,27 +1935,25 @@ [#0 [_ {#Symbol [module name]}]] (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) - [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~"]}] {#Item [unquoted {#End}]}]}}]] - (meta#in (form$ (list (text$ "lux type check") - (symbol$ [..prelude "Code"]) - unquoted))) - - [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~!"]}] {#Item [dependent {#End}]}]}}]] + [#1 [@form {#Form {#Item [@symbol {#Symbol global}] parameters}}]] (do meta#monad - [independent (untemplated replace? subst dependent)] - (in (with_location (variant$ (list (symbol$ [..prelude "#Form"]) - (untemplated_list (list (untemplated_text "lux in-module") - (untemplated_text subst) - independent))))))) - - [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~'"]}] {#Item [keep_quoted {#End}]}]}}]] - (untemplated #0 subst keep_quoted) + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= UnQuote type) + (do meta#monad + [.let' [it (unquote_macro ("lux type as" UnQuote value))] + output (one_expansion (it parameters)) + .let' [[_ output] output]] + (in [@form output])) + (untemplated_form @form untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) + + {#None} + (untemplated_form @form untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} + ?type,value)) - [_ [meta {#Form elems}]] - (do meta#monad - [output (spliced replace? (untemplated replace? subst) elems) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Form"]) output)))]] - (in [meta output'])) + [_ [@form {#Form elements}]] + (untemplated_form @form untemplated replace? subst elements) [_ [meta {#Variant elems}]] (do meta#monad @@ -1748,20 +1981,6 @@ (failure "Wrong syntax for Primitive")} tokens))) -(def'' .private (current_module_name state) - ($' Meta Text) - ({[..#info info ..#source source ..#current_module current_module ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - ({{#Some module_name} - {#Right [state module_name]} - - _ - {#Left "Cannot get the module name without a module!"}} - current_module)} - state)) - (def'' .public ` Macro (macro (_ tokens) @@ -1786,7 +2005,7 @@ (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) _ - (failure "Wrong syntax for `")} + (failure "Wrong syntax for `'")} tokens))) (def'' .public ' @@ -1801,6 +2020,50 @@ (failure "Wrong syntax for '")} tokens))) +(def'' .public ~ + UnQuote + (..unquote + (macro (_ tokens) + ({{#Item it {#End}} + (meta#in (list (form$ (list (text$ "lux type check") + (symbol$ [..prelude "Code"]) + it)))) + + _ + (failure (wrong_syntax_error [..prelude "~"]))} + tokens)))) + +(def'' .public ~! + UnQuote + (..unquote + (macro (_ tokens) + ({{#Item dependent {#End}} + (do meta#monad + [current_module ..current_module_name + independent (untemplated #1 current_module dependent)] + (in (list (with_location (variant$ (list (symbol$ [..prelude "#Form"]) + (untemplated_list (list (untemplated_text "lux in-module") + (untemplated_text current_module) + independent)))))))) + + _ + (failure (wrong_syntax_error [..prelude "~!"]))} + tokens)))) + +(def'' .public ~' + UnQuote + (..unquote + (macro (_ tokens) + ({{#Item it {#End}} + (do meta#monad + [current_module ..current_module_name + it (untemplated #0 current_module it)] + (in (list it))) + + _ + (failure (wrong_syntax_error [..prelude "~'"]))} + tokens)))) + (def'' .public |> Macro (macro (_ tokens) @@ -1906,11 +2169,6 @@ template} template)) -(def''' .private (every? p xs) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - (list#mix (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) - (def''' .private (high_bits value) (-> ($' I64 Any) I64) ("lux i64 right-shift" 32 value)) @@ -2092,17 +2350,6 @@ {#None}} ("lux type check" Global gdef)))) -(def''' .private (normal name) - (-> Symbol ($' Meta Symbol)) - ({["" name] - (do meta#monad - [module_name ..current_module_name] - (in [module_name name])) - - _ - (meta#in name)} - name)) - (def''' .private (named_macro full_name) (-> Symbol ($' Meta ($' Maybe Macro))) (do meta#monad @@ -2941,21 +3188,6 @@ {#None} (failure (..wrong_syntax_error (symbol ..def)))))) -(def (list#one f xs) - (All (_ a b) - (-> (-> a (Maybe b)) (List a) (Maybe b))) - (case xs - {#End} - {#None} - - {#Item x xs'} - (case (f x) - {#None} - (list#one f xs') - - {#Some y} - {#Some y}))) - (with_template [
] [(def .public (macro (_ tokens) @@ -3838,28 +4070,6 @@ {.#None} (failure (..wrong_syntax_error (symbol ..except)))))) -(def (in_env name state) - (-> Text Lux (Maybe Type)) - (case state - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - (list#one (is (-> Scope (Maybe Type)) - (function (_ env) - (case env - [..#name _ - ..#inner _ - ..#locals [..#counter _ ..#mappings locals] - ..#captured _] - (list#one (is (-> [Text [Type Any]] (Maybe Type)) - (function (_ [bname [type _]]) - (if (text#= name bname) - {#Some type} - {#None}))) - locals)))) - scopes))) - (def (definition_type name state) (-> Symbol Lux (Maybe Type)) (let [[v_module v_name] name @@ -3897,43 +4107,6 @@ {#Slot _} {#None}))))) -(def (definition_value name state) - (-> Symbol (Meta [Type Any])) - (let [[v_module v_name] name - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (plist#value v_module modules) - {#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Some [..#definitions definitions - ..#module_hash _ - ..#module_aliases _ - ..#imports _ - ..#module_state _]} - (case (plist#value v_name definitions) - {#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Some definition} - (case definition - {#Alias real_name} - (definition_value real_name state) - - {#Definition [exported? def_type def_value]} - {#Right [state [def_type def_value]]} - - {#Type [exported? type labels]} - {#Right [state [..Type type]]} - - {#Tag _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Slot _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))}))))) - (def (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings @@ -3988,21 +4161,6 @@ temp)) ))) -(def (zipped_2 xs ys) - (All (_ a b) - (-> (List a) (List b) (List [a b]))) - (case xs - {#Item x xs'} - (case ys - {#Item y ys'} - (partial_list [x y] (zipped_2 xs' ys')) - - _ - (list)) - - _ - (list))) - (def .public open (macro (_ tokens) (case tokens @@ -5048,54 +5206,6 @@ =refers) =refers)})))) -(def (symbol#= [moduleL shortL] [moduleR shortR]) - (-> Symbol Symbol Bit) - (and (text#= moduleL moduleR) - (text#= shortL shortR))) - -(def (type#= left right) - (-> Type Type Bit) - (case [left right] - [{#Primitive nameL parametersL} {#Primitive nameR parametersR}] - (and (text#= nameL nameR) - ("lux i64 =" (list#size parametersL) (list#size parametersR)) - (every? (function (_ [itL itR]) - (type#= itL itR)) - (zipped_2 parametersL parametersR))) - - (with_template#pattern [] - [[{ leftL rightL} { leftR rightR}] - (and (type#= leftL leftR) - (type#= rightL rightR))]) - ([#Sum] - [#Product] - [#Function] - [#Apply]) - - (with_template#pattern [] - [[{ idL} { idR}] - ("lux i64 =" idL idR)]) - ([#Parameter] - [#Var] - [#Ex]) - - (with_template#pattern [] - [[{ envL bodyL} { envR bodyR}] - (and ("lux i64 =" (list#size envL) (list#size envR)) - (every? (function (_ [itL itR]) - (type#= itL itR)) - (zipped_2 envL envR)) - (type#= bodyL bodyR))]) - ([#UnivQ] - [#ExQ]) - - [{#Named nameL anonL} {#Named nameR anonR}] - (and (symbol#= nameL nameR) - (type#= anonL anonR)) - - _ - #0)) - (type .public Immediate_UnQuote (Primitive "#Macro/Immediate_UnQuote")) -- cgit v1.2.3