aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-bootstrapper/src/lux/base.clj6
-rw-r--r--stdlib/source/library/lux.lux47
-rw-r--r--stdlib/source/library/lux/meta.lux238
-rw-r--r--stdlib/source/library/lux/meta/compiler/default/init.lux45
-rw-r--r--stdlib/source/library/lux/meta/compiler/default/platform.lux49
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux.lux6
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux14
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux11
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux8
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux100
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux6
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux8
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux117
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux71
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/io/archive.lux12
15 files changed, 453 insertions, 285 deletions
diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj
index 8e99d8cde..2265c49af 100644
--- a/lux-bootstrapper/src/lux/base.clj
+++ b/lux-bootstrapper/src/lux/base.clj
@@ -129,8 +129,7 @@
"loader"
"classes"
"type-env"
- "dummy-mappings"
- ])
+ "dummy-mappings"])
(defvariant
("Build" 0)
@@ -150,7 +149,8 @@
(defvariant
("DefinitionG" 1)
- ("AliasG" 1))
+ ("AliasG" 1)
+ ("DefaultG" 1))
(deftuple
["info"
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index 19cc619a2..e1092f696 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -524,6 +524,15 @@
{#Product Bit {#Product Type Any}}})
.public)
+... (type .public Default
+... Definition)
+("lux def" Default
+ ("lux type check"
+ Type
+ {#Named [..prelude "Default"]
+ Definition})
+ .public)
+
... (type .public Alias
... Symbol)
("lux def" Alias
@@ -536,13 +545,15 @@
... (type .public Global
... (Variant
... {#Definition Definition}
-... {#Alias Alias}))
+... {#Alias Alias}
+... {#Default Default}))
("lux def" Global
("lux type check"
Type
{#Named [..prelude "Global"]
{#Sum Definition
- Alias}})
+ {#Sum Alias
+ Default}}})
.public)
("lux def" global_tags
@@ -550,10 +561,12 @@
{#Apply Symbol List}
{#Item [..prelude "#Definition"]
{#Item [..prelude "#Alias"]
- {#End}}})
+ {#Item [..prelude "#Default"]
+ {#End}}}})
#0)
("lux def" #Definition (tag [{#Some [0 #0 ..global_tags]} Global]) .public)
-("lux def" #Alias (tag [{#Some [0 #1 ..global_tags]} Global]) .public)
+("lux def" #Alias (tag [{#Some [1 #0 ..global_tags]} Global]) .public)
+("lux def" #Default (tag [{#Some [1 #1 ..global_tags]} Global]) .public)
... (type .public (Bindings k v)
... (Record
@@ -1907,7 +1920,10 @@
{#Right [state full_name]}
{#Alias real_name}
- {#Right [state real_name]}}
+ {#Right [state real_name]}
+
+ {#Default _}
+ {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}}
constant)
{#None}
@@ -2037,7 +2053,10 @@
{#Definition [exported? 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))})}
+ {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})
+
+ {#Default _}
+ {#Left (text#composite "Unknown definition: " (symbol#encoded name))}}
definition)}
(property#value expected_short definitions))}
(property#value expected_module modules))))
@@ -2713,7 +2732,10 @@
(if (text#= module current_module)
{#Some ("lux type as" Macro def_value)}
{#None}))
- {#None})}
+ {#None})
+
+ {#Default _}
+ {#None}}
("lux type check" Global gdef))))
(def' .private (named_macro full_name)
@@ -4545,7 +4567,10 @@
{#Definition [exported? def_type def_value]}
(if exported?
(list name)
- (list)))))
+ (list))
+
+ {#Default _}
+ (list))))
(let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module]
definitions))]
{#Right state (list#conjoint to_alias)})
@@ -4677,7 +4702,10 @@
(definition_type real_name state)
{#Definition [exported? def_type def_value]}
- {#Some def_type})))))
+ {#Some def_type}
+
+ {#Default _}
+ {#None})))))
(def (type_variable idx bindings)
(-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
@@ -5880,6 +5908,7 @@
(with_template [<type>]
[(def .public <type>
+ Type
(let [[_ short] (symbol <type>)]
{.#Primitive (text#composite "#" short) (list)}))]
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index 8f5195d1f..69211a03c 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -185,7 +185,10 @@
{.#Definition [exported? def_type def_value]}
(if (macro_type? def_type)
{.#Some (as Macro def_value)}
- {.#None})))))
+ {.#None})
+
+ {.#Default _}
+ {.#None}))))
{try.#Failure error}
{.#None})]}))))
@@ -286,66 +289,74 @@
(list.sorted text#<)
(text.interposed ..listing_separator)))
-(def .public (definition name)
- (-> Symbol (Meta Global))
- (do ..monad
- [name (..normal name)
- .let [[normal_module normal_short] name]]
- (function (_ lux)
- (when (is (Maybe Global)
- (do maybe.monad
- [(open "[0]") (|> lux
- (the .#modules)
- (property.value normal_module))]
- (property.value normal_short #definitions)))
- {.#Some definition}
- {try.#Success [lux definition]}
-
- _
- (let [current_module (|> lux (the .#current_module) (maybe.else "???"))
- all_known_modules (|> lux
- (the .#modules)
- (list#each product.left)
- ..module_listing)]
- {try.#Failure (all text#composite
- "Unknown definition: " (symbol#encoded name) text.new_line
- " Current module: " current_module text.new_line
- (when (property.value current_module (the .#modules lux))
- {.#Some this_module}
- (let [candidates (|> lux
- (the .#modules)
- (list#each (function (_ [module_name module])
- (|> module
- (the .#definitions)
- (list.all (function (_ [def_name global])
- (`` (when global
- {.#Definition [exported? _]}
- (if (and exported?
- (text#= normal_short def_name))
- {.#Some (symbol#encoded [module_name def_name])}
- {.#None})
-
- {.#Alias _}
- {.#None})))))))
- list.together
+(with_template [<name> <yes> <no>]
+ [(def .public (<name> name)
+ (-> Symbol (Meta Global))
+ (do ..monad
+ [name (..normal name)
+ .let [[normal_module normal_short] name]]
+ (function (_ lux)
+ (when (is (Maybe Global)
+ (do maybe.monad
+ [(open "[0]") (|> lux
+ (the .#modules)
+ (property.value normal_module))]
+ (property.value normal_short #definitions)))
+ {.#Some definition}
+ {try.#Success [lux definition]}
+
+ _
+ (let [current_module (|> lux (the .#current_module) (maybe.else "???"))
+ all_known_modules (|> lux
+ (the .#modules)
+ (list#each product.left)
+ ..module_listing)]
+ {try.#Failure (all text#composite
+ "Unknown definition: " (symbol#encoded name) text.new_line
+ " Current module: " current_module text.new_line
+ (when (property.value current_module (the .#modules lux))
+ {.#Some this_module}
+ (let [candidates (|> lux
+ (the .#modules)
+ (list#each (function (_ [module_name module])
+ (|> module
+ (the .#definitions)
+ (list.all (function (_ [def_name global])
+ (`` (when global
+ {<yes> [exported? _]}
+ (if (and exported?
+ (text#= normal_short def_name))
+ {.#Some (symbol#encoded [module_name def_name])}
+ {.#None})
+
+ {.#Alias _}
+ {.#None}
+
+ {<no> _}
+ {.#None})))))))
+ list.together
+ (list.sorted text#<)
+ (text.interposed ..listing_separator))
+ imports (|> this_module
+ (the .#imports)
+ ..module_listing)
+ aliases (|> this_module
+ (the .#module_aliases)
+ (list#each (function (_ [alias real]) (all text#composite alias " => " real)))
(list.sorted text#<)
- (text.interposed ..listing_separator))
- imports (|> this_module
- (the .#imports)
- ..module_listing)
- aliases (|> this_module
- (the .#module_aliases)
- (list#each (function (_ [alias real]) (all text#composite alias " => " real)))
- (list.sorted text#<)
- (text.interposed ..listing_separator))]
- (all text#composite
- " Candidates: " candidates text.new_line
- " Imports: " imports text.new_line
- " Aliases: " aliases text.new_line))
-
- _
- "")
- " All known modules: " all_known_modules text.new_line)})))))
+ (text.interposed ..listing_separator))]
+ (all text#composite
+ " Candidates: " candidates text.new_line
+ " Imports: " imports text.new_line
+ " Aliases: " aliases text.new_line))
+
+ _
+ "")
+ " All known modules: " all_known_modules text.new_line)})))))]
+
+ [definition .#Definition .#Default]
+ [default' .#Default .#Definition]
+ )
(def .public (export name)
(-> Symbol (Meta Definition))
@@ -353,22 +364,54 @@
[name (..normal name)
definition (..definition name)]
(when definition
- {.#Definition definition}
- (let [[exported? def_type def_value] definition]
+ {.#Definition it}
+ (let [[exported? def_type def_value] it]
(if exported?
- (in definition)
+ (in it)
(do !
[.let [[expected _] name]
actual ..current_module_name]
(if (text#= expected actual)
- (in definition)
+ (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)))
+
+ {.#Default _}
+ (failure (all text#composite
+ "Defaults are not considered exports: "
(symbol#encoded name))))))
+(def .public (default name)
+ (-> Symbol (Meta Default))
+ (do [! ..monad]
+ [name (..normal name)
+ definition (..default' name)]
+ (when definition
+ {.#Definition _}
+ (failure (all text#composite
+ "Definitions are not considered defaults: "
+ (symbol#encoded name)))
+
+ {.#Alias de_aliased}
+ (failure (all text#composite
+ "Aliases are not considered defaults: "
+ (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))))))))))
+
(def .public (definition_type name)
(-> Symbol (Meta Type))
(do ..monad
@@ -378,7 +421,12 @@
(definition_type de_aliased)
{.#Definition [exported? def_type def_value]}
- (clean_type def_type))))
+ (clean_type def_type)
+
+ {.#Default _}
+ (failure (all text#composite
+ "Defaults are not considered definitions: "
+ (symbol#encoded name))))))
(def .public (type name)
(-> Symbol (Meta Type))
@@ -405,7 +453,10 @@
(type_code .Type)
(type_code def_type)))
(in (as Type def_value))
- (..failure (all text#composite "Definition is not a type: " (symbol#encoded name))))))))
+ (..failure (all text#composite "Definition is not a type: " (symbol#encoded name)))))
+
+ {.#Default _}
+ (..failure (all text#composite "Default is not a type: " (symbol#encoded name))))))
(def .public (globals module)
(-> Text (Meta (List [Text Global])))
@@ -426,7 +477,10 @@
{.#None}
{.#Definition definition}
- {.#Some [name definition]})))
+ {.#Some [name definition]}
+
+ {.#Default _}
+ {.#None})))
(..globals module)))
(def .public (exports module_name)
@@ -594,17 +648,10 @@
real_def_name
{.#Definition _}
- def_name))))
+ def_name
-(def .public compiler_state
- (Meta Lux)
- (function (_ lux)
- {try.#Success [lux lux]}))
-
-(def .public type_context
- (Meta Type_Context)
- (function (_ lux)
- {try.#Success [lux (the .#type_context lux)]}))
+ {.#Default _}
+ def_name))))
(def .public (lifted result)
(All (_ a) (-> (Try a) (Meta a)))
@@ -615,6 +662,21 @@
{try.#Failure error}
(..failure error)))
+(with_template [<name> <slot> <type>]
+ [(def .public <name>
+ (Meta <type>)
+ (function (_ lux)
+ {try.#Success [lux (the <slot> lux)]}))]
+
+ [compiler_state [] Lux]
+
+ [type_context .#type_context Type_Context]
+
+ [target [.#info .#target] Text]
+ [version [.#info .#version] Text]
+ [configuration [.#info .#configuration] (List [Text Text])]
+ )
+
(def .public (eval type code)
(-> Type Code (Meta Any))
(do [! ..monad]
@@ -625,21 +687,9 @@
(def .public (try computation)
(All (_ it) (-> (Meta it) (Meta (Try it))))
(function (_ lux)
- (when (computation lux)
- {try.#Success [lux' output]}
- {try.#Success [lux' {try.#Success output}]}
-
- {try.#Failure error}
- {try.#Success [lux {try.#Failure error}]})))
+ {try.#Success (when (computation lux)
+ {try.#Success [lux' output]}
+ [lux' {try.#Success output}]
-(with_template [<type> <name> <slot>]
- [(def .public <name>
- (Meta <type>)
- (function (_ lux)
- {try.#Success [lux
- (the [.#info <slot>] lux)]}))]
-
- [Text target .#target]
- [Text version .#version]
- [(List [Text Text]) configuration .#configuration]
- )
+ {try.#Failure error}
+ [lux {try.#Failure error}])}))
diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux
index 519224bb7..b30769ba6 100644
--- a/stdlib/source/library/lux/meta/compiler/default/init.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/init.lux
@@ -64,13 +64,15 @@
(-> extension.Extender Lux (///generation.Phase anchor expression declaration))
(///generation.Bundle anchor expression declaration)
(///declaration.State+ anchor expression declaration)))
- (let [synthesis_state [synthesisE.bundle ///synthesis.init]
- generation_state [generation_bundle (///generation.state host module)]
+ (let [synthesis_state [extension.#bundle synthesisE.bundle
+ extension.#state ///synthesis.init]
+ generation_state [extension.#bundle generation_bundle
+ extension.#state (///generation.state host module)]
lux (///analysis.state (///analysis.info version.latest target configuration))
analysis_phase (analysisP.phase extender expander)
eval (///analysis/evaluation.evaluator analysis_phase
- [synthesis_state (synthesisP.phase extender lux)]
- [generation_state (generate extender lux)])
+ [synthesis_state (synthesisP.phase extender)]
+ [generation_state (generate extender)])
analysis_state [(analysisE.bundle eval host_analysis)
lux]]
[extension.empty
@@ -124,6 +126,33 @@
[(///generation.Buffer declaration)
Registry])
+(def (with_generation_defaults module)
+ (-> Text
+ (Operation Any))
+ (do [! ///phase.monad]
+ [state ///phase.state
+ _ (|> state
+ (the [extension.#state ///declaration.#generation ///declaration.#state extension.#bundle])
+ dictionary.entries
+ (monad.each !
+ (function (_ [name handler])
+ (///declaration.lifted_analysis
+ (moduleA.define name {.#Default [true .Generation handler]})))))]
+ (in [])))
+
+(def (with_defaults module)
+ (-> Text
+ (Operation Any))
+ (when module
+ .prelude
+ (do ///phase.monad
+ []
+ (with_generation_defaults module))
+
+ _
+ (with ///phase.monad
+ (in []))))
+
(def (begin dependencies hash input)
(-> (List descriptor.Module) Nat ///.Input
(All (_ anchor expression declaration)
@@ -131,11 +160,13 @@
[Source (Payload declaration)])))
(do ///phase.monad
[.let [module (the ///.#module input)]
- _ (///declaration.set_current_module module)]
+ _ (///declaration.set_current_module module)
+ _ (///declaration.lifted_analysis
+ (moduleA.create hash module))
+ _ (with_defaults module)]
(///declaration.lifted_analysis
(do [! ///phase.monad]
- [_ (moduleA.create hash module)
- _ (monad.each ! moduleA.import dependencies)
+ [_ (monad.each ! moduleA.import dependencies)
.let [source (///analysis.source (the ///.#module input) (the ///.#code input))]
_ (///analysis.set_source_code source)]
(in [source [///generation.empty_buffer
diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux
index 5608be3b2..eecc1ed00 100644
--- a/stdlib/source/library/lux/meta/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux
@@ -743,6 +743,34 @@
{try.#Failure error}
<cache_and_fail>)))))))
+ (def (complete_lux_compilation context platform
+ all_dependencies
+ @module module entry
+ archive state)
+ (All (_ <type_vars>)
+ (-> context.Context <Platform>
+ (Set descriptor.Module)
+ module.ID Text (archive.Entry Any)
+ Archive <State+>
+ (Return <State+>)))
+ (do ..monad
+ [_ (let [report (..module_compilation_log module state)]
+ (with_expansions [<else> (in (debug.log! report))]
+ (for @.js (is (Async (Try Any))
+ (when console.default
+ {.#None}
+ <else>
+
+ {.#Some console}
+ (console.write_line report console)))
+ <else>)))
+ .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)]
+ _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))]
+ (async#in (do try.monad
+ [archive (archive.has module entry archive)]
+ (in [archive
+ (..with_reset_log state)])))))
+
(def (lux_compiler import context platform compilation_sources configuration compiler compilation)
(All (_ <type_vars>)
(-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State+> .Module Any)
@@ -772,23 +800,10 @@
(again [archive state] more all_dependencies)
{.#Right entry}
- (do !
- [_ (let [report (..module_compilation_log module state)]
- (with_expansions [<else> (in (debug.log! report))]
- (for @.js (is (Async (Try Any))
- (when console.default
- {.#None}
- <else>
-
- {.#Some console}
- (console.write_line report console)))
- <else>)))
- .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)]
- _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))]
- (async#in (do try.monad
- [archive (archive.has module entry archive)]
- (in [archive
- (..with_reset_log state)])))))
+ (complete_lux_compilation context platform
+ all_dependencies
+ @module module entry
+ archive state))
{try.#Failure error}
<cache_and_fail>)))))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux.lux
index 1176afc91..d8fd8a22e 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux.lux
@@ -29,7 +29,8 @@
global (is (Format Global)
(all _.or
definition
- alias))]
+ alias
+ definition))]
(all _.and
... #module_hash
_.nat
@@ -56,7 +57,8 @@
global (is (Parser Global)
(all <binary>.or
definition
- alias))]
+ alias
+ definition))]
(all <>.and
... #module_hash
<binary>.nat
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux
index c89ce3db1..5327bb81a 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux
@@ -46,9 +46,9 @@
(All (_ anchor expression artifact)
(-> //.Phase
[synthesis.State+
- synthesis.Phase]
+ (-> Lux synthesis.Phase)]
[(generation.State+ anchor expression artifact)
- (generation.Phase anchor expression artifact)]
+ (-> Lux (generation.Phase anchor expression artifact))]
Eval))
(function (eval archive type exprC)
(do phase.monad
@@ -56,16 +56,18 @@
//scope.reset
(analysis archive exprC))
module (extensionP.lifted
- meta.current_module_name)]
+ meta.current_module_name)
+ lux (extensionP.lifted
+ meta.compiler_state)]
(<| phase.lifted
(do try.monad
[exprS (|> exprA
- (synthesis archive)
+ (synthesis lux archive)
(phase.result synthesis_state))])
(phase.result generation_state)
(do phase.monad
[@module (sharing [anchor expression artifact]
- (is (generation.Phase anchor expression artifact)
+ (is (-> Lux (generation.Phase anchor expression artifact))
generation)
(is (generation.Operation anchor expression artifact module.ID)
(generation.module_id module archive)))
@@ -75,5 +77,5 @@
("lux i64 left-shift" 16)
("lux i64 or" @eval)
("lux i64 left-shift" 32)))
- (generation archive exprS))]
+ (generation lux archive exprS))]
(generation.evaluate! [@module @eval] [{.#None} exprO]))))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux
index a88649369..363c97fe5 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux
@@ -117,12 +117,11 @@
.let [analysis (the [//extension.#state /.#analysis /.#phase] state)
compiler_eval (meta_eval archive
(the [//extension.#state /.#analysis /.#state //extension.#bundle] state)
- (let [analysis_state (the [//extension.#state /.#analysis /.#state //extension.#state] state)]
- (evaluation.evaluator analysis
- [(the [//extension.#state /.#synthesis /.#state] state)
- ((the [//extension.#state /.#synthesis /.#phase] state) analysis_state)]
- [(the [//extension.#state /.#generation /.#state] state)
- ((the [//extension.#state /.#generation /.#phase] state) analysis_state)])))
+ (evaluation.evaluator analysis
+ [(the [//extension.#state /.#synthesis /.#state] state)
+ (the [//extension.#state /.#synthesis /.#phase] state)]
+ [(the [//extension.#state /.#generation /.#state] state)
+ (the [//extension.#state /.#generation /.#phase] state)]))
extension_eval (as Eval (wrapper (as_expected compiler_eval)))]
_ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))]
(when code
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 aa15450d3..7a6c27ad8 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
@@ -139,8 +139,8 @@
{try.#Success [[bundle' state'] output]}
{try.#Success [[bundle' (set old state')] output]}
- {try.#Failure error}
- {try.#Failure error})))))
+ failure
+ failure)))))
(def .public (temporary transform)
(All (_ s i o v)
@@ -152,8 +152,8 @@
{try.#Success [[bundle' state'] output]}
{try.#Success [[bundle' state] output]}
- {try.#Failure error}
- {try.#Failure error}))))
+ failure
+ failure))))
(def .public (with_state state)
(All (_ s i o v)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux
index 79e514a76..f59e344ac 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Type Module Primitive Analysis Declaration char int type)
+ [lux (.except Type Module Primitive Analysis Declaration #Default char int type)
["[0]" ffi (.only import)]
[abstract
["[0]" monad (.only do)]]
@@ -36,8 +36,8 @@
["[0]" template]]
[target
["[0]" jvm
- ["[0]!" reflection]
["_" bytecode (.only Bytecode) (.use "[1]#[0]" monad)]
+ ["[0]!" reflection]
["[0]" modifier (.only Modifier) (.use "[1]#[0]" monoid)]
["[0]" attribute]
["[0]" field]
@@ -465,7 +465,7 @@
..reflection)
(list)})
(analyse archive arrayC))]
- (in {/////analysis.#Extension ["" extension_name] (list arrayA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list arrayA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -486,8 +486,8 @@
:read: (typeA.check (check.clean (list) :read:))
:write: (typeA.check (check.clean (list) :write:))
arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))]
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature arrayJT))
- arrayA)})))
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature arrayJT))
+ arrayA)})))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -502,7 +502,7 @@
(analyse archive lengthC))
_ (typeA.inference {.#Primitive (|> (jvm.array primitive_type) ..reflection)
(list)})]
- (in {/////analysis.#Extension ["" extension_name] (list lengthA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list lengthA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -523,8 +523,8 @@
{.#None}
(/////analysis.except ..non_array expectedT))]
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature elementJT))
- lengthA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature elementJT))
+ lengthA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -703,7 +703,7 @@
arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array jvm_type) ..reflection)
(list)})
(analyse archive arrayC))]
- (in {/////analysis.#Extension ["" extension_name] (list idxA arrayA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list idxA arrayA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)]))))
@@ -726,9 +726,9 @@
:read: (typeA.check (check.clean (list) :read:))
:write: (typeA.check (check.clean (list) :write:))
arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))]
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature arrayJT))
- idxA
- arrayA)})))
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature arrayJT))
+ idxA
+ arrayA)})))
_
(/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)]))))
@@ -748,9 +748,9 @@
(analyse archive valueC))
arrayA (<| (typeA.expecting array_type)
(analyse archive arrayC))]
- (in {/////analysis.#Extension ["" extension_name] (list idxA
- valueA
- arrayA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list idxA
+ valueA
+ arrayA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)])))))
@@ -775,10 +775,10 @@
:read: (typeA.check (check.clean (list) :read:))
:write: (typeA.check (check.clean (list) :write:))
arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))]
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature arrayJT))
- idxA
- valueA
- arrayA)})))
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature arrayJT))
+ idxA
+ valueA
+ arrayA)})))
_
(/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)]))))
@@ -842,7 +842,7 @@
[expectedT (///.lifted meta.expected_type)
[_ :object:] (check_object expectedT)
_ (typeA.inference :object:)]
- (in {/////analysis.#Extension ["" extension_name] (list)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 0 (list.size args)]))))
@@ -857,7 +857,7 @@
[objectT objectA] (typeA.inferring
(analyse archive objectC))
_ (check_object objectT)]
- (in {/////analysis.#Extension ["" extension_name] (list objectA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list objectA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -872,7 +872,7 @@
(analyse archive monitorC))
_ (check_object monitorT)
exprA (analyse archive exprC)]
- (in {/////analysis.#Extension ["" extension_name] (list monitorA exprA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list monitorA exprA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)]))))
@@ -892,7 +892,7 @@
(if ?
(in [])
(/////analysis.except non_throwable exception_class)))]
- (in {/////analysis.#Extension ["" extension_name] (list exceptionA)}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list exceptionA)}))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -908,7 +908,7 @@
[_ (..ensure_fresh_class! class_loader class)
_ (typeA.inference {.#Primitive "java.lang.Class" (list {.#Primitive class (list)})})
_ (phase.lifted (reflection!.load class_loader class))]
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text class))}))
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text class))}))
_
(/////analysis.except ///.invalid_syntax [extension_name %.code args]))
@@ -929,7 +929,7 @@
[object_class _] (check_object objectT)
? (phase.lifted (reflection!.sub? class_loader object_class sub_class))]
(if ?
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text sub_class) objectA)})
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text sub_class) objectA)})
(/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))]))
(def (class_candidate_parents class_loader from_name fromT to_name to_class)
@@ -1018,9 +1018,9 @@
_
false)))))))]
(if can_cast?
- (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text from_name)
- (/////analysis.text to_name)
- fromA)})
+ (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text from_name)
+ (/////analysis.text to_name)
+ fromA)})
(/////analysis.except ..cannot_cast [fromJT toJT fromC])))
_
@@ -1054,7 +1054,7 @@
(not deprecated?))
fieldT (reflection_type luxT.fresh fieldJT)
_ (typeA.inference fieldT)]
- (in (<| {/////analysis.#Extension ["" extension_name]}
+ (in (<| {/////analysis.#Extension [.prelude extension_name]}
(list (/////analysis.text class)
(/////analysis.text field)
(/////analysis.text (..signature fieldJT)))))))]))
@@ -1078,7 +1078,7 @@
fieldT (reflection_type luxT.fresh fieldJT)
valueA (<| (typeA.expecting fieldT)
(analyse archive valueC))]
- (in (<| {/////analysis.#Extension ["" extension_name]}
+ (in (<| {/////analysis.#Extension [.prelude extension_name]}
(list (/////analysis.text class)
(/////analysis.text field)
(/////analysis.text (..signature fieldJT))
@@ -1103,7 +1103,7 @@
(not deprecated?))
fieldT (reflection_type mapping fieldJT)
_ (typeA.inference fieldT)]
- (in (<| {/////analysis.#Extension ["" extension_name]}
+ (in (<| {/////analysis.#Extension [.prelude extension_name]}
(list (/////analysis.text class)
(/////analysis.text field)
(/////analysis.text (..signature fieldJT))
@@ -1132,7 +1132,7 @@
fieldT (reflection_type mapping fieldJT)
valueA (<| (typeA.expecting fieldT)
(analyse archive valueC))]
- (in (<| {/////analysis.#Extension ["" extension_name]}
+ (in (<| {/////analysis.#Extension [.prelude extension_name]}
(list (/////analysis.text class)
(/////analysis.text field)
(/////analysis.text (..signature fieldJT))
@@ -1518,10 +1518,10 @@
(not deprecated?))
[outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC))
outputJT (check_return outputT)]
- (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
- (/////analysis.text method)
- (/////analysis.text (..signature outputJT))
- (decorate_inputs argsT argsA))})))]))
+ (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
+ (/////analysis.text method)
+ (/////analysis.text (..signature outputJT))
+ (decorate_inputs argsT argsA))})))]))
(def (invoke::virtual class_loader)
(-> java/lang/ClassLoader Handler)
@@ -1542,11 +1542,11 @@
_
(undefined))]
outputJT (check_return outputT)]
- (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
- (/////analysis.text method)
- (/////analysis.text (..signature outputJT))
- objectA
- (decorate_inputs argsT argsA))})))]))
+ (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
+ (/////analysis.text method)
+ (/////analysis.text (..signature outputJT))
+ objectA
+ (decorate_inputs argsT argsA))})))]))
(def (invoke::special class_loader)
(-> java/lang/ClassLoader Handler)
@@ -1567,11 +1567,11 @@
_
(undefined))]
outputJT (check_return outputT)]
- (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
- (/////analysis.text method)
- (/////analysis.text (..signature outputJT))
- objectA
- (decorate_inputs argsT argsA))})))]))
+ (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
+ (/////analysis.text method)
+ (/////analysis.text (..signature outputJT))
+ objectA
+ (decorate_inputs argsT argsA))})))]))
(def (invoke::interface class_loader)
(-> java/lang/ClassLoader Handler)
@@ -1595,7 +1595,7 @@
_
(undefined))]
outputJT (check_return outputT)]
- (in {/////analysis.#Extension ["" extension_name]
+ (in {/////analysis.#Extension [.prelude extension_name]
(list.partial (/////analysis.text (..signature (jvm.class class_name (list))))
(/////analysis.text method)
(/////analysis.text (..signature outputJT))
@@ -1614,8 +1614,8 @@
_ (phase.assertion ..deprecated_method [class ..constructor_method methodT]
(not deprecated?))
[outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC))]
- (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
- (decorate_inputs argsT argsA))})))]))
+ (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list))))
+ (decorate_inputs argsT argsA))})))]))
(def (bundle::member class_loader)
(-> java/lang/ClassLoader Bundle)
@@ -2709,7 +2709,7 @@
.let [supers {.#Item super_class super_interfaces}]
_ (..require_complete_method_concretion class_loader supers methods)
methodsA (monad.each ! (analyse_overriden_method analyse archive selfT mapping supers) methods)]
- (in {/////analysis.#Extension ["" extension_name]
+ (in {/////analysis.#Extension [.prelude extension_name]
(list (class_analysis super_class)
(/////analysis.tuple (list#each class_analysis super_interfaces))
(/////analysis.tuple (list#each typed_analysis constructor_argsA+))
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 b80344bc1..f311c48ec 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
@@ -65,7 +65,7 @@
(<| (typeA.expecting argT)
(analyse archive argC)))
(list.zipped_2 inputsT+ args))]
- (in {analysis.#Extension ["" extension_name] argsA}))
+ (in {analysis.#Extension [.prelude extension_name] argsA}))
(analysis.except ///.incorrect_arity [extension_name num_expected num_actual]))))))
(def .public (nullary valueT)
@@ -125,7 +125,7 @@
(list (analysis.tuple (list#each (|>> analysis.nat) cases))
branch))))
(list.partial input else)
- {analysis.#Extension ["" extension_name]}))))])))
+ {analysis.#Extension [.prelude extension_name]}))))])))
... "lux is" represents reference/pointer equality.
(def lux::is
@@ -150,7 +150,7 @@
(|> opC
(analyse archive)
(typeA.expecting (type_literal (-> .Any :var:)))
- (at ! each (|>> list {analysis.#Extension ["" extension_name]})))))
+ (at ! each (|>> list {analysis.#Extension [.prelude extension_name]})))))
_
(analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
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 50054b9cb..caddd4c81 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
@@ -226,13 +226,11 @@
(-> /////analysis.Bundle (Operation anchor expression declaration Any)))
(do phase.monad
[[bundle state] phase.state
- .let [analysis_state (the [/////declaration.#analysis /////declaration.#state ///.#state] state)
- analysis_phase (the [/////declaration.#analysis /////declaration.#phase] state)
- eval (/////analysis/evaluation.evaluator analysis_phase
+ .let [eval (/////analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state)
[(the [/////declaration.#synthesis /////declaration.#state] state)
- ((the [/////declaration.#synthesis /////declaration.#phase] state) analysis_state)]
+ (the [/////declaration.#synthesis /////declaration.#phase] state)]
[(the [/////declaration.#generation /////declaration.#state] state)
- ((the [/////declaration.#generation /////declaration.#phase] state) analysis_state)])
+ (the [/////declaration.#generation /////declaration.#phase] state)])
previous_analysis_extensions (the [/////declaration.#analysis /////declaration.#state ///.#bundle] state)]]
(phase.with [bundle
(revised [/////declaration.#analysis /////declaration.#state]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux
index fc45197f5..b31d36e9b 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux
@@ -24,7 +24,7 @@
[dependency
["[1]/[0]" artifact]]]]]]]]
["[0]" /
- [runtime (.only Operation Phase)]
+ [runtime (.only Operation Phase Handler)]
["[1][0]" primitive]
["[1][0]" structure]
["[1][0]" reference]
@@ -46,79 +46,98 @@
["Expected" (%.type expected)]
["Actual" (%.type actual)])))
+(exception.def .public (extension_error error)
+ (Exception Text)
+ error)
+
(def (extension_application extender lux
phase archive
name parameters)
(-> extension.Extender Lux
- (-> extension.Extender Lux Phase) Archive
+ Phase Archive
Symbol (List Synthesis)
(Operation (Bytecode Any)))
- (when (|> name
- meta.export
+ (when (|> (do [! meta.monad]
+ [definition (meta.try (meta.export name))]
+ (when definition
+ {try.#Success [exported? type definition]}
+ (in [exported? type {.#Left definition}])
+
+ {try.#Failure error}
+ (do !
+ [[exported? type default] (meta.default name)]
+ (in [exported? type {.#Right default}]))))
+ (is (Meta [Bit Type (Either Any Any)]))
(meta.result lux))
{try.#Success [exported? type value]}
(if (check.subsumes? .Generation type)
- ((extender value) "" (phase extender lux) archive parameters)
+ (when value
+ {.#Left definition}
+ ((extender definition) "" phase archive parameters)
+
+ {.#Right default}
+ ((as Handler default) "" phase archive parameters))
(///.except ..not_an_extension [name .Generation type]))
{try.#Failure error}
- (///.failure error)))
+ (///.except ..extension_error [error])))
-(def .public (generate extender lux archive synthesis)
+(def .public (generate extender lux)
(-> extension.Extender Lux Phase)
- (when synthesis
- (^.with_template [<tag> <generator>]
- [(<tag> value)
- (///#in (<generator> value))])
- ([synthesis.bit /primitive.bit]
- [synthesis.i64 /primitive.i64]
- [synthesis.f64 /primitive.f64]
- [synthesis.text /primitive.text])
+ (function (phase archive synthesis)
+ (when synthesis
+ (^.with_template [<tag> <generator>]
+ [(<tag> value)
+ (///#in (<generator> value))])
+ ([synthesis.bit /primitive.bit]
+ [synthesis.i64 /primitive.i64]
+ [synthesis.f64 /primitive.f64]
+ [synthesis.text /primitive.text])
- (synthesis.variant variantS)
- (/structure.variant (generate extender lux) archive variantS)
+ (synthesis.variant variantS)
+ (/structure.variant phase archive variantS)
- (synthesis.tuple members)
- (/structure.tuple (generate extender lux) archive members)
+ (synthesis.tuple members)
+ (/structure.tuple phase archive members)
- {synthesis.#Reference reference}
- (when reference
- {reference.#Variable variable}
- (/reference.variable archive variable)
-
- {reference.#Constant constant}
- (/reference.constant archive constant))
+ {synthesis.#Reference reference}
+ (when reference
+ {reference.#Variable variable}
+ (/reference.variable archive variable)
+
+ {reference.#Constant constant}
+ (/reference.constant archive constant))
- (synthesis.branch/when [valueS pathS])
- (/when.when (generate extender lux) archive [valueS pathS])
+ (synthesis.branch/when [valueS pathS])
+ (/when.when phase archive [valueS pathS])
- (synthesis.branch/exec [this that])
- (/when.exec (generate extender lux) archive [this that])
+ (synthesis.branch/exec [this that])
+ (/when.exec phase archive [this that])
- (synthesis.branch/let [inputS register bodyS])
- (/when.let (generate extender lux) archive [inputS register bodyS])
+ (synthesis.branch/let [inputS register bodyS])
+ (/when.let phase archive [inputS register bodyS])
- (synthesis.branch/if [conditionS thenS elseS])
- (/when.if (generate extender lux) archive [conditionS thenS elseS])
+ (synthesis.branch/if [conditionS thenS elseS])
+ (/when.if phase archive [conditionS thenS elseS])
- (synthesis.branch/get [path recordS])
- (/when.get (generate extender lux) archive [path recordS])
+ (synthesis.branch/get [path recordS])
+ (/when.get phase archive [path recordS])
- (synthesis.loop/scope scope)
- (/loop.scope (generate extender lux) archive scope)
+ (synthesis.loop/scope scope)
+ (/loop.scope phase archive scope)
- (synthesis.loop/again updates)
- (/loop.again (generate extender lux) archive updates)
+ (synthesis.loop/again updates)
+ (/loop.again phase archive updates)
- (synthesis.function/abstraction abstraction)
- (/function.abstraction (generate extender lux) archive abstraction)
+ (synthesis.function/abstraction abstraction)
+ (/function.abstraction phase archive abstraction)
- (synthesis.function/apply application)
- (/function.apply (generate extender lux) archive application)
+ (synthesis.function/apply application)
+ (/function.apply phase archive application)
- {synthesis.#Extension [["" name] parameters]}
- (extension.apply archive (generate extender lux) [name parameters])
+ {synthesis.#Extension [["" name] parameters]}
+ (extension.apply archive phase [name parameters])
- {synthesis.#Extension [name parameters]}
- (extension_application extender lux generate archive name parameters)
- ))
+ {synthesis.#Extension [name parameters]}
+ (extension_application extender lux phase archive name parameters)
+ )))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux
index 1e5562447..539c17856 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux
@@ -25,7 +25,7 @@
["/[1]" //
["[1][0]" extension]
["/[1]" //
- ["/" synthesis (.only Synthesis Operation Phase Extender)
+ ["/" synthesis (.only Synthesis Operation Phase Extender Handler)
["[1][0]" simple]]
["[1][0]" analysis (.only Analysis)
["[2][0]" simple]
@@ -68,23 +68,42 @@
phase archive
name parameters)
(-> Extender Lux
- (-> Extender Lux Phase) Archive
+ Phase Archive
Symbol (List Analysis)
(Operation Synthesis))
- (when (|> name
- meta.export
+ (when (|> (do [! meta.monad]
+ [definition (meta.try (meta.export name))]
+ (when definition
+ {try.#Success [exported? type definition]}
+ (in [exported? type {.#Left definition}])
+
+ {try.#Failure error}
+ (do !
+ [[exported? type default] (meta.default name)]
+ (in [exported? type {.#Right default}]))))
+ (is (Meta [Bit Type (Either Any Any)]))
(meta.result lux))
{try.#Success [exported? type value]}
(if (check.subsumes? .Synthesis type)
- ((extender value) "" (phase extender lux) archive parameters)
- (phase.except ..not_an_extension [name .Synthesis type]))
+ (when value
+ {.#Left definition}
+ ((extender definition) "" phase archive parameters)
+
+ {.#Right default}
+ ((as Handler default) "" phase archive parameters))
+ ... (phase.except ..not_an_extension [name .Synthesis type])
+ (|> parameters
+ (monad.each phase.monad (phase archive))
+ (phase#each (|>> [name] {/.#Extension}))))
{try.#Failure error}
- (phase.failure error)))
+ (|> parameters
+ (monad.each phase.monad (phase archive))
+ (phase#each (|>> [name] {/.#Extension})))))
-(def (optimization phase extender lux archive)
- (-> Phase Extender Lux Phase)
- (function (optimization' analysis)
+(def (optimization extender lux)
+ (-> Extender Lux Phase)
+ (function (phase archive analysis)
(when analysis
{///analysis.#Simple analysis'}
(phase#in {/.#Simple (..simple analysis')})
@@ -96,38 +115,39 @@
(/.with_currying? false
(when structure
{///complex.#Variant variant}
- (do phase.monad
- [valueS (optimization' (the ///complex.#value variant))]
- (in (/.variant (has ///complex.#value valueS variant))))
+ (phase#each
+ (function (_ valueS)
+ (/.variant (has ///complex.#value valueS variant)))
+ (phase archive (the ///complex.#value variant)))
{///complex.#Tuple tuple}
(|> tuple
- (monad.each phase.monad optimization')
+ (monad.each phase.monad (phase archive))
(phase#each (|>> /.tuple)))))
{///analysis.#When inputA branchesAB+}
(/.with_currying? false
- (/when.synthesize (optimization phase extender lux) branchesAB+ archive inputA))
+ (/when.synthesize phase branchesAB+ archive inputA))
(///analysis.no_op value)
- (optimization' value)
+ (phase archive value)
{///analysis.#Apply _}
(/.with_currying? false
- (/function.apply (optimization phase extender lux) archive analysis))
+ (/function.apply phase archive analysis))
{///analysis.#Function environmentA bodyA}
- (/function.abstraction (optimization phase extender lux) environmentA archive bodyA)
+ (/function.abstraction phase environmentA archive bodyA)
{///analysis.#Extension ["" name] args}
(/.with_currying? false
(function (_ state)
- (|> (//extension.apply archive (optimization phase extender lux) [name args])
+ (|> (//extension.apply archive phase [name args])
(phase.result' state)
(pipe.when
{try.#Failure _}
(|> args
- (monad.each phase.monad optimization')
+ (monad.each phase.monad (phase archive))
(phase#each (|>> [["" name]] {/.#Extension}))
(phase.result' state))
@@ -136,13 +156,12 @@
{///analysis.#Extension name parameters}
(extension_application extender lux
- (optimization phase) archive
+ phase archive
name parameters)
)))
-(def .public (phase extender lux)
+(def .public (phase extender lux archive analysis)
(-> Extender Lux Phase)
- (function (phase archive analysis)
- (do phase.monad
- [synthesis (..optimization phase extender lux archive analysis)]
- (phase.lifted (/variable.optimization synthesis)))))
+ (do phase.monad
+ [synthesis (..optimization extender lux archive analysis)]
+ (phase.lifted (/variable.optimization synthesis))))
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 1d1aaca4b..71f055c64 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
@@ -16,7 +16,7 @@
["%" \\format (.only format)]]
[collection
[set (.only Set)]
- ["[0]" list (.use "[1]#[0]" mix)]
+ ["[0]" list (.use "[1]#[0]" mix monad)]
["[0]" dictionary (.only Dictionary)]
["[0]" sequence (.only Sequence)]]]
[meta
@@ -222,7 +222,7 @@
definitions (monad.each ! (function (_ [def_name def_global])
(when def_global
{.#Alias payload}
- (in [def_name def_global])
+ (in (list [def_name def_global]))
{.#Definition [exported? type _]}
(|> definitions
@@ -230,9 +230,13 @@
try.of_maybe
(at ! each (|>> [exported? type]
{.#Definition}
- [def_name])))))
+ [def_name]
+ (list))))
+
+ {.#Default [exported? type _]}
+ (in (list))))
(the .#definitions content))]
- (in [(document.document $.key (has .#definitions definitions content))
+ (in [(document.document $.key (has .#definitions (list#conjoint definitions) content))
bundles])))
(def (load_definitions fs context @module host_environment entry)