aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2022-10-28 23:11:52 -0400
committerEduardo Julian2022-10-28 23:11:52 -0400
commit736521eb56a45122eb0a545b677d3ffca1451080 (patch)
tree484221adf44f4cd5b9d0132fc41441d0ad098533 /stdlib/source
parent54d22bc41b874d52a94a96aafca18ab3a6357edb (diff)
Eliminated the .alias# extension. Now detecting aliases in .def#.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/library/lux.lux47
-rw-r--r--stdlib/source/library/lux/control/aspect.lux46
-rw-r--r--stdlib/source/library/lux/data/format/css.lux6
-rw-r--r--stdlib/source/library/lux/data/format/css/font.lux2
-rw-r--r--stdlib/source/library/lux/data/format/css/property.lux7
-rw-r--r--stdlib/source/library/lux/data/format/css/query.lux4
-rw-r--r--stdlib/source/library/lux/data/format/css/selector.lux7
-rw-r--r--stdlib/source/library/lux/data/format/css/style.lux2
-rw-r--r--stdlib/source/library/lux/data/format/css/value.lux4
-rw-r--r--stdlib/source/library/lux/data/format/html.lux28
-rw-r--r--stdlib/source/library/lux/documentation.lux2
-rw-r--r--stdlib/source/library/lux/meta.lux127
-rw-r--r--stdlib/source/library/lux/meta/compiler/default/init.lux6
-rw-r--r--stdlib/source/library/lux/meta/compiler/default/platform.lux8
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux.lux7
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux17
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux12
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux56
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux91
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/io/archive.lux11
-rw-r--r--stdlib/source/library/lux/meta/global.lux2
-rw-r--r--stdlib/source/library/lux/meta/macro/context.lux22
-rw-r--r--stdlib/source/library/lux/meta/macro/local.lux8
-rw-r--r--stdlib/source/library/lux/meta/macro/vocabulary.lux2
-rw-r--r--stdlib/source/library/lux/meta/type/implicit.lux8
-rw-r--r--stdlib/source/library/lux/world/net/http.lux10
-rw-r--r--stdlib/source/library/lux/world/net/http/client.lux7
-rw-r--r--stdlib/source/library/lux/world/net/http/request.lux12
-rw-r--r--stdlib/source/library/lux/world/net/http/response.lux88
-rw-r--r--stdlib/source/test/lux/data/color/named.lux9
-rw-r--r--stdlib/source/test/lux/meta/type/resource.lux2
-rw-r--r--stdlib/source/test/lux/meta/type/row.lux56
-rw-r--r--stdlib/source/test/lux/world/net.lux4
-rw-r--r--stdlib/source/test/lux/world/net/http/client.lux3
-rw-r--r--stdlib/source/test/lux/world/net/http/response.lux189
-rw-r--r--stdlib/source/test/lux/world/net/http/status.lux21
36 files changed, 609 insertions, 324 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index 0be0527c4..d8ef5fd2f 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -489,11 +489,11 @@
#0)
... (type .public Definition
-... [Bit Type Any])
+... [Type Any])
(.def# Definition
(.is# Type
{#Named [..prelude "Definition"]
- {#Product Bit {#Product Type Any}}})
+ {#Product Type Any}})
.public)
... (type .public Default
@@ -692,7 +692,7 @@
... (Record
... [#module_hash Nat
... #module_aliases (List [Text Text])
-... #definitions (List [Text Global])
+... #definitions (List [Text [Bit Global]])
... #imports (List Text)
... #module_state Module_State]))
(.def# Module
@@ -706,7 +706,7 @@
{#Apply {#Product Text Text} List}
{#Product
... definitions
- {#Apply {#Product Text Global} List}
+ {#Apply {#Product Text {#Product Bit Global}} List}
{#Product
... imports
{#Apply Text List}
@@ -1841,7 +1841,7 @@
..#seed seed ..#expected expected ..#location location ..#extensions extensions
..#scope_type_vars scope_type_vars ..#eval _eval] state]
({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]}
- ({{#Some constant}
+ ({{#Some [_ constant]}
({{#Definition _}
{#Right [state full_name]}
@@ -1972,11 +1972,11 @@
({{#None}
{#Left (text#composite "Unknown definition: " (symbol#encoded name))}
- {#Some definition}
+ {#Some [exported? definition]}
({{#Alias real_name}
(definition_value real_name state)
- {#Definition [exported? def_type def_value]}
+ {#Definition [def_type def_value]}
(if (available? expected_module current_module exported?)
{#Right [state [def_type def_value]]}
{#Left (text#composite "Unavailable definition: " (symbol#encoded name))})
@@ -2637,12 +2637,13 @@
($ Maybe Macro))
(do maybe#monad
[$module (property#value module modules)
- gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] (.is# Module $module)]
- (property#value name bindings))]
+ exported?,gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] (.is# Module $module)]
+ (property#value name bindings))
+ .let' [[exported? gdef] exported?,gdef]]
({{#Alias [r_module r_name]}
(named_macro' modules current_module r_module r_name)
- {#Definition [exported? def_type def_value]}
+ {#Definition [def_type def_value]}
(if (macro_type? def_type)
(if exported?
{#Some (.as# Macro def_value)}
@@ -3889,7 +3890,7 @@
..#imports _
..#module_state _] =module]]
(when (property#value name definitions)
- {#Some {#Definition [exported type value]}}
+ {#Some [exported {#Definition [type value]}]}
(meta#in [exported (as Label value)])
_
@@ -3905,13 +3906,13 @@
..#definitions definitions
..#imports _
..#module_state _] module]]
- (in ((is (-> (List [Text Global])
+ (in ((is (-> (List [Text [Bit Global]])
(Maybe (List Symbol)))
(function (again remaining)
(when remaining
{#Item [slot head] tail}
(when head
- {#Definition [exported? type value]}
+ [exported? {#Definition [type value]}]
(if (and (type#= Slot type)
(or exported?
(text#= expected_module actual_module)))
@@ -3954,7 +3955,7 @@
..#imports _
..#module_state _] =module]]
(when (property#value name definitions)
- {#Some {#Definition [exported? type value]}}
+ {#Some [exported? {#Definition [type value]}]}
(if (type#= Type type)
(do meta#monad
[slots (slot_family module (as Type value))]
@@ -4470,14 +4471,16 @@
[current_module modules])]
(when (property#value module modules)
{#Some =module}
- (let [to_alias (list#each (is (-> [Text Global]
+ (let [to_alias (list#each (is (-> [Text [Bit Global]]
(List Text))
- (function (_ [name definition])
+ (function (_ [name [exported? definition]])
(when definition
{#Alias _}
- (list)
+ (if exported?
+ (list name)
+ (list))
- {#Definition [exported? def_type def_value]}
+ {#Definition [def_type def_value]}
(if exported?
(list name)
(list))
@@ -4537,7 +4540,9 @@
(def (alias_definition imported_module def)
(-> Text Text Code)
- (` (.alias# (, (local$ def)) (, (symbol$ [imported_module def])))))
+ (` (.def# (, (local$ def))
+ (, (symbol$ [imported_module def]))
+ .private)))
(def .public only
(macro (_ tokens)
@@ -4609,12 +4614,12 @@
{#None}
{#None}
- {#Some definition}
+ {#Some [exported? definition]}
(when definition
{#Alias real_name}
(definition_type real_name state)
- {#Definition [exported? def_type def_value]}
+ {#Definition [def_type def_value]}
{#Some def_type}
{#Default _}
diff --git a/stdlib/source/library/lux/control/aspect.lux b/stdlib/source/library/lux/control/aspect.lux
index ae08932e3..eda6a78c7 100644
--- a/stdlib/source/library/lux/control/aspect.lux
+++ b/stdlib/source/library/lux/control/aspect.lux
@@ -109,7 +109,7 @@
(def (without_global [module short])
(-> Symbol (analysis.Operation Any))
(function (_ lux)
- (let [without_global (is (-> (property.List .Global) (property.List .Global))
+ (let [without_global (is (-> (property.List [Bit .Global]) (property.List [Bit .Global]))
(property.lacks short))
without_global (is (-> .Module .Module)
(revised .#definitions without_global))
@@ -121,30 +121,30 @@
[]]})))
(def (global_reference name)
- (-> Symbol (Meta .Global))
+ (-> Symbol (Meta [Bit .Global]))
(do meta.monad
[name (meta.normal name)
current_module_name meta.current_module_name
lux meta.compiler_state]
(loop (again [[normal_module normal_short] name])
- (when (is (Maybe .Global)
+ (when (is (Maybe [Bit .Global])
(do maybe.monad
[(open "/[0]") (|> lux
(the .#modules)
(property.value normal_module))]
(property.value normal_short /#definitions)))
- {.#Some it}
+ {.#Some [exported? it]}
(when it
- {.#Definition [exported? type value]}
+ {.#Definition [type value]}
(if (or exported?
(text#= current_module_name normal_module))
- (in it)
+ (in [exported? it])
(meta.failure (%.format "Global is not an export: " (%.symbol name))))
- {.#Default [exported? type value]}
+ {.#Default [type value]}
(if (or exported?
(text#= current_module_name normal_module))
- (in it)
+ (in [exported? it])
(meta.failure (%.format "Global is not an export: " (%.symbol name))))
{.#Alias de_aliased}
@@ -159,9 +159,9 @@
(analysis.Operation of)))
(do phase.monad
[g!cache (macro.symbol "g!cache")
- global (global_reference name)
+ [exported? global] (global_reference name)
.let [cache_name (%.code g!cache)]
- _ (module.define cache_name global)
+ _ (module.define cache_name [exported? global])
it (then [g!cache global])
current_module_name meta.current_module_name
_ (without_global [current_module_name cache_name])]
@@ -174,11 +174,11 @@
(do phase.monad
[g!cache (declaration.lifted_analysis
(macro.symbol "g!cache"))
- global (declaration.lifted_analysis
- (global_reference name))
+ [exported? global] (declaration.lifted_analysis
+ (global_reference name))
.let [cache_name (%.code g!cache)]
_ (declaration.lifted_analysis
- (module.define cache_name global))
+ (module.define cache_name [exported? global]))
it (then [g!cache global])
current_module_name (declaration.lifted_analysis
meta.current_module_name)
@@ -191,10 +191,10 @@
(-> [Symbol .Global] (analysis.Operation of)
(analysis.Operation of)))
(do phase.monad
- [old (global_reference name)
- _ (module.override_definition name new)
+ [[exported? old] (global_reference name)
+ _ (module.override_definition name [exported? new])
it then
- _ (module.override_definition name old)]
+ _ (module.override_definition name [exported? old])]
(in it)))
(def (with_temporary_global' [name new] then)
@@ -202,13 +202,13 @@
(-> [Symbol .Global] (declaration.Operation anchor expression declaration of)
(declaration.Operation anchor expression declaration of)))
(do phase.monad
- [old (declaration.lifted_analysis
- (global_reference name))
+ [[exported? old] (declaration.lifted_analysis
+ (global_reference name))
_ (declaration.lifted_analysis
- (module.override_definition name new))
+ (module.override_definition name [exported? new]))
it then
_ (declaration.lifted_analysis
- (module.override_definition name old))]
+ (module.override_definition name [exported? old]))]
(in it)))
(def (expression type term)
@@ -226,7 +226,7 @@
(do phase.monad
[g!cache (macro.symbol "g!cache")
.let [cache_name (%.code g!cache)]
- _ (module.define cache_name {.#Definition [false Analysis (expression type term)]})
+ _ (module.define cache_name [false {.#Definition [Analysis (expression type term)]}])
it (then g!cache)
current_module_name meta.current_module_name
_ (without_global [current_module_name cache_name])]
@@ -279,7 +279,7 @@
(list#mix (function (_ [original value] then)
(<| (with_cached_analysis original)
(function (_ [g!original original_global]))
- (with_temporary_global [original {.#Definition [true Analysis (value g!original aspect)]}])
+ (with_temporary_global [original {.#Definition [Analysis (value g!original aspect)]}])
then))
(phase archive body)
(list [(symbol .local#) ..local]
@@ -296,7 +296,7 @@
(list#mix (function (_ [original value] then)
(<| (with_cached_analysis' original)
(function (_ [g!original original_global]))
- (with_temporary_global' [original {.#Definition [true Analysis (value g!original aspect)]}])
+ (with_temporary_global' [original {.#Definition [Analysis (value g!original aspect)]}])
then))
(phase archive body)
(list [(symbol .local#) ..local]
diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux
index c754a7d6d..53b9238ec 100644
--- a/stdlib/source/library/lux/data/format/css.lux
+++ b/stdlib/source/library/lux/data/format/css.lux
@@ -14,7 +14,7 @@
["[0]" nat]]]
[meta
[type
- ["[0]" primitive (.except Frame def pattern)]]]
+ ["[0]" primitive (.except Frame def)]]]
[world
[net (.only URL)]]]]
["[0]" /
@@ -40,7 +40,9 @@
(abstraction ""))
(type .public Style
- (List (Ex (_ brand) [(Property brand) (Value brand)])))
+ (List (Ex (_ brand)
+ [(Property brand)
+ (Value brand)])))
(def .public (rule selector style)
(-> (Selector Any) Style (CSS Common))
diff --git a/stdlib/source/library/lux/data/format/css/font.lux b/stdlib/source/library/lux/data/format/css/font.lux
index 5d97d5382..f69a8f602 100644
--- a/stdlib/source/library/lux/data/format/css/font.lux
+++ b/stdlib/source/library/lux/data/format/css/font.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #source)
[meta
[code
["s" \\parser]]]
diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux
index 4b4197940..e34b27b1d 100644
--- a/stdlib/source/library/lux/data/format/css/property.lux
+++ b/stdlib/source/library/lux/data/format/css/property.lux
@@ -1,15 +1,14 @@
(.require
[library
- [lux (.except All Location)
+ [lux (.except All Location all left right)
[data
["[0]" text]]
[meta
- [code
+ ["[0]" code (.only)
["s" \\parser]]
[macro
[syntax (.only syntax)]
- ["[0]" template]
- ["[0]" code]]
+ ["[0]" template]]
[type
["[0]" primitive (.except def)]]]]]
[//
diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/data/format/css/query.lux
index 6f35f5e43..095d12b40 100644
--- a/stdlib/source/library/lux/data/format/css/query.lux
+++ b/stdlib/source/library/lux/data/format/css/query.lux
@@ -1,11 +1,11 @@
(.require
[library
- [lux (.except and or not)
+ [lux (.except and or not all only except)
[data
["[0]" text (.only)
["%" \\format (.only format)]]]
[meta
- ["[0]" code (.only syntax)
+ ["[0]" code (.only)
["s" \\parser]]
[macro
[syntax (.only syntax)]
diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux
index df2df8fbf..a76428c86 100644
--- a/stdlib/source/library/lux/data/format/css/selector.lux
+++ b/stdlib/source/library/lux/data/format/css/selector.lux
@@ -1,7 +1,6 @@
(.require
[library
- [lux (.except Label or and for same? not)
- ["[0]" locale (.only Locale)]
+ [lux (.except Label Tag or and for same? not at)
[data
["[0]" text (.only)
["%" \\format (.only format)]]]
@@ -12,7 +11,9 @@
[macro
["[0]" template]]
[type
- ["[0]" primitive (.except def)]]]]]
+ ["[0]" primitive (.except def)]]]
+ [world
+ ["[0]" locale (.only Locale)]]]]
["[0]" //
["[1][0]" id (.only ID)]
["[1][0]" class (.only Class)]])
diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/data/format/css/style.lux
index 0d278d714..ddcbbc291 100644
--- a/stdlib/source/library/lux/data/format/css/style.lux
+++ b/stdlib/source/library/lux/data/format/css/style.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except with)
[data
[text
["%" \\format (.only format)]]
diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux
index 4fa9266ae..a05cabdf5 100644
--- a/stdlib/source/library/lux/data/format/css/value.lux
+++ b/stdlib/source/library/lux/data/format/css/value.lux
@@ -1,12 +1,12 @@
(.require
[library
- [lux (.except Label All Location and static false true)
+ [lux (.except Label All Location and static false true all)
[control
["[0]" maybe]]
[data
["[0]" color]
["[0]" product]
- ["[0]" text
+ ["[0]" text (.only)
["%" \\format (.only Format format)]]
[collection
["[0]" list (.use "[1]#[0]" functor)]]]
diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux
index e92858dce..0dc8a42b5 100644
--- a/stdlib/source/library/lux/data/format/html.lux
+++ b/stdlib/source/library/lux/data/format/html.lux
@@ -1,12 +1,12 @@
(.require
[library
- [lux (.except Meta Source comment and template)
+ [lux (.except Tag Meta Source comment and template open parameter)
[control
["[0]" function]
["[0]" maybe (.use "[1]#[0]" functor)]]
[data
["[0]" product]
- ["[0]" text
+ ["[0]" text (.only)
["%" \\format (.only Format format)]]
[collection
["[0]" list (.use "[1]#[0]" functor mix)]]]
@@ -21,18 +21,24 @@
[net (.only URL)]]]]
[//
["[0]" xml (.only XML)]
- [css
+ ["[0]" css
["[0]" selector]
- ["[0]" style (.only Style)]]])
+ ["[0]" style (.only Style)]
+ ["[1]/[0]" id]
+ ["[1]/[0]" class]]])
(type .public Tag selector.Tag)
-(type .public ID selector.ID)
-(type .public Class selector.Class)
+(type .public ID css/id.ID)
+(type .public Class css/class.Class)
... Attributes for an HTML tag.
(type .public Attributes
(List [Text Text]))
+(def .public empty
+ Attributes
+ (list))
+
(type .public Script
js.Statement)
@@ -134,7 +140,7 @@
(format (text.enclosed ["<!--" "-->"] content)
(representation node))))
- (def (empty name attributes)
+ (def (empty_tag name attributes)
(-> Tag Attributes HTML)
(abstraction
(format (..open name attributes)
@@ -302,7 +308,7 @@
for
(when (list#each (product.uncurried ..area) areas)
{.#End}
- (..empty "map" attributes)
+ (..empty_tag "map" attributes)
{.#Item head tail}
(..tag "map" attributes
@@ -311,7 +317,7 @@
(.with_template [<name> <tag> <type>]
[(def .public <name>
(-> Attributes <type>)
- (..empty <tag>))]
+ (..empty_tag <tag>))]
[canvas "canvas" Element]
[progress "progress" Element]
@@ -342,7 +348,7 @@
(def .public label
(-> ID Input)
- (|>> ["for"] list (..empty "label")))
+ (|>> css/id.id ["for"] list (..empty_tag "label")))
(.with_template [<name> <container_tag> <description_tag> <type>]
[(def .public (<name> description attributes content)
@@ -468,7 +474,7 @@
(..description description)))
descriptions)
{.#End}
- (..empty "dl" attributes)
+ (..empty_tag "dl" attributes)
{.#Item head tail}
(..tag "dl" attributes
diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux
index 2d71738d0..da27d4a1a 100644
--- a/stdlib/source/library/lux/documentation.lux
+++ b/stdlib/source/library/lux/documentation.lux
@@ -492,7 +492,7 @@
(syntax (_ [[name parameters] ..declaration])
(do meta.monad
[.let [g!module (code.text (product.left name))]
- [[_ def_type def_value]] (meta.export name)
+ [def_type def_value] (meta.export name)
tags (meta.tags_of name)]
(macro.with_symbols [g!type]
(in (list (` (all md.then
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index 131e88b0d..cade6f127 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -173,16 +173,16 @@
name name])
(do maybe.monad
[$module (property.value module modules)
- definition (is (Maybe Global)
- (|> $module
- (is Module)
- (the .#definitions)
- (property.value name)))]
+ [exported? definition] (is (Maybe [Bit Global])
+ (|> $module
+ (is Module)
+ (the .#definitions)
+ (property.value name)))]
(when definition
{.#Alias [r_module r_name]}
(again r_module r_name)
- {.#Definition [exported? def_type def_value]}
+ {.#Definition [def_type def_value]}
(if (macro_type? def_type)
{.#Some (as Macro def_value)}
{.#None})
@@ -291,19 +291,19 @@
(with_template [<name> <yes> <no>]
[(def .public (<name> name)
- (-> Symbol (Meta Global))
+ (-> Symbol (Meta [Bit Global]))
(do ..monad
[name (..normal name)
.let [[normal_module normal_short] name]]
(function (_ lux)
- (when (is (Maybe Global)
+ (when (is (Maybe [Bit Global])
(do maybe.monad
[(open "[0]") (|> lux
(the .#modules)
(property.value normal_module))]
(property.value normal_short #definitions)))
- {.#Some definition}
- {try.#Success [lux definition]}
+ {.#Some exported?,definition}
+ {try.#Success [lux exported?,definition]}
_
(let [current_module (|> lux (the .#current_module) (maybe.else "???"))
@@ -321,9 +321,9 @@
(list#each (function (_ [module_name module])
(|> module
(the .#definitions)
- (list.all (function (_ [def_name global])
+ (list.all (function (_ [def_name [exported? global]])
(`` (when global
- {<yes> [exported? _]}
+ {<yes> _}
(if (and exported?
(text#= normal_short def_name))
{.#Some (symbol#encoded [module_name def_name])}
@@ -362,23 +362,21 @@
(-> Symbol (Meta Definition))
(do [! ..monad]
[name (..normal name)
- definition (..definition name)]
+ .let [[expected _] name]
+ [exported? definition] (..definition name)
+ actual ..current_module_name]
(when definition
{.#Definition it}
- (let [[exported? def_type def_value] it]
- (if exported?
- (in it)
- (do !
- [.let [[expected _] name]
- actual ..current_module_name]
- (if (text#= expected actual)
- (in it)
- (failure (all text#composite "Definition is not an export: " (symbol#encoded name)))))))
+ (if (or exported?
+ (text#= expected actual))
+ (in it)
+ (failure (all text#composite "Definition is not an export: " (symbol#encoded name))))
- {.#Alias de_aliased}
- (failure (all text#composite
- "Aliases are not considered exports: "
- (symbol#encoded name)))
+ {.#Alias it}
+ (if (or exported?
+ (text#= expected actual))
+ (export it)
+ (failure (all text#composite "Alias is not an export: " (symbol#encoded name))))
{.#Default _}
(failure (all text#composite
@@ -389,7 +387,7 @@
(-> Symbol (Meta Default))
(do [! ..monad]
[name (..normal name)
- definition (..default' name)]
+ [exported? definition] (..default' name)]
(when definition
{.#Definition _}
(failure (all text#composite
@@ -402,15 +400,14 @@
(symbol#encoded name)))
{.#Default it}
- (let [[exported? def_type def_value] it]
- (if exported?
- (in it)
- (do !
- [.let [[expected _] name]
- actual ..current_module_name]
- (if (text#= expected actual)
- (in it)
- (failure (all text#composite "Default is not an export: " (symbol#encoded name))))))))))
+ (if exported?
+ (in it)
+ (do !
+ [.let [[expected _] name]
+ actual ..current_module_name]
+ (if (text#= expected actual)
+ (in it)
+ (failure (all text#composite "Default is not an export: " (symbol#encoded name)))))))))
(with_template [<name> <slot> <type>]
[(def .public <name>
@@ -430,12 +427,12 @@
(def .public (definition_type name)
(-> Symbol (Meta Type))
(do ..monad
- [definition (definition name)]
+ [[exported? definition] (definition name)]
(when definition
{.#Alias de_aliased}
(definition_type de_aliased)
- {.#Definition [exported? def_type def_value]}
+ {.#Definition [def_type def_value]}
(clean_type def_type)
{.#Default _}
@@ -456,12 +453,12 @@
(def .public (type_definition name)
(-> Symbol (Meta Type))
(do ..monad
- [definition (definition name)]
+ [[exported? definition] (definition name)]
(when definition
{.#Alias de_aliased}
(type_definition de_aliased)
- {.#Definition [exported? def_type def_value]}
+ {.#Definition [def_type def_value]}
(let [type_code (`` (.in_module# (,, (static .prelude)) .type_code))]
(if (or (same? .Type def_type)
(at code.equivalence =
@@ -474,7 +471,7 @@
(..failure (all text#composite "Default is not a type: " (symbol#encoded name))))))
(def .public (globals module)
- (-> Text (Meta (List [Text Global])))
+ (-> Text (Meta (List [Text [Bit Global]])))
(function (_ lux)
(when (property.value module (the .#modules lux))
{.#Some module}
@@ -484,28 +481,54 @@
{try.#Failure (all text#composite "Unknown module: " module)})))
(def .public (definitions module)
- (-> Text (Meta (List [Text Definition])))
+ (-> Text (Meta (List [Text [Bit Definition]])))
(at ..monad each
- (list.all (function (_ [name global])
+ (list.all (function (_ [name [exported? global]])
(when global
{.#Alias de_aliased}
{.#None}
{.#Definition definition}
- {.#Some [name definition]}
+ {.#Some [name [exported? definition]]}
{.#Default _}
{.#None})))
(..globals module)))
+(def .public (resolved_globals module)
+ (-> Text (Meta (List [Text [Bit Definition]])))
+ (do [! ..monad]
+ [it (..globals module)
+ .let [it (list.all (function (_ [name [exported? global]])
+ (when global
+ {.#Alias de_aliased}
+ {.#Some [name exported? {.#Left de_aliased}]}
+
+ {.#Definition definition}
+ {.#Some [name exported? {.#Right definition}]}
+
+ {.#Default _}
+ {.#None}))
+ it)]]
+ (monad.each ! (function (_ [name exported? it])
+ (when it
+ {.#Left de_aliased}
+ (do !
+ [de_aliased (export de_aliased)]
+ (in [name [exported? de_aliased]]))
+
+ {.#Right definition}
+ (in [name [exported? definition]])))
+ it)))
+
(def .public (exports module_name)
(-> Text (Meta (List [Text Definition])))
(do ..monad
[constants (..definitions module_name)]
(in (do list.monad
- [[name [exported? def_type def_value]] constants]
+ [[name [exported? [def_type def_value]]] constants]
(if exported?
- (in [name [exported? def_type def_value]])
+ (in [name [def_type def_value]])
(list))))))
(def .public modules
@@ -527,9 +550,9 @@
(do ..monad
[.let [[module_name name] type_name]
module (..module module_name)]
- (in (list.one (function (_ [short global])
+ (in (list.one (function (_ [short [exported? global]])
(when global
- {.#Definition [exported? type value]}
+ {.#Definition [type value]}
(if (type#= Slot type)
(let [[label type] (as Label value)]
(when type
@@ -592,7 +615,7 @@
=module (..module module)
this_module_name ..current_module_name]
(when (property.value name (the .#definitions =module))
- {.#Some {.#Definition [exported? def_type def_value]}}
+ {.#Some [exported? {.#Definition [def_type def_value]}]}
(if (or (text#= this_module_name module)
exported?)
(if (type#= <type> def_type)
@@ -614,9 +637,9 @@
[=module (..module module)
this_module_name ..current_module_name]
(in (property.values
- (list#mix (function (_ [short global] output)
+ (list#mix (function (_ [short [exported? global]] output)
(when global
- {.#Definition [exported? type value]}
+ {.#Definition [type value]}
(if (and (type#= Slot type)
(or exported?
(text#= this_module_name module)))
@@ -657,7 +680,7 @@
(def .public (de_aliased def_name)
(-> Symbol (Meta Symbol))
(do ..monad
- [constant (..definition def_name)]
+ [[exported? constant] (..definition def_name)]
(in (when constant
{.#Alias real_def_name}
real_def_name
diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux
index 0daa166c6..ac2f31861 100644
--- a/stdlib/source/library/lux/meta/compiler/default/init.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/init.lux
@@ -108,7 +108,7 @@
(monad.each !
(function (_ [name handler])
(///declaration.lifted_analysis
- (moduleA.override_definition [.prelude name] {.#Default [true .Analysis handler]})))))]
+ (moduleA.override_definition [.prelude name] [true {.#Default [.Analysis handler]}])))))]
(in [])))
(def (with_generation_defaults bundle)
@@ -121,7 +121,7 @@
(monad.each !
(function (_ [name handler])
(///declaration.lifted_analysis
- (moduleA.override_definition [.prelude name] {.#Default [true .Generation handler]})))))]
+ (moduleA.override_definition [.prelude name] [true {.#Default [.Generation handler]}])))))]
(in [])))
(def (with_declaration_defaults bundle)
@@ -135,7 +135,7 @@
(function (_ [name handler])
(do !
[_ (///declaration.lifted_analysis
- (moduleA.override_definition [.prelude name] {.#Default [true .Declaration handler]}))]
+ (moduleA.override_definition [.prelude name] [true {.#Default [.Declaration handler]}]))]
(in [])))))]
(in [])))
diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux
index 6d1974ab8..c6f7c892f 100644
--- a/stdlib/source/library/lux/meta/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux
@@ -780,10 +780,10 @@
meta_state (the [///declaration.#analysis
///declaration.#state]
state)]
- [_ /#type /#value] (|> /#definition
- meta.export
- (meta.result meta_state)
- async#in)]
+ [/#type /#value] (|> /#definition
+ meta.export
+ (meta.result meta_state)
+ async#in)]
(async#in (if (check.subsumes? ..Custom /#type)
{try.#Success [context (the compiler.#parameters it) /#value]}
(exception.except ..invalid_custom_compiler [/#definition /#type]))))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux.lux
index d8fd8a22e..58b2833b9 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux.lux
@@ -23,7 +23,7 @@
(def .public format
(Format .Module)
(let [definition (is (Format Definition)
- (all _.and _.bit _.type _.any))
+ (all _.and _.type _.any))
alias (is (Format Alias)
(_.and _.text _.text))
global (is (Format Global)
@@ -37,7 +37,7 @@
... #module_aliases
(_.list alias)
... #definitions
- (_.list (_.and _.text global))
+ (_.list (_.and _.text (_.and _.bit global)))
... #imports
(_.list _.text)
... #module_state
@@ -47,7 +47,6 @@
(Parser .Module)
(let [definition (is (Parser Definition)
(all <>.and
- <binary>.bit
<binary>.type
<binary>.any))
alias (is (Parser Alias)
@@ -65,7 +64,7 @@
... #module_aliases
(<binary>.list alias)
... #definitions
- (<binary>.list (<>.and <binary>.text global))
+ (<binary>.list (<>.and <binary>.text (<>.and <binary>.bit global)))
... #imports
(<binary>.list <binary>.text)
... #module_state
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux
index 6fa95812d..8a47ab3b6 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux
@@ -95,8 +95,8 @@
[state]
{try.#Success})))
-(def .public (define name definition)
- (-> Text Global (Operation Any))
+(def .public (define name exported?,definition)
+ (-> Text [Bit Global] (Operation Any))
(do ///.monad
[self_name meta.current_module_name
self meta.current_module]
@@ -106,23 +106,24 @@
{try.#Success [(revised .#modules
(property.has self_name
(revised .#definitions
- (is (-> (List [Text Global]) (List [Text Global]))
- (|>> {.#Item [name definition]}))
+ (is (-> (List [Text [Bit Global]])
+ (List [Text [Bit Global]]))
+ (|>> {.#Item [name exported?,definition]}))
self))
state)
[]]}
- {.#Some already_existing}
+ {.#Some [_ already_existing]}
((/.except ..cannot_define_more_than_once [[self_name name] already_existing])
state)))))
-(def .public (override_definition [module short] definition)
- (-> Symbol Global (Operation Any))
+(def .public (override_definition [module short] exported?,definition)
+ (-> Symbol [Bit Global] (Operation Any))
(function (_ state)
{try.#Success [(revised .#modules
(property.revised module
(revised .#definitions
- (property.has short definition)))
+ (property.has short exported?,definition)))
state)
[]]}))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux
index c0ad23cb1..0424495e0 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux
@@ -83,22 +83,22 @@
current_module_name meta.current_module_name
lux meta.compiler_state]
(loop (again [[normal_module normal_short] name])
- (when (is (Maybe Global)
+ (when (is (Maybe [Bit Global])
(do maybe.monad
[(open "/[0]") (|> lux
(the .#modules)
(property.value normal_module))]
(property.value normal_short /#definitions)))
- {.#Some it}
+ {.#Some [exported? it]}
(when it
- {.#Definition [exported? type value]}
+ {.#Definition [type value]}
(if (or validated_global?
exported?
(text#= current_module_name normal_module))
(in it)
(meta.failure (%.format "Global is not an export: " (%.symbol name))))
- {.#Default [exported? type value]}
+ {.#Default [type value]}
(if (or validated_global?
exported?
(text#= current_module_name normal_module))
@@ -116,10 +116,10 @@
(do meta.monad
[global (..global validated_global? name)]
(when global
- {.#Definition [exported? type value]}
+ {.#Definition [type value]}
(in [type {#Normal value}])
- {.#Default [exported? type value]}
+ {.#Default [type value]}
(in [type {#Special value}])
{.#Alias _}
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux
index 114928b77..3daa22bc1 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -230,32 +230,38 @@
(-> Text Handler)
(..custom
[(<>.and <code>.text <code>.global)
- (function (again extension_name phase archive [quoted_module def_name])
+ (function (_ extension_name phase archive [quoted_module def_name])
(with_expansions [<return> (in (|> def_name reference.constant {analysis.#Reference}))]
- (do [! phase.monad]
- [constant (meta.definition def_name)]
- (when constant
- {.#Alias real_def_name}
- (again extension_name phase archive [quoted_module real_def_name])
-
- {.#Definition [exported? actualT _]}
- (do !
- [_ (typeA.inference actualT)
- (^.let def_name [::module ::name]) (meta.normal def_name)
- current meta.current_module_name]
- (if (text#= current ::module)
- <return>
- (if exported?
- (do !
- [imported! (meta.imported_by? ::module current)]
- (if (or imported!
- (text#= quoted_module ::module))
- <return>
- (analysis.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name])))
- (analysis.except ..global_has_not_been_exported [def_name]))))
-
- {.#Default _}
- (analysis.except ..defaults_cannot_be_referenced [def_name])))))]))
+ (loop (again [exported_alias? false
+ def_name def_name])
+ (do [! phase.monad]
+ [(^.let def_name [::module ::name]) (meta.normal def_name)
+ current meta.current_module_name
+ [exported? constant] (meta.definition def_name)]
+ (when constant
+ {.#Alias real_def_name}
+ (again (or exported_alias?
+ (text#= current ::module)
+ exported?)
+ real_def_name)
+
+ {.#Definition [actualT _]}
+ (do !
+ [_ (typeA.inference actualT)]
+ (if (or exported_alias?
+ (text#= current ::module))
+ <return>
+ (if exported?
+ (do !
+ [imported! (meta.imported_by? ::module current)]
+ (if (or imported!
+ (text#= quoted_module ::module))
+ <return>
+ (analysis.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name])))
+ (analysis.except ..global_has_not_been_exported [def_name]))))
+
+ {.#Default _}
+ (analysis.except ..defaults_cannot_be_referenced [def_name]))))))]))
(exception.def .public (unknown_local name)
(Exception Text)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
index d75f24433..988395df8 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
@@ -34,7 +34,7 @@
["[1][0]" analysis]
["/[1]" //
["/[1]" //
- ["[1][0]" analysis (.only)
+ ["[0]" analysis (.only)
[macro (.only Expander)]
["[1]/[0]" evaluation]
["[0]A" type]
@@ -227,15 +227,15 @@
(Operation anchor expression declaration Any))
(do [! phase.monad]
[state phase.state
- .let [eval (/////analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state)
- [(the [/////declaration.#synthesis /////declaration.#state] state)
- (the [/////declaration.#synthesis /////declaration.#phase] state)]
- [(the [/////declaration.#generation /////declaration.#state] state)
- (the [/////declaration.#generation /////declaration.#phase] state)])]
+ .let [eval (analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state)
+ [(the [/////declaration.#synthesis /////declaration.#state] state)
+ (the [/////declaration.#synthesis /////declaration.#phase] state)]
+ [(the [/////declaration.#generation /////declaration.#state] state)
+ (the [/////declaration.#generation /////declaration.#phase] state)])]
_ (/////declaration.lifted_analysis
(do !
- [_ (moduleA.override_definition [.prelude "is#"] {.#Default [true .Analysis (analysisE.is#_extension eval "is#")]})
- _ (moduleA.override_definition [.prelude "as#"] {.#Default [true .Analysis (analysisE.as#_extension eval "as#")]})]
+ [_ (moduleA.override_definition [.prelude "is#"] [true {.#Default [.Analysis (analysisE.is#_extension eval "is#")]}])
+ _ (moduleA.override_definition [.prelude "as#"] [true {.#Default [.Analysis (analysisE.as#_extension eval "as#")]}])]
(in [])))]
(in [])))
@@ -250,16 +250,38 @@
(..custom
[(all <>.and <code>.local <code>.any <code>.any)
(function (_ phase archive [short_name valueC exported?C])
- (do phase.monad
- [_ ..refresh
- current_module (/////declaration.lifted_analysis meta.current_module_name)
- .let [full_name [current_module short_name]]
- [type valueT value] (..definition archive full_name {.#None} valueC)
- [_ _ exported?] (evaluate! archive Bit exported?C)
- _ (/////declaration.lifted_analysis
- (moduleA.define short_name {.#Definition [(as Bit exported?) type value]}))
- _ (..announce_definition! short_name type)]
- (in /////declaration.no_requirements)))]))
+ (when valueC
+ [_ {.#Symbol original}]
+ (do phase.monad
+ [_ ..refresh
+ state phase.state
+ .let [analysis (the [/////declaration.#analysis /////declaration.#phase] state)]
+ [code//type codeA] (<| /////declaration.lifted_analysis
+ typeA.fresh
+ typeA.inferring
+ (analysis archive valueC))
+ [_ _ exported?] (evaluate! archive Bit exported?C)
+ .let [original (when codeA
+ (analysis.constant original)
+ original
+
+ _
+ (undefined))]
+ _ (/////declaration.lifted_analysis
+ (moduleA.define short_name [(as Bit exported?) {.#Alias original}]))]
+ (in /////declaration.no_requirements))
+
+ _
+ (do phase.monad
+ [_ ..refresh
+ current_module (/////declaration.lifted_analysis meta.current_module_name)
+ .let [full_name [current_module short_name]]
+ [type valueT value] (..definition archive full_name {.#None} valueC)
+ [_ _ exported?] (evaluate! archive Bit exported?C)
+ _ (/////declaration.lifted_analysis
+ (moduleA.define short_name [(as Bit exported?) {.#Definition [type value]}]))
+ _ (..announce_definition! short_name type)]
+ (in /////declaration.no_requirements))))]))
(def imports
(Parser (List Import))
@@ -284,36 +306,6 @@
(in [/////declaration.#imports imports
/////declaration.#referrals (list)])))]))
-(exception.def .public (cannot_alias_an_alias [local foreign target])
- (Exception [Alias Alias Symbol])
- (exception.report
- (list ["Local alias" (%.symbol local)]
- ["Foreign alias" (%.symbol foreign)]
- ["Target definition" (%.symbol target)])))
-
-(def (define_alias alias original)
- (-> Text Symbol (/////analysis.Operation Any))
- (do phase.monad
- [current_module meta.current_module_name
- constant (meta.definition original)]
- (when constant
- {.#Alias de_aliased}
- (phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased])
-
- {.#Definition _}
- (moduleA.define alias {.#Alias original}))))
-
-(def def_alias
- Handler
- (..custom
- [(all <>.and <code>.local <code>.symbol)
- (function (_ phase archive [alias def_name])
- (do phase.monad
- [_ (phase.sub [(the [/////declaration.#analysis /////declaration.#state])
- (has [/////declaration.#analysis /////declaration.#state])]
- (define_alias alias def_name))]
- (in /////declaration.no_requirements)))]))
-
... TODO: Stop requiring these types and the "swapped" function below to make types line-up.
(with_template [<name> <anonymous>]
[(def <name>
@@ -362,5 +354,4 @@
Bundle
(|> ///.empty
(dictionary.has "def#" lux::def)
- (dictionary.has "module#" def_module)
- (dictionary.has "alias#" def_alias)))
+ (dictionary.has "module#" def_module)))
diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
index e419e99aa..ae2df0fda 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
@@ -219,21 +219,22 @@
{.#End}
{try.#Success [definitions bundles output]}))))
content (document.content $.key document)
- definitions (monad.each ! (function (_ [def_name def_global])
+ definitions (monad.each ! (function (_ [def_name [exported? def_global]])
(when def_global
{.#Alias payload}
- (in (list [def_name def_global]))
+ (in (list [def_name [exported? def_global]]))
- {.#Definition [exported? type _]}
+ {.#Definition [type _]}
(|> definitions
(dictionary.value def_name)
try.of_maybe
- (at ! each (|>> [exported? type]
+ (at ! each (|>> [type]
{.#Definition}
+ [exported?]
[def_name]
(list))))
- {.#Default [exported? type _]}
+ {.#Default [type _]}
(in (list))))
(the .#definitions content))]
(in [(document.document $.key (has .#definitions (list#conjoint definitions) content))
diff --git a/stdlib/source/library/lux/meta/global.lux b/stdlib/source/library/lux/meta/global.lux
index e26d50afd..4f86381a7 100644
--- a/stdlib/source/library/lux/meta/global.lux
+++ b/stdlib/source/library/lux/meta/global.lux
@@ -34,7 +34,7 @@
(|> (do maybe.monad
[global (property.value short (the .#definitions module))]
(in (revised .#definitions
- (|>> (property.has short {.#Alias [here local]})
+ (|>> (property.has short [false {.#Alias [here local]}])
(property.has hidden global))
module)))
(maybe.else module))))))
diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux
index ed4c54849..c39bbd539 100644
--- a/stdlib/source/library/lux/meta/macro/context.lux
+++ b/stdlib/source/library/lux/meta/macro/context.lux
@@ -48,7 +48,7 @@
(do meta.monad
[.let [[@ expected_name] it]
defs (meta.definitions @)]
- (when (list.one (function (_ [actual_name [exported? type value]])
+ (when (list.one (function (_ [actual_name [exported? [type value]]])
(if (text#= expected_name actual_name)
{.#Some value}
{.#None}))
@@ -110,12 +110,12 @@
_
(exception.except ..not_a_definition [definition]))))
- on_globals (is (-> (property.List Global) (Try (property.List Global)))
+ on_globals (is (-> (property.List [Bit Global]) (Try (property.List [Bit Global])))
(function (_ globals)
(when (property.value context globals)
- {.#Some global}
+ {.#Some [exported? global]}
(try#each (function (_ global)
- (property.has context global globals))
+ (property.has context [exported? global] globals))
(on_global global))
{.#None}
@@ -146,12 +146,12 @@
(All (_ value)
(-> value (Stack' value)
(Meta Any)))
- (alter (function (_ _ [exported? type stack])
+ (alter (function (_ _ [type stack])
(|> stack
(as (Stack Any))
{.#Item top}
(is (Stack Any))
- [exported? type]
+ [type]
{try.#Success}))))
(.def .public push
@@ -163,7 +163,7 @@
(All (_ value)
(-> (Maybe (Predicate value)) (-> value value) (Stack' value)
(Meta Any)))
- (alter (function (_ @ [exported? type stack])
+ (alter (function (_ @ [type stack])
(let [stack (sharing [value]
(is (-> value value)
!)
@@ -183,7 +183,7 @@
_
(exception.except ..no_example [@])))]
- (in [exported? type stack]))
+ (in [type stack]))
{.#None}
(when stack
@@ -191,7 +191,7 @@
(|> stack'
(list.partial (! top))
(is (Stack Any))
- [exported? type]
+ [type]
{try.#Success})
_
@@ -207,10 +207,10 @@
(.def .public pop''
(All (_ value) (-> (Stack' value) (Meta Any)))
- (alter (function (_ _ [exported? type value])
+ (alter (function (_ _ [type value])
(|> (let [value (as (Stack Any) value)]
(maybe.else value (list.tail value)))
- [exported? type]
+ [type]
{try.#Success}))))
(.def .public pop'
diff --git a/stdlib/source/library/lux/meta/macro/local.lux b/stdlib/source/library/lux/meta/macro/local.lux
index d1e9c9475..b2367fee8 100644
--- a/stdlib/source/library/lux/meta/macro/local.lux
+++ b/stdlib/source/library/lux/meta/macro/local.lux
@@ -55,9 +55,9 @@
(-> [Symbol Macro] (Meta Any))
(do meta.monad
[[module_name definition_name] (meta.normal name)
- .let [definition (is Global {.#Definition [false .Macro macro]})
- add_macro! (is (-> (property.List Global) (property.List Global))
- (property.has definition_name definition))]]
+ .let [definition (is Global {.#Definition [.Macro macro]})
+ add_macro! (is (-> (property.List [Bit Global]) (property.List [Bit Global]))
+ (property.has definition_name [false definition]))]]
(..with_module module_name
(function (_ module)
(when (|> module (the .#definitions) (property.value definition_name))
@@ -72,7 +72,7 @@
(-> Symbol (Meta Any))
(do meta.monad
[[module_name definition_name] (meta.normal name)
- .let [lacks_macro! (is (-> (property.List Global) (property.List Global))
+ .let [lacks_macro! (is (-> (property.List [Bit Global]) (property.List [Bit Global]))
(property.lacks definition_name))]]
(..with_module module_name
(function (_ module)
diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux
index 2e9297eee..31e0dc1d9 100644
--- a/stdlib/source/library/lux/meta/macro/vocabulary.lux
+++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux
@@ -47,7 +47,7 @@
(` (.def (, public|private@by_name) ((, by_name) (, g!_))
(-> Symbol (Meta Macro))
(do ///.monad
- [[(, g!_) (, g!type) (, g!value)] (///.export (, g!_))]
+ [[(, g!type) (, g!value)] (///.export (, g!_))]
(if (at type.equivalence (,' =) (, type) (, g!type))
((,' in) ((, macro) (as (, type) (, g!value))))
(///.failure (exception.error ..invalid_type [(, type) (, g!type)])))))))))))
diff --git a/stdlib/source/library/lux/meta/type/implicit.lux b/stdlib/source/library/lux/meta/type/implicit.lux
index f265ac780..1e1a93c0d 100644
--- a/stdlib/source/library/lux/meta/type/implicit.lux
+++ b/stdlib/source/library/lux/meta/type/implicit.lux
@@ -143,8 +143,8 @@
<found?>)))
(def (available_definitions sig_type source_module target_module constants aggregate)
- (-> Type Text Text (List [Text Definition]) (-> (List [Symbol Type]) (List [Symbol Type])))
- (list#mix (function (_ [name [exported? def_type def_value]] aggregate)
+ (-> Type Text Text (List [Text [Bit Definition]]) (-> (List [Symbol Type]) (List [Symbol Type])))
+ (list#mix (function (_ [name [exported? [def_type def_value]]] aggregate)
(if (and (or (text#= target_module source_module)
exported?)
(compatible_type? sig_type def_type))
@@ -173,7 +173,7 @@
(-> Type (Meta (List [Symbol Type])))
(do [! ///.monad]
[this_module_name ///.current_module_name
- definitions (///.definitions this_module_name)]
+ definitions (///.resolved_globals this_module_name)]
(in (available_definitions sig_type this_module_name this_module_name definitions {.#End}))))
(def (imported_structs sig_type)
@@ -181,7 +181,7 @@
(do [! ///.monad]
[this_module_name ///.current_module_name
imported_modules (///.imported_modules this_module_name)
- accessible_definitions (monad.each ! ///.definitions imported_modules)]
+ accessible_definitions (monad.each ! ///.resolved_globals imported_modules)]
(in (list#mix (function (_ [imported_module definitions] tail)
(available_definitions sig_type imported_module this_module_name definitions tail))
{.#End}
diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux
index 37d9c0fd4..05cf85509 100644
--- a/stdlib/source/library/lux/world/net/http.lux
+++ b/stdlib/source/library/lux/world/net/http.lux
@@ -50,13 +50,3 @@
(Record
[#headers Headers
#body (Body !)]))
-
-(type .public (Request !)
- [Identification Protocol Resource (Message !)])
-
-(type .public (Response !)
- [Status (Message !)])
-
-(type .public (Server !)
- (-> (Request !)
- (! (Response !))))
diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux
index 49b376ee3..f3851016a 100644
--- a/stdlib/source/library/lux/world/net/http/client.lux
+++ b/stdlib/source/library/lux/world/net/http/client.lux
@@ -28,13 +28,14 @@
[syntax (.only syntax)]
["[0]" template]]]]]
["[0]" // (.only)
+ [response (.only Response)]
["[0]" header (.only Headers)]
[// (.only URL)]])
(type .public (Client !)
(Interface
(is (-> //.Method URL Headers (Maybe Binary)
- (! (Try (//.Response !))))
+ (! (Try (Response !))))
request)))
(def method_function
@@ -46,7 +47,7 @@
(def .public (<name> url headers data client)
(All (_ !)
(-> URL Headers (Maybe Binary) (Client !)
- (! (Try (//.Response !)))))
+ (! (Try (Response !)))))
(at client request {<method>} url headers data)))]
[//.#Post]
@@ -193,7 +194,7 @@
(Client IO)
(implementation
(def (request method url headers data)
- (is (IO (Try (//.Response IO)))
+ (is (IO (Try (Response IO)))
(do [! (try.with io.monad)]
[connection (|> url ffi.as_string java/net/URL::new java/net/URL::openConnection)
.let [connection (as java/net/HttpURLConnection connection)]
diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux
index 26005abe2..477fbf2e3 100644
--- a/stdlib/source/library/lux/world/net/http/request.lux
+++ b/stdlib/source/library/lux/world/net/http/request.lux
@@ -31,6 +31,18 @@
["[1][0]" query]
["[1][0]" cookie]])
+(type .public (Request !)
+ [Identification Protocol Resource (Message !)])
+
+(type .public (Server !)
+ (-> (Request !)
+ (! (Response !))))
+
+(def .public (static response)
+ (-> Response Server)
+ (function (_ request)
+ (async.resolved response)))
+
(def (merge inputs)
(-> (List Binary) Binary)
(let [[_ output] (try.trusted
diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux
index 7b223efed..9c280d019 100644
--- a/stdlib/source/library/lux/world/net/http/response.lux
+++ b/stdlib/source/library/lux/world/net/http/response.lux
@@ -1,74 +1,80 @@
(.require
[library
- [lux (.except static)
+ [lux (.except)
[control
- ["[0]" io]
+ ["[0]" try]
[concurrency
- ["[0]" async]
- ["[0]" frp (.use "[1]#[0]" monad)]]]
+ ["[0]" async (.only Async)]]]
[data
- ["[0]" text
- ["[0]" encoding]]
+ ["[0]" binary (.only Binary)]
+ [text
+ [encoding
+ ["[0]" utf8]]]
[format
["[0]" html]
["[0]" css (.only CSS)]
- ["[0]" context]
- ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]
- [world
- ["[0]" binary (.only Binary)]]]]
- ["[0]" // (.only Status Body Response Server)
- ["[0]" status]
- ["[0]" mime (.only MIME)]
+ ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]]]
+ ["[0]" // (.only Body Message)
+ ["[0]" status (.only Status)]
["[0]" header]
- [// (.only URL)]])
+ [// (.only URL)
+ ["[0]" mime (.only MIME)]]])
-(def .public (static response)
- (-> Response Server)
- (function (_ request)
- (async.resolved response)))
+(type .public (Response !)
+ (Record
+ [#status Status
+ #message (Message !)]))
(def .public empty
- (-> Status Response)
- (let [body (frp#in (at encoding.utf8 encoded ""))]
+ (-> Status (Response Async))
+ (let [body (is (Body Async)
+ (function (_ _)
+ (async.resolved {try.#Success [0 (at utf8.codec encoded "")]})))]
(function (_ status)
- [status
- [//.#headers (|> context.empty
- (header.content_length 0)
- (header.content_type mime.utf_8))
- //.#body body]])))
+ [#status status
+ #message [//.#headers (|> header.empty
+ (header.has header.content_length 0)
+ (header.has header.content_type mime.utf_8))
+ //.#body body]])))
(def .public (temporary_redirect to)
- (-> URL Response)
- (let [[status message] (..empty status.temporary_redirect)]
- [status (revised //.#headers (header.location to) message)]))
+ (-> URL (Response Async))
+ (|> status.temporary_redirect
+ ..empty
+ (revised [#message //.#headers] (header.has header.location to))))
(def .public not_found
- Response
+ (Response Async)
(..empty status.not_found))
(def .public (content status type data)
- (-> Status MIME Binary Response)
- [status
- [//.#headers (|> context.empty
- (header.content_length (binary.size data))
- (header.content_type type))
- //.#body (frp#in data)]])
+ (-> Status MIME Binary (Response Async))
+ (let [length (binary.size data)]
+ [#status status
+ #message [//.#headers (|> header.empty
+ (header.has header.content_length length)
+ (header.has header.content_type type))
+ //.#body (function (_ _)
+ (async.resolved {try.#Success [length data]}))]]))
(def .public bad_request
- (-> Text Response)
- (|>> (at encoding.utf8 encoded) (content status.bad_request mime.utf_8)))
+ (-> Text (Response Async))
+ (|>> (at utf8.codec encoded)
+ (content status.bad_request mime.utf_8)))
(def .public ok
- (-> MIME Binary Response)
+ (-> MIME Binary (Response Async))
(content status.ok))
(with_template [<name> <type> <mime> <pre>]
[(def .public <name>
- (-> <type> Response)
- (|>> <pre> (at encoding.utf8 encoded) (..ok <mime>)))]
+ (-> <type> (Response Async))
+ (|>> <pre>
+ (at utf8.codec encoded)
+ (..ok <mime>)))]
[text Text mime.utf_8 (<|)]
[html html.Document mime.html html.html]
- [css CSS mime.css css.css]
+ [css (CSS Any) mime.css css.css]
[json JSON mime.json json#encoded]
)
diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux
index 34a5a5a3d..4a9a633c9 100644
--- a/stdlib/source/test/lux/data/color/named.lux
+++ b/stdlib/source/test/lux/data/color/named.lux
@@ -3,6 +3,8 @@
[lux (.except)
[abstract
[monad (.only do)]]
+ [control
+ ["[0]" maybe]]
[data
[collection
["[0]" list]
@@ -214,6 +216,13 @@
(def unique_colors
(set.of_list //.hash ..all_colors))
+ (def .public random
+ (Random //.Color)
+ (do [! random.monad]
+ [choice (at ! each (n.% (set.size ..unique_colors))
+ random.nat)]
+ (in (maybe.trusted (list.item choice ..all_colors)))))
+
(def verdict
(n.= (list.size ..all_colors)
(set.size ..unique_colors)))
diff --git a/stdlib/source/test/lux/meta/type/resource.lux b/stdlib/source/test/lux/meta/type/resource.lux
index 33859dd4e..4b134ebbe 100644
--- a/stdlib/source/test/lux/meta/type/resource.lux
+++ b/stdlib/source/test/lux/meta/type/resource.lux
@@ -161,7 +161,7 @@
(syntax (_ [exception <code>.symbol
to_expand <code>.any])
(monad.do meta.monad
- [[_ _ exception] (meta.export exception)]
+ [[_ exception] (meta.export exception)]
(function (_ compiler)
{.#Right [compiler
(list (code.bit (when ((expansion.single to_expand) compiler)
diff --git a/stdlib/source/test/lux/meta/type/row.lux b/stdlib/source/test/lux/meta/type/row.lux
index fb2abf4de..b74441df1 100644
--- a/stdlib/source/test/lux/meta/type/row.lux
+++ b/stdlib/source/test/lux/meta/type/row.lux
@@ -112,7 +112,7 @@
(_.coverage [/.the]
(and (|> (/.row [@birth expected_birth
@life_span expected_life_span])
- (is Mortal)
+ (is (Mortal Any))
(/.the @birth)
(same? expected_birth))
(|> (/.row [@name expected_name
@@ -129,18 +129,48 @@
(/.the @id)
(same? expected_id))))
(_.coverage [/.has]
- (|> (/.row [@birth dummy_birth
- @life_span expected_life_span])
- (is Mortal)
- (/.has @birth expected_birth)
- (/.the @birth)
- (same? expected_birth)))
+ (and (|> (/.row [@birth dummy_birth
+ @life_span expected_life_span])
+ (is (Mortal Any))
+ (/.has @birth expected_birth)
+ (/.the @birth)
+ (same? expected_birth))
+ (|> (/.row [@name dummy_name
+ @birth expected_birth
+ @life_span expected_life_span])
+ (is (Human Any))
+ (/.has @name expected_name)
+ (/.the @name)
+ (same? expected_name))
+ (|> (/.row [@id dummy_id
+ @name expected_name
+ @birth expected_birth
+ @life_span expected_life_span])
+ (is (TransHuman Nat Any))
+ (/.has @id expected_id)
+ (/.the @id)
+ (same? expected_id))))
(_.coverage [/.revised]
- (|> (/.row [@birth dummy_birth
- @life_span expected_life_span])
- (is Mortal)
- (/.revised @birth (function (_ _) expected_birth))
- (/.the @birth)
- (same? expected_birth)))
+ (and (|> (/.row [@birth dummy_birth
+ @life_span expected_life_span])
+ (is (Mortal Any))
+ (/.revised @birth (function (_ _) expected_birth))
+ (/.the @birth)
+ (same? expected_birth))
+ (|> (/.row [@name dummy_name
+ @birth expected_birth
+ @life_span expected_life_span])
+ (is (Human Any))
+ (/.revised @name (function (_ _) expected_name))
+ (/.the @name)
+ (same? expected_name))
+ (|> (/.row [@id dummy_id
+ @name expected_name
+ @birth expected_birth
+ @life_span expected_life_span])
+ (is (TransHuman Nat Any))
+ (/.revised @id (function (_ _) expected_id))
+ (/.the @id)
+ (same? expected_id))))
))
)))
diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux
index b2c286fc0..08c56fa4b 100644
--- a/stdlib/source/test/lux/world/net.lux
+++ b/stdlib/source/test/lux/world/net.lux
@@ -16,7 +16,8 @@
["[1]/[0]" cookie]
["[1]/[0]" header]
["[1]/[0]" status]
- ["[1]/[0]" version]]
+ ["[1]/[0]" version]
+ ["[1]/[0]" response]]
["[1][0]" uri
["[1]/[0]" encoding]
["[1]/[0]" scheme]
@@ -45,6 +46,7 @@
/http/header.test
/http/status.test
/http/version.test
+ /http/response.test
/uri/encoding.test
/uri/scheme.test
diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux
index ed3eb915c..3eee7b77a 100644
--- a/stdlib/source/test/lux/world/net/http/client.lux
+++ b/stdlib/source/test/lux/world/net/http/client.lux
@@ -29,12 +29,13 @@
[\\library
["[0]" / (.only)
["/[1]" // (.only)
+ [response (.only Response)]
["[0]" header]
["[1][0]" status]]]])
(def (verification ! expected response)
(All (_ !)
- (-> (Monad !) Nat (! (Try (//.Response !)))
+ (-> (Monad !) Nat (! (Try (Response !)))
(! Bit)))
(do !
[response response]
diff --git a/stdlib/source/test/lux/world/net/http/response.lux b/stdlib/source/test/lux/world/net/http/response.lux
new file mode 100644
index 000000000..28d726a1f
--- /dev/null
+++ b/stdlib/source/test/lux/world/net/http/response.lux
@@ -0,0 +1,189 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["[0]" try (.use "[1]#[0]" functor)]
+ [concurrency
+ ["[0]" async]]]
+ [data
+ ["[0]" product]
+ ["[0]" binary (.use "[1]#[0]" equivalence)]
+ ["[0]" color
+ [named
+ ["[1]T" \\test]]]
+ ["[0]" text (.use "[1]#[0]" equivalence)
+ [encoding
+ ["[0]" utf8 (.use "[1]#[0]" codec)]]]
+ [format
+ ["[0]" html]
+ ["[0]" css (.only)
+ ["[0]" selector]
+ ["[0]" property]
+ ["[0]" value]]
+ ["[0]" json (.use "[1]#[0]" codec)
+ ["[1]T" \\test]]]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["n" nat]]]
+ [test
+ ["_" property (.only Test)]
+ ["[0]" unit]]]]
+ [\\library
+ ["[0]" / (.only)
+ ["/[1]" // (.only)
+ ["[0]" header]
+ ["[0]" status]
+ [//
+ ["[0]" mime (.use "[1]#[0]" equivalence)]]]]]
+ [//
+ ["[0]T" status]
+ [//
+ ["[0]T" mime]]])
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [expected_status statusT.random
+ expected_mime mimeT.random
+
+ utf8_length (at ! each (n.% 10) random.nat)
+ utf8 (random.upper_cased utf8_length)
+ .let [utf8_data (utf8#encoded utf8)]
+
+ expected_url (at ! each (text.prefix "http://www.example.com/")
+ (random.upper_cased 1))
+
+ .let [expected_html (html.html/5
+ (html.head (html.title (html.text utf8)))
+ (html.body (html.paragraph (list) (html.text utf8))))]
+ expected_json jsonT.random
+ color colorT.random
+ .let [expected_css (css.rule selector.any
+ (list [property.text_color
+ (value.rgb color)]))]])
+ (_.for [/.Response])
+ (`` (all _.and
+ (,, (with_template [<coverage> <response>
+ <status>
+ <content_length> <content_type>]
+ [(_.coverage [<coverage>]
+ (let [response <response>]
+ (and (same? <status> (the /.#status response))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_length)
+ (try#each (n.= <content_length>))
+ (try.else false))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_type)
+ (try#each (mime#= <content_type>))
+ (try.else false)))))]
+
+ [/.empty (/.empty expected_status) expected_status 0 mime.utf_8]
+ [/.not_found /.not_found status.not_found 0 mime.utf_8]
+ [/.content (/.content expected_status expected_mime utf8_data) expected_status utf8_length expected_mime]
+ [/.bad_request (/.bad_request utf8) status.bad_request utf8_length mime.utf_8]
+ [/.ok (/.ok expected_mime utf8_data) status.ok utf8_length expected_mime]
+ ))
+ (_.coverage [/.temporary_redirect]
+ (let [response (/.temporary_redirect expected_url)]
+ (and (same? status.temporary_redirect (the /.#status response))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.location)
+ (try#each (text#= expected_url))
+ (try.else false)))))
+ (in (do async.monad
+ [.let [response (/.text utf8)]
+ body ((the [/.#message //.#body] response) {.#None})]
+ (unit.coverage [/.text]
+ (and (same? status.ok (the /.#status response))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_length)
+ (try#each (n.= utf8_length))
+ (try.else false))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_type)
+ (try#each (mime#= mime.utf_8))
+ (try.else false))
+ (|> body
+ (try#each (|>> product.right
+ (binary#= utf8_data)))
+ (try.else false))))))
+ (in (do async.monad
+ [.let [response (/.html expected_html)
+ data (|> expected_html
+ html.html
+ utf8#encoded)
+ length (binary.size data)]
+ body ((the [/.#message //.#body] response) {.#None})]
+ (unit.coverage [/.html]
+ (and (same? status.ok (the /.#status response))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_length)
+ (try#each (n.= length))
+ (try.else false))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_type)
+ (try#each (mime#= mime.html))
+ (try.else false))
+ (|> body
+ (try#each (|>> product.right
+ (binary#= data)))
+ (try.else false))))))
+ (in (do async.monad
+ [.let [response (/.json expected_json)
+ data (|> expected_json
+ json#encoded
+ utf8#encoded)
+ length (binary.size data)]
+ body ((the [/.#message //.#body] response) {.#None})]
+ (unit.coverage [/.json]
+ (and (same? status.ok (the /.#status response))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_length)
+ (try#each (n.= length))
+ (try.else false))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_type)
+ (try#each (mime#= mime.json))
+ (try.else false))
+ (|> body
+ (try#each (|>> product.right
+ (binary#= data)))
+ (try.else false))))))
+ (in (do async.monad
+ [.let [response (/.css expected_css)
+ data (|> expected_css
+ css.css
+ utf8#encoded)
+ length (binary.size data)]
+ body ((the [/.#message //.#body] response) {.#None})]
+ (unit.coverage [/.css]
+ (and (same? status.ok (the /.#status response))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_length)
+ (try#each (n.= length))
+ (try.else false))
+ (|> response
+ (the [/.#message //.#headers])
+ (header.one header.content_type)
+ (try#each (mime#= mime.css))
+ (try.else false))
+ (|> body
+ (try#each (|>> product.right
+ (binary#= data)))
+ (try.else false))))))
+ ))))
diff --git a/stdlib/source/test/lux/world/net/http/status.lux b/stdlib/source/test/lux/world/net/http/status.lux
index f2522222a..a7cb40039 100644
--- a/stdlib/source/test/lux/world/net/http/status.lux
+++ b/stdlib/source/test/lux/world/net/http/status.lux
@@ -1,11 +1,16 @@
(.require
[library
[lux (.except all)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["[0]" maybe]]
[data
[collection
["[0]" list]
["[0]" set (.only Set)]]]
[math
+ ["[0]" random (.only Random)]
[number
["n" nat]]]
[meta
@@ -14,8 +19,7 @@
[test
["_" property (.only Test)]]]]
[\\library
- ["[0]" / (.only)
- ["/[1]" //]]])
+ ["[0]" /]])
(with_expansions [<categories> (these [informational
[/.continue
@@ -85,9 +89,9 @@
/.not_extended
/.network_authentication_required]])]
(def all
- (List //.Status)
+ (List /.Status)
(list.together (`` (list (,, (with_template [<category> <status+>]
- [((is (-> Any (List //.Status))
+ [((is (-> Any (List /.Status))
(function (_ _)
(`` (list (,, (template.spliced <status+>))))))
123)]
@@ -95,9 +99,16 @@
<categories>))))))
(def unique
- (Set //.Status)
+ (Set /.Status)
(set.of_list n.hash ..all))
+ (def .public random
+ (Random /.Status)
+ (do [! random.monad]
+ [choice (at ! each (n.% (set.size ..unique))
+ random.nat)]
+ (in (maybe.trusted (list.item choice all)))))
+
(def verdict
(n.= (list.size ..all)
(set.size ..unique)))