From 7661faaa22a253bb4703992b638038d96ead0ade Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 25 Jan 2022 21:26:50 -0400 Subject: Bug fixes for eval in general and in Lux/Ruby. --- documentation/bookmark/algorithm/graph.md | 4 + lux-jvm/source/luxc/lang/directive/jvm.lux | 18 +- lux-jvm/source/luxc/lang/translation/jvm.lux | 11 +- lux-ruby/source/program.lux | 107 ++++++------ stdlib/source/library/lux/static.lux | 58 +++++-- stdlib/source/library/lux/target/ruby.lux | 2 + .../compiler/language/lux/analysis/evaluation.lux | 91 +++++----- .../tool/compiler/language/lux/analysis/type.lux | 52 ++++++ .../lux/tool/compiler/language/lux/generation.lux | 16 +- .../tool/compiler/language/lux/phase/analysis.lux | 8 +- .../compiler/language/lux/phase/analysis/case.lux | 44 +++-- .../language/lux/phase/analysis/function.lux | 22 ++- .../language/lux/phase/analysis/inference.lux | 76 ++++----- .../language/lux/phase/analysis/reference.lux | 46 ++--- .../language/lux/phase/analysis/simple.lux | 19 +-- .../language/lux/phase/analysis/structure.lux | 164 +++++++++--------- .../compiler/language/lux/phase/analysis/type.lux | 56 ------- .../tool/compiler/language/lux/phase/directive.lux | 56 +++---- .../language/lux/phase/extension/analysis/jvm.lux | 185 ++++++++++----------- .../language/lux/phase/extension/analysis/lux.lux | 117 +++++++------ .../language/lux/phase/extension/analysis/ruby.lux | 134 ++++++++------- .../language/lux/phase/extension/directive/lux.lux | 65 ++++---- .../lux/phase/extension/generation/ruby/host.lux | 4 +- .../language/lux/phase/generation/jvm/host.lux | 2 +- .../lux/phase/generation/ruby/function.lux | 10 +- .../language/lux/phase/generation/ruby/runtime.lux | 11 +- .../lux/phase/generation/ruby/structure.lux | 2 +- .../lux/tool/compiler/meta/packager/ruby.lux | 9 +- stdlib/source/test/lux/extension.lux | 11 +- stdlib/source/test/lux/static.lux | 136 +++++++-------- stdlib/source/test/lux/target/ruby.lux | 38 +++++ .../lux/tool/compiler/language/lux/analysis.lux | 2 + .../tool/compiler/language/lux/analysis/type.lux | 119 +++++++++++++ .../language/lux/phase/analysis/simple.lux | 25 ++- 34 files changed, 951 insertions(+), 769 deletions(-) create mode 100644 documentation/bookmark/algorithm/graph.md create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux diff --git a/documentation/bookmark/algorithm/graph.md b/documentation/bookmark/algorithm/graph.md new file mode 100644 index 000000000..68c06e81b --- /dev/null +++ b/documentation/bookmark/algorithm/graph.md @@ -0,0 +1,4 @@ +# Reference + +0. [GraphBLAS: Building a C++ Matrix API for Graph Algorithms - Benjamin Brock & Scott McMillan](https://www.youtube.com/watch?v=xMBNCtFV8sI) + diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 009bec5b4..3960a3532 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -40,14 +40,14 @@ ["[0]" phase] [language [lux - ["[0]" analysis {"+" Analysis}] ["[0]" synthesis {"+" Synthesis}] ["[0]" generation] ["[0]" directive {"+" Requirements}] + ["[0]" analysis {"+" Analysis} + ["[0]A" type]] [phase [analysis - ["[0]A" scope] - ["[0]A" type]] + ["[0]A" scope]] ["[0]" extension ["[0]" bundle] [analysis @@ -1054,8 +1054,8 @@ constructor_argumentsA (monad.each ! (function (_ [typeJ termC]) (do ! [typeL (//A.reflection_type mapping typeJ) - termA (typeA.with_type typeL - (analyse archive termC))] + termA (<| (typeA.expecting typeL) + (analyse archive termC))] (in [typeJ termA]))) constructor_argumentsC) selfT (//A.reflection_type mapping (/type.class class_name class_tvars)) @@ -1069,7 +1069,7 @@ {.#Item [self selfT]} list.reversed (list#mix scopeA.with_local (analyse archive bodyC)) - (typeA.with_type returnT) + (typeA.expecting returnT) analysis.with_scope)] (in [privacy strict_floating_point? annotations method_tvars exceptions self arguments constructor_argumentsA @@ -1099,7 +1099,7 @@ {.#Item [self selfT]} list.reversed (list#mix scopeA.with_local (analyse archive bodyC)) - (typeA.with_type returnT) + (typeA.expecting returnT) analysis.with_scope)] (in [[super_name super_tvars] method_name strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ @@ -1127,7 +1127,7 @@ {.#Item [self selfT]} list.reversed (list#mix scopeA.with_local (analyse archive bodyC)) - (typeA.with_type returnT) + (typeA.expecting returnT) analysis.with_scope)] (in [name privacy final? strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ @@ -1152,7 +1152,7 @@ [_scope bodyA] (|> arguments' list.reversed (list#mix scopeA.with_local (analyse archive bodyC)) - (typeA.with_type returnT) + (typeA.expecting returnT) analysis.with_scope)] (in [name privacy strict_floating_point? annotations method_tvars arguments returnJ exceptionsJ diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 0dcb684e9..c2f7cea68 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -109,10 +109,9 @@ ..class_path_separator (%.nat module_id) ..class_path_separator (%.nat artifact_id))) -(def: (evaluate! library loader context valueI) - (-> Library java/lang/ClassLoader generation.Context Inst (Try [Any Definition])) - (let [eval_class (..class_name context) - bytecode_name (..bytecode_name eval_class) +(def: (evaluate! library loader eval_class valueI) + (-> Library java/lang/ClassLoader Text Inst (Try [Any Definition])) + (let [bytecode_name (..bytecode_name eval_class) bytecode (def.class {jvm.#V1_6} {jvm.#Public} jvm.noneC bytecode_name @@ -149,7 +148,7 @@ (def: (define! library loader context custom valueI) (-> Library java/lang/ClassLoader generation.Context (Maybe Text) Inst (Try [Text Any Definition])) (do try.monad - [[value definition] (evaluate! library loader context valueI)] + [[value definition] (evaluate! library loader (..class_name context) valueI)] (in [(maybe.else (..class_name context) custom) value definition]))) @@ -163,7 +162,7 @@ (implementation (def: (evaluate context valueI) (# try.monad each product.left - (..evaluate! library loader context valueI))) + (..evaluate! library loader (format "E" (..class_name context)) valueI))) (def: execute (..execute! library loader)) diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index 3a55ccafc..cd037a5b1 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -288,6 +288,7 @@ [java/lang/Long [{try.#Success}]] [java/lang/Double [{try.#Success}]] [java/lang/String [{try.#Success}]] + [org/jruby/RubyFixnum [org/jruby/RubyFixnum::getLongValue {try.#Success}]] [org/jruby/RubyString [org/jruby/RubyString::asJavaString {try.#Success}]] [[java/lang/Object] [{try.#Success}]] [org/jruby/RubyArray [(read_tuple read)]] @@ -708,10 +709,10 @@ (for [@.old (as_is (exception: .public (invaid_phase_application [partial_application (List Any) - arity Nat]) + arity (List Any)]) (exception.report ["Partial Application" (%.nat (list.size partial_application))] - ["Arity" (%.nat arity)])) + ["Arity" (%.nat (list.size arity))])) (def: proc_type org/jruby/runtime/Block$Type @@ -758,64 +759,70 @@ _ org/jruby/runtime/Block]) org/jruby/runtime/builtin/IRubyObject (<| try.trusted - (let [inputs (array.list {.#None} inputs)]) + (do [! try.monad] + [inputs (|> inputs + (array.list {.#None}) + (monad.each ! (|>> (:as java/lang/Object) ..read)))]) (case inputs + ... It seems that org/jruby/runtime/Block::call can misbehave when getting called with a Lux state value. + (^ (list info source location current_module modules scopes type_context expected seed scope_type_vars extensions eval host)) + (case partial_application + (^ (list partial/0 partial/1)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + partial/1 + [info source location current_module modules scopes type_context expected seed scope_type_vars extensions eval host]))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) + (^ (list)) {try.#Success (host_phase partial_application phase)} (^ (list input/0)) - (do try.monad - [input/0 (..read (:as java/lang/Object input/0))] - (case partial_application - (^ (list)) - (in (host_phase (list input/0) phase)) - - (^ (list partial/0)) - (in (host_phase (list partial/0 input/0) phase)) - - (^ (list partial/0 partial/1)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - partial/0 - partial/1 - input/0))) - - _ - (exception.except ..invaid_phase_application [partial_application (list.size inputs)]))) + (case partial_application + (^ (list)) + (in (host_phase (list input/0) phase)) + + (^ (list partial/0)) + (in (host_phase (list partial/0 input/0) phase)) + + (^ (list partial/0 partial/1)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + partial/1 + input/0))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) (^ (list input/0 input/1)) - (do try.monad - [input/0 (..read (:as java/lang/Object input/0)) - input/1 (..read (:as java/lang/Object input/1))] - (case partial_application - (^ (list)) - (in (host_phase (list input/0 input/1) phase)) - - (^ (list partial/0)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - partial/0 - input/0 - input/1))) - - _ - (exception.except ..invaid_phase_application [partial_application (list.size inputs)]))) + (case partial_application + (^ (list)) + (in (host_phase (list input/0 input/1) phase)) + + (^ (list partial/0)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + input/0 + input/1))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) (^ (list input/0 input/1 input/2)) - (do try.monad - [input/0 (..read (:as java/lang/Object input/0)) - input/1 (..read (:as java/lang/Object input/1)) - input/2 (..read (:as java/lang/Object input/2))] - (case partial_application - (^ (list)) - (in (..to_host ((:as (-> Any Any Any Any) phase) - input/0 - input/1 - input/2))) - - _ - (exception.except ..invaid_phase_application [partial_application (list.size inputs)]))) + (case partial_application + (^ (list)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + input/0 + input/1 + input/2))) + + _ + (exception.except ..invaid_phase_application [partial_application inputs])) _ - (exception.except ..invaid_phase_application [partial_application (list.size inputs)])))))] + (exception.except ..invaid_phase_application [partial_application inputs])))))] (org/jruby/RubyProc::newProc (!ruby_runtime) block ..proc_type))) (def: (extender phase_wrapper) @@ -873,7 +880,7 @@ (let [normal_runtime? (_.do "const_defined?" (list (_.string (_.code _.command_line_arguments))) {.#None} - (_.local "Object"))] + (: _.CVar (_.manual "Object")))] (_.statement (_.apply_lambda/* (list (runtime.lux//program_args (_.? normal_runtime? _.command_line_arguments diff --git a/stdlib/source/library/lux/static.lux b/stdlib/source/library/lux/static.lux index c3acd7967..9bb38bd1d 100644 --- a/stdlib/source/library/lux/static.lux +++ b/stdlib/source/library/lux/static.lux @@ -1,18 +1,21 @@ (.using - [library - [lux {"-" nat int rev} - ["[0]" meta] - [abstract - [monad {"+" do}]] - [control - ["<>" parser - ["<[0]>" code]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code]] - [math - [number {"+" hex}] - ["[0]" random {"+" Random}]]]]) + [library + [lux {"-" nat int rev} + ["[0]" meta] + [abstract + [monad {"+" do}]] + [control + ["<>" parser + ["<[0]>" code]]] + [data + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]] + [math + [number {"+" hex}] + ["[0]" random {"+" Random}]]]]) (template [ ] [(syntax: .public ( [expression .any]) @@ -37,11 +40,22 @@ (syntax: .public (literal [format .any expression .any]) (do meta.monad - [pair (meta.eval (type ) + [pair (meta.eval (.type ) (` [(~ format) (~ expression)])) .let [[format expression] (:as pair)]] (in (list (format expression)))))) +(with_expansions [ (Ex (_ a) + [(-> a Code) + (List a)])] + (syntax: .public (literals [format .any + expression .any]) + (do meta.monad + [pair (meta.eval (.type ) + (` [(~ format) (~ expression)])) + .let [[format expression] (:as pair)]] + (in (list#each format expression))))) + (template [ ] [(syntax: .public ( []) (do meta.monad @@ -69,3 +83,17 @@ .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) random)]] (in (list (format result)))))) + +(with_expansions [ (Ex (_ a) + [(-> a Code) + (Random (List a))])] + (syntax: .public (randoms [format .any + random .any]) + (do meta.monad + [pair (meta.eval (type ) + (` [(~ format) (~ random)])) + .let [[format random] (:as pair)] + seed meta.seed + .let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + random)]] + (in (list#each format result))))) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index d243b6046..edc4d44f8 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -128,6 +128,8 @@ ["0" script_name] ["$" process_id] ["?" exit_status] + + ["stdout" stdout] ) (template [ ] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux index b780e2137..218e9172d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -1,39 +1,37 @@ (.using - [library - [lux {"-" Module} - ["[0]" meta] - [abstract - [monad {"+" do}]] - [control - ["[0]" try]] - [math - [number - ["n" nat]]]]] - ["[0]" // {"+" Operation} - [macro {"+" Expander}] - [// - [phase - ["[0]P" extension] - ["[0]P" synthesis] - ["[0]P" analysis - ["[0]" type]] - [// - ["[0]" synthesis] - ["[0]" generation {"+" Context}] - [/// - ["[0]" phase] - [meta - [archive {"+" Archive} - [descriptor {"+" Module}]]]]]]]]) + [library + [lux "*" + ["[0]" meta] + [abstract + [monad {"+" do}]] + [control + ["[0]" try {"+" Try}]] + [data + [text + ["%" format]]] + [math + [number {"+" hex} + ["n" nat] + ["[0]" i64]]]]] + ["[0]" // {"+" Operation} + ["[0]" type] + [macro {"+" Expander}] + [// + [phase + ["[0]P" extension] + ["[0]P" synthesis] + ["[0]P" analysis] + [// + ["[0]" synthesis] + ["[0]" generation {"+" Context}] + [/// + ["[0]" phase] + [meta + ["[0]" archive {"+" Archive}]]]]]]]) (type: .public Eval (-> Archive Type Code (Operation Any))) -(def: (context [module_id artifact_id]) - (-> Context Context) - ... TODO: Find a better way that doesn't rely on clever tricks. - [(n.- module_id 0) artifact_id]) - (def: .public (evaluator expander synthesis_state generation_state generate) (All (_ anchor expression artifact) (-> Expander @@ -44,17 +42,22 @@ (let [analyze (analysisP.phase expander)] (function (eval archive type exprC) (do phase.monad - [exprA (type.with_type type - (//.without_scopes - (analyze archive exprC))) + [count (extensionP.lifted + meta.seed) + exprA (<| (type.expecting type) + //.without_scopes + (analyze archive exprC)) module (extensionP.lifted - meta.current_module_name) - count (extensionP.lifted - meta.seed)] - (phase.lifted (do try.monad - [exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))] - (phase.result generation_state - (do phase.monad - [exprO (generate archive exprS) - module_id (generation.module_id module archive)] - (generation.evaluate! (..context [module_id count]) exprO))))))))) + meta.current_module_name)] + (<| phase.lifted + (do try.monad + [exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))]) + (phase.result generation_state) + (let [shift (|> count + (i64.left_shifted 32) + (i64.or (hex "FF,FF,FF,FF")))]) + (do phase.monad + [exprO (generation.with_registry_shift shift + (generate archive exprS)) + module_id (generation.module_id module archive)] + (generation.evaluate! [module_id count] exprO))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux new file mode 100644 index 000000000..7e06dc71a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux @@ -0,0 +1,52 @@ +(.using + [library + [lux "*" + ["[0]" meta] + [abstract + [monad {"+" do}]] + [control + ["[0]" function] + ["[0]" try]] + [type + ["[0]" check {"+" Check}]]]] + ["/" // {"+" Operation} + [// + [phase + ["[0]" extension]] + [/// + ["[0]" phase]]]]) + +(def: .public (expecting expected) + (All (_ a) (-> Type (Operation a) (Operation a))) + (extension.localized (value@ .#expected) (with@ .#expected) + (function.constant {.#Some expected}))) + +(def: .public (check action) + (All (_ a) (-> (Check a) (Operation a))) + (function (_ (^@ stateE [bundle state])) + (case (action (value@ .#type_context state)) + {try.#Success [context' output]} + {try.#Success [[bundle (with@ .#type_context context' state)] + output]} + + {try.#Failure error} + ((/.failure error) stateE)))) + +(def: .public fresh + (All (_ a) (-> (Operation a) (Operation a))) + (extension.localized (value@ .#type_context) (with@ .#type_context) + (function.constant check.fresh_context))) + +(def: .public (inference actualT) + (-> Type (Operation Any)) + (do phase.monad + [expectedT (extension.lifted meta.expected_type)] + (..check (check.check expectedT actualT)))) + +(def: .public (inferring action) + (All (_ a) (-> (Operation a) (Operation [Type a]))) + (do phase.monad + [[_ varT] (..check check.var) + output (..expecting varT action) + knownT (..check (check.clean varT))] + (in [knownT output]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 077747e0d..7342e46ed 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -77,6 +77,7 @@ #host (Host expression directive) #buffer (Maybe (Buffer directive)) #registry Registry + #registry_shift Nat #counter Nat #context (Maybe artifact.ID) #log (Sequence Text) @@ -104,6 +105,7 @@ #host host #buffer {.#None} #registry registry.empty + #registry_shift 0 #counter 0 #context {.#None} #log sequence.empty @@ -324,12 +326,24 @@ (in [[bundle' (with@ #context (value@ #context state) state')] output])))) +(def: .public (with_registry_shift shift body) + (All (_ anchor expression directive a) + (-> Nat + (Operation anchor expression directive a) + (Operation anchor expression directive a))) + (function (_ [bundle state]) + (do try.monad + [[[bundle' state'] output] (body [bundle (with@ #registry_shift shift state)])] + (in [[bundle' (with@ #registry_shift (value@ #registry_shift state) state')] + output])))) + (def: .public (with_new_context archive dependencies body) (All (_ anchor expression directive a) (-> Archive (Set artifact.Dependency) (Operation anchor expression directive a) (Operation anchor expression directive [Context a]))) (function (_ (^@ stateE [bundle state])) - (let [[id registry'] (registry.resource false dependencies (value@ #registry state))] + (let [[id registry'] (registry.resource false dependencies (value@ #registry state)) + id (n.+ id (value@ #registry_shift state))] (do try.monad [[[bundle' state'] output] (body [bundle (|> state (with@ #registry registry') diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index 3add55843..d4f217dd0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -16,7 +16,6 @@ ["[0]" meta ["[0]" location]]]] ["[0]" / "_" - ["[1][0]" type] ["[1][0]" simple] ["[1][0]" structure] ["[1][0]" reference] @@ -26,7 +25,8 @@ ["[1][0]" extension] ["/[1]" // "_" ["/" analysis {"+" Analysis Operation Phase} - ["[1][0]" macro {"+" Expander}]] + ["[1][0]" macro {"+" Expander}] + ["[1][0]" type]] [/// ["//" phase] ["[0]" reference] @@ -104,8 +104,8 @@ (^ {.#Form (list& functionC argsC+)}) (do [! //.monad] - [[functionT functionA] (/type.with_inference - (compile archive functionC))] + [[functionT functionA] (/type.inferring + (compile archive functionC))] (case functionA {/.#Reference {reference.#Constant def_name}} (do ! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index e2d411efe..2b99be974 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -25,7 +25,6 @@ ["[1][0]" coverage {"+" Coverage}] ["/[1]" // "_" ["[1][0]" scope] - ["[1][0]" type] ["[1][0]" structure] ["/[1]" // "_" ["[1][0]" extension] @@ -33,7 +32,8 @@ ["/" analysis {"+" Analysis Operation Phase} ["[1][0]" simple] ["[1][0]" complex] - ["[1][0]" pattern {"+" Pattern}]] + ["[1][0]" pattern {"+" Pattern}] + ["[1][0]" type]] [/// ["[1]" phase]]]]]]) @@ -93,8 +93,7 @@ (.case caseT {.#Var id} (do ///.monad - [?caseT' (//type.with_env - (check.peek id))] + [?caseT' (/type.check (check.peek id))] (.case ?caseT' {.#Some caseT'} (again envs caseT') @@ -110,23 +109,22 @@ {.#ExQ _} (do ///.monad - [[var_id varT] (//type.with_env - check.var)] + [[var_id varT] (/type.check check.var)] (again envs (maybe.trusted (type.applied (list varT) caseT)))) {.#Apply inputT funcT} (.case funcT {.#Var funcT_id} (do ///.monad - [funcT' (//type.with_env - (do check.monad - [?funct' (check.peek funcT_id)] - (.case ?funct' - {.#Some funct'} - (in funct') - - _ - (check.except ..cannot_simplify_for_pattern_matching caseT))))] + [funcT' (/type.check + (do check.monad + [?funct' (check.peek funcT_id)] + (.case ?funct' + {.#Some funct'} + (in funct') + + _ + (check.except ..cannot_simplify_for_pattern_matching caseT))))] (again envs {.#Apply inputT funcT'})) _ @@ -151,8 +149,7 @@ (All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) (/.with_location location (do ///.monad - [_ (//type.with_env - (check.check inputT type)) + [_ (/type.check (check.check inputT type)) outputA next] (in [output outputA])))) @@ -263,8 +260,7 @@ (do ! [_ (.case inputT {.#Var _id} - (//type.with_env - (check.check inputT recordT)) + (/type.check (check.check inputT recordT)) _ (in []))] @@ -307,8 +303,7 @@ {.#UnivQ _} (do ///.monad - [[ex_id exT] (//type.with_env - check.existential)] + [[ex_id exT] (/type.check check.existential)] (analyse_pattern num_tags (maybe.trusted (type.applied (list exT) inputT')) pattern @@ -322,8 +317,7 @@ (do ///.monad [tag (///extension.lifted (meta.normal tag)) [idx group variantT] (///extension.lifted (meta.tag tag)) - _ (//type.with_env - (check.check inputT variantT)) + _ (/type.check (check.check inputT variantT)) .let [[lefts right?] (/complex.choice (list.size group) idx)]] (analyse_pattern {.#Some (list.size group)} inputT (` {(~ (code.nat lefts)) (~ (code.bit right?)) (~+ values)}) next))) @@ -336,8 +330,8 @@ (.case branches {.#Item [patternH bodyH] branchesT} (do [! ///.monad] - [[inputT inputA] (//type.with_inference - (analyse archive inputC)) + [[inputT inputA] (/type.inferring + (analyse archive inputC)) outputH (analyse_pattern {.#None} inputT patternH (analyse archive bodyH)) outputT (monad.each ! (function (_ [patternT bodyT]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux index 1b4b38a7c..8f7a67a0c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -1,6 +1,7 @@ (.using [library [lux {"-" function} + ["[0]" meta] [abstract monad] [control @@ -12,16 +13,15 @@ [collection ["[0]" list ("[1]#[0]" monoid monad)]]] ["[0]" type - ["[0]" check]] - ["[0]" meta]]] + ["[0]" check]]]] ["[0]" // "_" ["[1][0]" scope] - ["[1][0]" type] ["[1][0]" inference] ["/[1]" // "_" ["[1][0]" extension] [// - ["/" analysis {"+" Analysis Operation Phase}] + ["/" analysis {"+" Analysis Operation Phase} + ["[1][0]" type]] [/// ["[1]" phase] [reference {"+"} @@ -68,15 +68,14 @@ (^template [ ] [{ _} (do ! - [[_ instanceT] (//type.with_env )] + [[_ instanceT] (/type.check )] (again (maybe.trusted (type.applied (list instanceT) expectedT))))]) ([.#UnivQ check.existential] [.#ExQ check.var]) {.#Var id} (do ! - [?expectedT' (//type.with_env - (check.peek id))] + [?expectedT' (/type.check (check.peek id))] (case ?expectedT' {.#Some expectedT'} (again expectedT') @@ -84,12 +83,11 @@ ... Inference _ (do ! - [[input_id inputT] (//type.with_env check.var) - [output_id outputT] (//type.with_env check.var) + [[input_id inputT] (/type.check check.var) + [output_id outputT] (/type.check check.var) .let [functionT {.#Function inputT outputT}] functionA (again functionT) - _ (//type.with_env - (check.check expectedT functionT))] + _ (/type.check (check.check expectedT functionT))] (in functionA)))) {.#Function inputT outputT} @@ -102,7 +100,7 @@ ... also to themselves, through a local variable. (//scope.with_local [function_name expectedT]) (//scope.with_local [arg_name inputT]) - (//type.with_type outputT) + (/type.expecting outputT) (analyse archive body)) _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 6c0b9a429..ea03f2719 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -1,33 +1,32 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] - [math - [number - ["n" nat]]] - ["[0]" type - ["[0]" check]] - ["[0]" meta]]] - ["[0]" // "_" - ["[1][0]" type] - ["/[1]" // "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Analysis Operation Phase} - [complex {"+" Tag}]] - [/// - ["[1]" phase ("[1]#[0]" monad)] - [meta - [archive {"+" Archive}]]]]]]) + [library + [lux "*" + ["[0]" meta] + [abstract + [monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor monoid)]]] + [math + [number + ["n" nat]]] + ["[0]" type + ["[0]" check]]]] + ["[0]" /// "_" + ["[1][0]" extension] + [// + ["/" analysis {"+" Analysis Operation Phase} + [complex {"+" Tag}] + ["[1][0]" type]] + [/// + ["[1]" phase ("[1]#[0]" monad)] + [meta + [archive {"+" Archive}]]]]]) (exception: .public (variant_tag_out_of_bounds [size Nat tag Tag @@ -104,7 +103,7 @@ (Operation Type) (do ///.monad [location (///extension.lifted meta.location) - [ex_id _] (//type.with_env check.existential)] + [ex_id _] (/type.check check.existential)] (in (named_type location ex_id)))) ... Type-inference works by applying some (potentially quantified) type @@ -119,7 +118,7 @@ (case args {.#End} (do ///.monad - [_ (//type.infer inferT)] + [_ (/type.inference inferT)] (in [inferT (list)])) {.#Item argC args'} @@ -129,23 +128,21 @@ {.#UnivQ _} (do ///.monad - [[var_id varT] (//type.with_env check.var)] + [[var_id varT] (/type.check check.var)] (general archive analyse (maybe.trusted (type.applied (list varT) inferT)) args)) {.#ExQ _} (do [! ///.monad] - [[var_id varT] (//type.with_env check.var) + [[var_id varT] (/type.check check.var) output (general archive analyse (maybe.trusted (type.applied (list varT) inferT)) args) - bound? (//type.with_env - (check.bound? var_id)) + bound? (/type.check (check.bound? var_id)) _ (if bound? (in []) (do ! [newT new_named_type] - (//type.with_env - (check.check varT newT))))] + (/type.check (check.check varT newT))))] (in output)) {.#Apply inputT transT} @@ -167,14 +164,13 @@ (do ///.monad [[outputT' args'A] (general archive analyse outputT args') argA (<| (/.with_stack ..cannot_infer_argument [inputT argC]) - (//type.with_type inputT) + (/type.expecting inputT) (analyse archive argC))] (in [outputT' (list& argA args'A)])) {.#Var infer_id} (do ///.monad - [?inferT' (//type.with_env - (check.peek infer_id))] + [?inferT' (/type.check (check.peek infer_id))] (case ?inferT' {.#Some inferT'} (general archive analyse inferT' args) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 87337d8b6..223f0c07f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - [abstract - monad] - [control - ["[0]" exception {"+" exception:}]] - ["[0]" meta] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]]]]] - ["[0]" // "_" - ["[1][0]" scope] - ["[1][0]" type] - ["/[1]" // "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Analysis Operation}] - [/// - ["[1][0]" reference] - ["[1]" phase]]]]]) + [library + [lux "*" + [abstract + monad] + [control + ["[0]" exception {"+" exception:}]] + ["[0]" meta] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]]]]] + ["[0]" // "_" + ["[1][0]" scope] + ["/[1]" // "_" + ["[1][0]" extension] + [// + ["/" analysis {"+" Analysis Operation} + ["[1][0]" type]] + [/// + ["[1][0]" reference] + ["[1]" phase]]]]]) (exception: .public (foreign_module_has_not_been_imported [current Text foreign Text @@ -47,7 +47,7 @@ {.#Definition [exported? actualT _]} (do ! - [_ (//type.infer actualT) + [_ (/type.inference actualT) (^@ def_name [::module ::name]) (///extension.lifted (meta.normal def_name)) current (///extension.lifted meta.current_module_name)] (if (text#= current ::module) @@ -62,7 +62,7 @@ {.#Type [exported? value labels]} (do ! - [_ (//type.infer .Type) + [_ (/type.inference .Type) (^@ def_name [::module ::name]) (///extension.lifted (meta.normal def_name)) current (///extension.lifted meta.current_module_name)] (if (text#= current ::module) @@ -88,7 +88,7 @@ (case ?var {.#Some [actualT ref]} (do ! - [_ (//type.infer actualT)] + [_ (/type.inference actualT)] (in {.#Some (|> ref ///reference.variable {/.#Reference})})) {.#None} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux index 7d65b62cf..54b9b7a36 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -3,20 +3,19 @@ [lux {"-" nat int rev} [abstract [monad {"+" do}]]]] - ["[0]" // "_" - ["[1][0]" type] - ["/[1]" // "_" - [// - ["/" analysis {"+" Analysis Operation} - ["[1][0]" simple]] - [/// - ["[1]" phase]]]]]) + ["[0]" /// "_" + [// + ["/" analysis {"+" Analysis Operation} + ["[1][0]" simple] + ["[1][0]" type]] + [/// + ["[1]" phase]]]]) (template [ ] [(def: .public ( value) (-> (Operation Analysis)) (do ///.monad - [_ (//type.infer )] + [_ (/type.inference )] (in {/.#Simple { value}})))] [bit .Bit /simple.#Bit] @@ -30,5 +29,5 @@ (def: .public unit (Operation Analysis) (do ///.monad - [_ (//type.infer .Any)] + [_ (/type.inference .Any)] (in {/.#Simple {/simple.#Unit}}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 12f00a8aa..66cf6c80d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -1,43 +1,43 @@ (.using - [library - [lux "*" - ["[0]" meta] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["[0]" state]] - [data - ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" monad)] - ["[0]" dictionary {"+" Dictionary}]]] - [macro - ["[0]" code]] - [math - [number - ["n" nat]]] - [meta - ["[0]" symbol]] - ["[0]" type - ["[0]" check]]]] - ["[0]" // "_" - ["[1][0]" type] - ["[1][0]" simple] - ["[1][0]" inference] - ["/[1]" // "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Analysis Operation Phase} - ["[1][0]" complex {"+" Tag}]] - [/// - ["[1]" phase] - [meta - [archive {"+" Archive}]]]]]]) + [library + [lux "*" + ["[0]" meta] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception {"+" exception:}] + ["[0]" state]] + [data + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" monad)] + ["[0]" dictionary {"+" Dictionary}]]] + [macro + ["[0]" code]] + [math + [number + ["n" nat]]] + [meta + ["[0]" symbol]] + ["[0]" type + ["[0]" check]]]] + ["[0]" // "_" + ["[1][0]" simple] + ["[1][0]" inference] + ["/[1]" // "_" + ["[1][0]" extension] + [// + ["/" analysis {"+" Analysis Operation Phase} + ["[1][0]" complex {"+" Tag}] + ["[1][0]" type]] + [/// + ["[1]" phase] + [meta + [archive {"+" Archive}]]]]]]) (exception: .public (invalid_variant_type [type Type tag Tag @@ -113,8 +113,7 @@ (function (again valueC) (do [! ///.monad] [expectedT (///extension.lifted meta.expected_type) - expectedT' (//type.with_env - (check.clean expectedT))] + expectedT' (/type.check (check.clean expectedT))] (/.with_stack ..cannot_analyse_variant [expectedT' tag valueC] (case expectedT {.#Sum _} @@ -122,25 +121,24 @@ (case (list.item tag flat) {.#Some variant_type} (do ! - [valueA (//type.with_type variant_type - (analyse archive valueC))] + [valueA (<| (/type.expecting variant_type) + (analyse archive valueC))] (in (/.variant [lefts right? valueA]))) {.#None} (/.except //inference.variant_tag_out_of_bounds [(list.size flat) tag expectedT]))) {.#Named name unnamedT} - (//type.with_type unnamedT - (again valueC)) + (<| (/type.expecting unnamedT) + (again valueC)) {.#Var id} (do ! - [?expectedT' (//type.with_env - (check.peek id))] + [?expectedT' (/type.check (check.peek id))] (case ?expectedT' {.#Some expectedT'} - (//type.with_type expectedT' - (again valueC)) + (<| (/type.expecting expectedT') + (again valueC)) ... Cannot do inference when the tag is numeric. ... This is because there is no way of knowing how many @@ -151,9 +149,9 @@ (^template [ ] [{ _} (do ! - [[instance_id instanceT] (//type.with_env )] - (//type.with_type (maybe.trusted (type.applied (list instanceT) expectedT)) - (again valueC)))]) + [[instance_id instanceT] (/type.check )] + (<| (/type.expecting (maybe.trusted (type.applied (list instanceT) expectedT))) + (again valueC)))]) ([.#UnivQ check.existential] [.#ExQ check.var]) @@ -161,12 +159,11 @@ (case funT {.#Var funT_id} (do ! - [?funT' (//type.with_env - (check.peek funT_id))] + [?funT' (/type.check (check.peek funT_id))] (case ?funT' {.#Some funT'} - (//type.with_type {.#Apply inputT funT'} - (again valueC)) + (<| (/type.expecting {.#Apply inputT funT'}) + (again valueC)) _ (/.except ..invalid_variant_type [expectedT tag valueC]))) @@ -174,8 +171,8 @@ _ (case (type.applied (list inputT) funT) {.#Some outputT} - (//type.with_type outputT - (again valueC)) + (<| (/type.expecting outputT) + (again valueC)) {.#None} (/.except ..not_a_quantified_type funT))) @@ -193,22 +190,22 @@ (case [membersT+ membersC+] [{.#Item memberT {.#End}} {.#Item memberC {.#End}}] (do ! - [memberA (//type.with_type memberT - (analyse archive memberC))] + [memberA (<| (/type.expecting memberT) + (analyse archive memberC))] (in (list memberA))) [{.#Item memberT {.#End}} _] - (//type.with_type memberT - (# ! each (|>> list) (analyse archive (code.tuple membersC+)))) + (<| (/type.expecting memberT) + (# ! each (|>> list) (analyse archive (code.tuple membersC+)))) [_ {.#Item memberC {.#End}}] - (//type.with_type (type.tuple membersT+) - (# ! each (|>> list) (analyse archive memberC))) + (<| (/type.expecting (type.tuple membersT+)) + (# ! each (|>> list) (analyse archive memberC))) [{.#Item memberT membersT+'} {.#Item memberC membersC+'}] (do ! - [memberA (//type.with_type memberT - (analyse archive memberC)) + [memberA (<| (/type.expecting memberT) + (analyse archive memberC)) memberA+ (again membersT+' membersC+')] (in {.#Item memberA memberA+})) @@ -226,34 +223,32 @@ (..typed_product archive analyse membersC) {.#Named name unnamedT} - (//type.with_type unnamedT - (product archive analyse membersC)) + (<| (/type.expecting unnamedT) + (product archive analyse membersC)) {.#Var id} (do ! - [?expectedT' (//type.with_env - (check.peek id))] + [?expectedT' (/type.check (check.peek id))] (case ?expectedT' {.#Some expectedT'} - (//type.with_type expectedT' - (product archive analyse membersC)) + (<| (/type.expecting expectedT') + (product archive analyse membersC)) _ ... Must do inference... (do ! - [membersTA (monad.each ! (|>> (analyse archive) //type.with_inference) + [membersTA (monad.each ! (|>> (analyse archive) /type.inferring) membersC) - _ (//type.with_env - (check.check expectedT - (type.tuple (list#each product.left membersTA))))] + _ (/type.check (check.check expectedT + (type.tuple (list#each product.left membersTA))))] (in (/.tuple (list#each product.right membersTA)))))) (^template [ ] [{ _} (do ! - [[instance_id instanceT] (//type.with_env )] - (//type.with_type (maybe.trusted (type.applied (list instanceT) expectedT)) - (product archive analyse membersC)))]) + [[instance_id instanceT] (/type.check )] + (<| (/type.expecting (maybe.trusted (type.applied (list instanceT) expectedT))) + (product archive analyse membersC)))]) ([.#UnivQ check.existential] [.#ExQ check.var]) @@ -261,12 +256,11 @@ (case funT {.#Var funT_id} (do ! - [?funT' (//type.with_env - (check.peek funT_id))] + [?funT' (/type.check (check.peek funT_id))] (case ?funT' {.#Some funT'} - (//type.with_type {.#Apply inputT funT'} - (product archive analyse membersC)) + (<| (/type.expecting {.#Apply inputT funT'}) + (product archive analyse membersC)) _ (/.except ..invalid_tuple_type [expectedT membersC]))) @@ -274,8 +268,8 @@ _ (case (type.applied (list inputT) funT) {.#Some outputT} - (//type.with_type outputT - (product archive analyse membersC)) + (<| (/type.expecting outputT) + (product archive analyse membersC)) {.#None} (/.except ..not_a_quantified_type funT))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux deleted file mode 100644 index 4854e1407..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux +++ /dev/null @@ -1,56 +0,0 @@ -(.using - [library - [lux "*" - [abstract - [monad {"+" do}]] - [control - ["[0]" function] - ["[0]" try]] - [type - ["[0]" check {"+" Check}]] - ["[0]" meta]]] - ["[0]" /// "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Operation}] - [/// - ["[1]" phase]]]]) - -(def: .public (with_type expected) - (All (_ a) (-> Type (Operation a) (Operation a))) - (///extension.localized (value@ .#expected) (with@ .#expected) - (function.constant {.#Some expected}))) - -(def: .public (with_env action) - (All (_ a) (-> (Check a) (Operation a))) - (function (_ (^@ stateE [bundle state])) - (case (action (value@ .#type_context state)) - {try.#Success [context' output]} - {try.#Success [[bundle (with@ .#type_context context' state)] - output]} - - {try.#Failure error} - ((/.failure error) stateE)))) - -(def: .public with_fresh_env - (All (_ a) (-> (Operation a) (Operation a))) - (///extension.localized (value@ .#type_context) (with@ .#type_context) - (function.constant check.fresh_context))) - -(def: .public (infer actualT) - (-> Type (Operation Any)) - (do ///.monad - [expectedT (///extension.lifted meta.expected_type)] - (with_env - (check.check expectedT actualT)))) - -(def: .public (with_inference action) - (All (_ a) (-> (Operation a) (Operation [Type a]))) - (do ///.monad - [[_ varT] (..with_env - check.var) - output (with_type varT - action) - knownT (..with_env - (check.clean varT))] - (in [knownT output]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index 6fbc49090..670b54765 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -1,32 +1,32 @@ (.using - [library - [lux "*" - ["[0]" meta] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception {"+" exception:}]] - [data - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" mix monoid)]]]]] - ["[0]" // "_" - ["[1][0]" extension] + [library + [lux "*" + ["[0]" meta] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception {"+" exception:}]] + [data + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" mix monoid)]]]]] + ["[0]" // "_" + ["[1][0]" extension] + ["[1][0]" analysis] + ["/[1]" // "_" + ["/" directive {"+" Operation Phase}] ["[1][0]" analysis + ["[0]" evaluation] + ["[1]/[0]" macro {"+" Expander}] ["[1]/[0]" type]] - ["/[1]" // "_" - ["/" directive {"+" Operation Phase}] - ["[1][0]" analysis - ["[0]" evaluation] - ["[1]/[0]" macro {"+" Expander}]] - [/// - ["//" phase] - [reference {"+" } - [variable {"+" }]] - [meta - [archive {"+" Archive}]]]]]) + [/// + ["//" phase] + [reference {"+" } + [variable {"+" }]] + [meta + [archive {"+" Archive}]]]]]) (exception: .public (not_a_directive [code Code]) (exception.report @@ -97,8 +97,8 @@ (do ! [expansion (/.lifted_analysis (do ! - [macroA (//analysis/type.with_type Macro - (analysis archive macro))] + [macroA (<| (///analysis/type.expecting Macro) + (analysis archive macro))] (case macroA (^ (///analysis.constant macro_name)) (do ! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index ba635d72f..be1e560ca 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -48,13 +48,13 @@ ["[1][0]" bundle] ["/[1]" // "_" [analysis - ["[0]A" type] ["[0]A" inference] ["[0]" scope]] ["/[1]" // "_" ["[1][0]" analysis {"+" Analysis Operation Phase Handler Bundle} ["[1]/[0]" complex] - ["[1]/[0]" pattern]] + ["[1]/[0]" pattern] + ["[0]A" type]] ["[1][0]" synthesis] [/// ["[0]" phase ("[1]#[0]" monad)] @@ -427,11 +427,11 @@ (case args (^ (list arrayC)) (do phase.monad - [_ (typeA.infer ..int) - arrayA (typeA.with_type {.#Primitive (|> (jvm.array primitive_type) - ..reflection) - (list)} - (analyse archive arrayC))] + [_ (typeA.inference ..int) + arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array primitive_type) + ..reflection) + (list)}) + (analyse archive arrayC))] (in {/////analysis.#Extension extension_name (list arrayA)})) _ @@ -443,11 +443,11 @@ (case args (^ (list arrayC)) (do phase.monad - [_ (typeA.infer ..int) - [var_id varT] (typeA.with_env check.var) - arrayA (typeA.with_type (.type (array.Array varT)) - (analyse archive arrayC)) - varT (typeA.with_env (check.clean varT)) + [_ (typeA.inference ..int) + [var_id varT] (typeA.check check.var) + arrayA (<| (typeA.expecting (.type (array.Array varT))) + (analyse archive arrayC)) + varT (typeA.check (check.clean varT)) arrayJT (jvm_array_type (.type (array.Array varT)))] (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) arrayA)})) @@ -461,10 +461,10 @@ (case args (^ (list lengthC)) (do phase.monad - [lengthA (typeA.with_type ..int - (analyse archive lengthC)) - _ (typeA.infer {.#Primitive (|> (jvm.array primitive_type) ..reflection) - (list)})] + [lengthA (<| (typeA.expecting ..int) + (analyse archive lengthC)) + _ (typeA.inference {.#Primitive (|> (jvm.array primitive_type) ..reflection) + (list)})] (in {/////analysis.#Extension extension_name (list lengthA)})) _ @@ -476,8 +476,8 @@ (case args (^ (list lengthC)) (do phase.monad - [lengthA (typeA.with_type ..int - (analyse archive lengthC)) + [lengthA (<| (typeA.expecting ..int) + (analyse archive lengthC)) expectedT (///.lifted meta.expected_type) expectedJT (jvm_array_type expectedT) elementJT (case (jvm_parser.array? expectedJT) @@ -632,12 +632,12 @@ (case args (^ (list idxC arrayC)) (do phase.monad - [_ (typeA.infer lux_type) - idxA (typeA.with_type ..int - (analyse archive idxC)) - arrayA (typeA.with_type {.#Primitive (|> (jvm.array jvm_type) ..reflection) - (list)} - (analyse archive arrayC))] + [_ (typeA.inference lux_type) + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array jvm_type) ..reflection) + (list)}) + (analyse archive arrayC))] (in {/////analysis.#Extension extension_name (list idxA arrayA)})) _ @@ -649,15 +649,14 @@ (case args (^ (list idxC arrayC)) (do phase.monad - [[var_id varT] (typeA.with_env check.var) - _ (typeA.infer varT) - arrayA (typeA.with_type (.type (array.Array varT)) - (analyse archive arrayC)) - varT (typeA.with_env - (check.clean varT)) + [[var_id varT] (typeA.check check.var) + _ (typeA.inference varT) + arrayA (<| (typeA.expecting (.type (array.Array varT))) + (analyse archive arrayC)) + varT (typeA.check (check.clean varT)) arrayJT (jvm_array_type (.type (array.Array varT))) - idxA (typeA.with_type ..int - (analyse archive idxC))] + idxA (<| (typeA.expecting ..int) + (analyse archive idxC))] (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) idxA arrayA)})) @@ -673,13 +672,13 @@ (case args (^ (list idxC valueC arrayC)) (do phase.monad - [_ (typeA.infer array_type) - idxA (typeA.with_type ..int - (analyse archive idxC)) - valueA (typeA.with_type lux_type - (analyse archive valueC)) - arrayA (typeA.with_type array_type - (analyse archive arrayC))] + [_ (typeA.inference array_type) + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + valueA (<| (typeA.expecting lux_type) + (analyse archive valueC)) + arrayA (<| (typeA.expecting array_type) + (analyse archive arrayC))] (in {/////analysis.#Extension extension_name (list idxA valueA arrayA)})) @@ -693,17 +692,16 @@ (case args (^ (list idxC valueC arrayC)) (do phase.monad - [[var_id varT] (typeA.with_env check.var) - _ (typeA.infer (.type (array.Array varT))) - arrayA (typeA.with_type (.type (array.Array varT)) - (analyse archive arrayC)) - varT (typeA.with_env - (check.clean varT)) + [[var_id varT] (typeA.check check.var) + _ (typeA.inference (.type (array.Array varT))) + arrayA (<| (typeA.expecting (.type (array.Array varT))) + (analyse archive arrayC)) + varT (typeA.check (check.clean varT)) arrayJT (jvm_array_type (.type (array.Array varT))) - idxA (typeA.with_type ..int - (analyse archive idxC)) - valueA (typeA.with_type varT - (analyse archive valueC))] + idxA (<| (typeA.expecting ..int) + (analyse archive idxC)) + valueA (<| (typeA.expecting varT) + (analyse archive valueC))] (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) idxA valueA @@ -781,9 +779,9 @@ (case args (^ (list objectC)) (do phase.monad - [_ (typeA.infer Bit) - [objectT objectA] (typeA.with_inference - (analyse archive objectC)) + [_ (typeA.inference Bit) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) _ (check_object objectT)] (in {/////analysis.#Extension extension_name (list objectA)})) @@ -796,8 +794,8 @@ (case args (^ (list monitorC exprC)) (do phase.monad - [[monitorT monitorA] (typeA.with_inference - (analyse archive monitorC)) + [[monitorT monitorA] (typeA.inferring + (analyse archive monitorC)) _ (check_object monitorT) exprA (analyse archive exprC)] (in {/////analysis.#Extension extension_name (list monitorA exprA)})) @@ -811,9 +809,9 @@ (case args (^ (list exceptionC)) (do phase.monad - [_ (typeA.infer Nothing) - [exceptionT exceptionA] (typeA.with_inference - (analyse archive exceptionC)) + [_ (typeA.inference Nothing) + [exceptionT exceptionA] (typeA.inferring + (analyse archive exceptionC)) exception_class (check_object exceptionT) ? (phase.lifted (reflection!.sub? class_loader "java.lang.Throwable" exception_class)) _ (: (Operation Any) @@ -834,7 +832,7 @@ [_ {.#Text class}] (do phase.monad [_ (..ensure_fresh_class! class_loader class) - _ (typeA.infer {.#Primitive "java.lang.Class" (list {.#Primitive class (list)})}) + _ (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))})) @@ -851,9 +849,9 @@ (function (_ extension_name analyse archive [sub_class objectC]) (do phase.monad [_ (..ensure_fresh_class! class_loader sub_class) - _ (typeA.infer Bit) - [objectT objectA] (typeA.with_inference - (analyse archive objectC)) + _ (typeA.inference Bit) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) object_class (check_object objectT) ? (phase.lifted (reflection!.sub? class_loader object_class sub_class))] (if ? @@ -865,8 +863,7 @@ (-> Mapping (Type ) (Operation .Type)) (case (|> typeJ ..signature (.result ( mapping))) {try.#Success check} - (typeA.with_env - check) + (typeA.check check) {try.#Failure error} (phase.failure error)))] @@ -924,8 +921,8 @@ (do [! phase.monad] [toT (///.lifted meta.expected_type) target_name (# ! each ..reflection (check_jvm toT)) - [fromT fromA] (typeA.with_inference - (analyse archive fromC)) + [fromT fromA] (typeA.inferring + (analyse archive fromC)) source_name (# ! each ..reflection (check_jvm fromT)) can_cast? (: (Operation Bit) (`` (cond (~~ (template [ ] @@ -1011,7 +1008,7 @@ _ (phase.assertion ..deprecated_field [class field] (not deprecated?)) fieldT (reflection_type luxT.fresh fieldJT) - _ (typeA.infer fieldT)] + _ (typeA.inference fieldT)] (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) @@ -1024,7 +1021,7 @@ (function (_ extension_name analyse archive [[class field] valueC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) - _ (typeA.infer Any) + _ (typeA.inference Any) [final? deprecated? fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class)] @@ -1034,8 +1031,8 @@ _ (phase.assertion ..cannot_set_a_final_field [class field] (not final?)) fieldT (reflection_type luxT.fresh fieldJT) - valueA (typeA.with_type fieldT - (analyse archive valueC))] + valueA (<| (typeA.expecting fieldT) + (analyse archive valueC))] (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) @@ -1048,8 +1045,8 @@ (function (_ extension_name analyse archive [[class field] objectC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) - [objectT objectA] (typeA.with_inference - (analyse archive objectC)) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) [deprecated? mapping fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class) @@ -1059,7 +1056,7 @@ _ (phase.assertion ..deprecated_field [class field] (not deprecated?)) fieldT (reflection_type mapping fieldJT) - _ (typeA.infer fieldT)] + _ (typeA.inference fieldT)] (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) @@ -1073,9 +1070,9 @@ (function (_ extension_name analyse archive [[class field] valueC objectC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) - [objectT objectA] (typeA.with_inference - (analyse archive objectC)) - _ (typeA.infer objectT) + [objectT objectA] (typeA.inferring + (analyse archive objectC)) + _ (typeA.inference objectT) [final? deprecated? mapping fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class) @@ -1087,8 +1084,8 @@ _ (phase.assertion ..cannot_set_a_final_field [class field] (not final?)) fieldT (reflection_type mapping fieldJT) - valueA (typeA.with_type fieldT - (analyse archive valueC))] + valueA (<| (typeA.expecting fieldT) + (analyse archive valueC))] (in (<| {/////analysis.#Extension extension_name} (list (/////analysis.text class) (/////analysis.text field) @@ -1728,8 +1725,8 @@ super_arguments (monad.each ! (function (_ [jvmT super_argC]) (do ! [luxT (reflection_type mapping jvmT) - super_argA (typeA.with_type luxT - (analyse archive super_argC))] + super_argA (<| (typeA.expecting luxT) + (analyse archive super_argC))] (in [jvmT super_argA]))) super_arguments) arguments' (monad.each ! @@ -1742,7 +1739,7 @@ {.#Item [self_name selfT]} list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.with_type .Any) + (typeA.expecting .Any) /////analysis.with_scope)] (in (/////analysis.tuple (list (/////analysis.text ..constructor_tag) (visibility_analysis visibility) @@ -1839,7 +1836,7 @@ {.#Item [self_name selfT]} list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.with_type returnT) + (typeA.expecting returnT) /////analysis.with_scope)] (in (/////analysis.tuple (list (/////analysis.text ..virtual_tag) (/////analysis.text method_name) @@ -1912,7 +1909,7 @@ [scope bodyA] (|> arguments' list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.with_type returnT) + (typeA.expecting returnT) /////analysis.with_scope)] (in (/////analysis.tuple (list (/////analysis.text ..static_tag) (/////analysis.text method_name) @@ -2006,8 +2003,7 @@ (do [! phase.monad] [pairings (monad.each ! (function (_ var) (do ! - [[_ exT] (typeA.with_env - check.existential)] + [[_ exT] (typeA.check check.existential)] (in [var exT]))) vars)] (in (list#mix (function (_ [varJ varT] mapping) @@ -2083,7 +2079,7 @@ {.#Item [self_name selfT]} list.reversed (list#mix scope.with_local (analyse archive body)) - (typeA.with_type returnT) + (typeA.expecting returnT) /////analysis.with_scope)] (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag) (class_analysis parent_type) @@ -2209,32 +2205,29 @@ (do [! phase.monad] [_ (..ensure_fresh_class! class_loader (..reflection super_class)) _ (monad.each ! (|>> ..reflection (..ensure_fresh_class! class_loader)) super_interfaces) - parameters (typeA.with_env - (..parameter_types parameters)) + parameters (typeA.check (..parameter_types parameters)) .let [mapping (list#mix (function (_ [parameterJ parameterT] mapping) (dictionary.has (jvm_parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] - super_classT (typeA.with_env - (luxT.check (luxT.class mapping) (..signature super_class))) - super_interfaceT+ (typeA.with_env - (monad.each check.monad - (|>> ..signature (luxT.check (luxT.class mapping))) - super_interfaces)) + super_classT (typeA.check (luxT.check (luxT.class mapping) (..signature super_class))) + super_interfaceT+ (typeA.check (monad.each check.monad + (|>> ..signature (luxT.check (luxT.class mapping))) + super_interfaces)) selfT (///.lifted (do meta.monad [where meta.current_module_name id meta.seed] (in (inheritance_relationship_type {.#Primitive (..anonymous_class_name where id) (list)} super_classT super_interfaceT+)))) - _ (typeA.infer selfT) + _ (typeA.inference selfT) constructor_argsA+ (monad.each ! (function (_ [type term]) (do ! [argT (reflection_type mapping type) - termA (typeA.with_type argT - (analyse archive term))] + termA (<| (typeA.expecting argT) + (analyse archive term))] (in [type termA]))) constructor_args) .let [supers {.#Item super_class super_interfaces}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 9916735de..4632aa193 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -1,38 +1,37 @@ (.using - [library - [lux "*" - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" dictionary {"+" Dictionary}]]] - [math - [number - ["n" nat]]] - [type - ["[0]" check]] - ["[0]" meta]]] - ["[0]" /// - ["[1][0]" bundle] - ["/[1]" // "_" - [analysis + [library + [lux "*" + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" dictionary {"+" Dictionary}]]] + [math + [number + ["n" nat]]] + [type + ["[0]" check]] + ["[0]" meta]]] + ["[0]" /// + ["[1][0]" bundle] + ["/[1]" // "_" + [// + ["[1][0]" analysis {"+" Analysis Operation Phase Handler Bundle} + [evaluation {"+" Eval}] ["[0]A" type]] - [// - ["[1][0]" analysis {"+" Analysis Operation Phase Handler Bundle} - [evaluation {"+" Eval}]] - [/// - ["[1]" phase] - [meta - [archive {"+" Archive}]]]]]]) + [/// + ["[1]" phase] + [meta + [archive {"+" Archive}]]]]]]) (def: .public (custom [syntax handler]) (All (_ s) @@ -54,11 +53,11 @@ (let [num_actual (list.size args)] (if (n.= num_expected num_actual) (do [! ////.monad] - [_ (typeA.infer outputT) + [_ (typeA.inference outputT) argsA (monad.each ! (function (_ [argT argC]) - (typeA.with_type argT - (analyse archive argC))) + (<| (typeA.expecting argT) + (analyse archive argC))) (list.zipped/2 inputsT+ args))] (in {////analysis.#Extension extension_name argsA})) (////analysis.except ///.incorrect_arity [extension_name num_expected num_actual])))))) @@ -102,17 +101,17 @@ .any) (function (_ extension_name phase archive [input conditionals else]) (do [! ////.monad] - [input (typeA.with_type text.Char - (phase archive input)) + [input (<| (typeA.expecting text.Char) + (phase archive input)) expectedT (///.lifted meta.expected_type) conditionals (monad.each ! (function (_ [cases branch]) (do ! - [branch (typeA.with_type expectedT - (phase archive branch))] + [branch (<| (typeA.expecting expectedT) + (phase archive branch))] (in [cases branch]))) conditionals) - else (typeA.with_type expectedT - (phase archive else))] + else (<| (typeA.expecting expectedT) + (phase archive else))] (in (|> conditionals (list#each (function (_ [cases branch]) (////analysis.tuple @@ -126,7 +125,7 @@ Handler (function (_ extension_name analyse archive args) (do ////.monad - [[var_id varT] (typeA.with_env check.var)] + [[var_id varT] (typeA.check check.var)] ((binary varT varT Bit extension_name) analyse archive args)))) @@ -138,10 +137,10 @@ (case args (^ (list opC)) (do ////.monad - [[var_id varT] (typeA.with_env check.var) - _ (typeA.infer (type (Either Text varT))) - opA (typeA.with_type (type (-> .Any varT)) - (analyse archive opC))] + [[var_id varT] (typeA.check check.var) + _ (typeA.inference (type (Either Text varT))) + opA (<| (typeA.expecting (type (-> .Any varT))) + (analyse archive opC))] (in {////analysis.#Extension extension_name (list opA)})) _ @@ -166,9 +165,9 @@ (do [! ////.monad] [actualT (# ! each (|>> (:as Type)) (eval archive Type typeC)) - _ (typeA.infer actualT)] - (typeA.with_type actualT - (analyse archive valueC))) + _ (typeA.inference actualT)] + (<| (typeA.expecting actualT) + (analyse archive valueC))) _ (////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) @@ -181,9 +180,9 @@ (do [! ////.monad] [actualT (# ! each (|>> (:as Type)) (eval archive Type typeC)) - _ (typeA.infer actualT) - [valueT valueA] (typeA.with_inference - (analyse archive valueC))] + _ (typeA.inference actualT) + [valueT valueA] (typeA.inferring + (analyse archive valueC))] (in valueA)) _ @@ -195,9 +194,9 @@ [.any (function (_ extension_name phase archive valueC) (do [! ////.monad] - [_ (typeA.infer output)] - (typeA.with_type input - (phase archive valueC))))])) + [_ (typeA.inference output)] + (<| (typeA.expecting input) + (phase archive valueC))))])) (exception: .public (not_a_type [symbol Symbol]) (exception.report @@ -209,7 +208,7 @@ [.any (function (_ extension_name phase archive valueC) (do [! ////.monad] - [_ (typeA.infer .Macro) + [_ (typeA.inference .Macro) input_type (loop [input_name (symbol .Macro')] (do ! [input_type (///.lifted (meta.definition (symbol .Macro')))] @@ -224,8 +223,8 @@ {.#Alias real_name} (again real_name))))] - (typeA.with_type input_type - (phase archive valueC))))])) + (<| (typeA.expecting input_type) + (phase archive valueC))))])) (def: (bundle::lux eval) (-> Eval Bundle) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux index d71b06ed5..4f6a34452 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -1,32 +1,30 @@ (.using - [library - [lux "*" - ["[0]" ffi] - [abstract - ["[0]" monad {"+" do}]] - [control - ["<>" parser - ["" code {"+" Parser}]]] - [data - [collection - ["[0]" array {"+" Array}] - ["[0]" dictionary] - ["[0]" list]]] - ["[0]" type - ["[0]" check]] - ["@" target - ["_" ruby]]]] + [library + [lux "*" + ["[0]" ffi] + [abstract + ["[0]" monad {"+" do}]] + [control + ["<>" parser + ["" code {"+" Parser}]]] + [data + [collection + ["[0]" array {"+" Array}] + ["[0]" dictionary] + ["[0]" list]]] + ["[0]" type + ["[0]" check]] + ["@" target + ["_" ruby]]]] + [// + ["/" lux {"+" custom}] [// - ["/" lux {"+" custom}] - [// - ["[0]" bundle] - [// - ["[0]" analysis "_" - ["[1]/[0]" type]] - [// - ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}] - [/// - ["[0]" phase]]]]]]) + ["[0]" bundle] + [/// + ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle} + ["[1]/[0]" type]] + [/// + ["[0]" phase]]]]]) (def: array::new Handler @@ -34,10 +32,10 @@ [.any (function (_ extension phase archive lengthC) (do phase.monad - [lengthA (analysis/type.with_type Nat - (phase archive lengthC)) - [var_id varT] (analysis/type.with_env check.var) - _ (analysis/type.infer (type (Array varT)))] + [lengthA (<| (analysis/type.expecting Nat) + (phase archive lengthC)) + [var_id varT] (analysis/type.check check.var) + _ (analysis/type.inference (type (Array varT)))] (in {analysis.#Extension extension (list lengthA)})))])) (def: array::length @@ -46,10 +44,10 @@ [.any (function (_ extension phase archive arrayC) (do phase.monad - [[var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer Nat)] + [[var_id varT] (analysis/type.check check.var) + arrayA (<| (analysis/type.expecting (type (Array varT))) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] (in {analysis.#Extension extension (list arrayA)})))])) (def: array::read @@ -58,12 +56,12 @@ [(<>.and .any .any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer varT)] + [indexA (<| (analysis/type.expecting Nat) + (phase archive indexC)) + [var_id varT] (analysis/type.check check.var) + arrayA (<| (analysis/type.expecting (type (Array varT))) + (phase archive arrayC)) + _ (analysis/type.inference varT)] (in {analysis.#Extension extension (list indexA arrayA)})))])) (def: array::write @@ -72,14 +70,14 @@ [($_ <>.and .any .any .any) (function (_ extension phase archive [indexC valueC arrayC]) (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - valueA (analysis/type.with_type varT - (phase archive valueC)) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] + [indexA (<| (analysis/type.expecting Nat) + (phase archive indexC)) + [var_id varT] (analysis/type.check check.var) + valueA (<| (analysis/type.expecting varT) + (phase archive valueC)) + arrayA (<| (analysis/type.expecting (type (Array varT))) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array varT)))] (in {analysis.#Extension extension (list indexA valueA arrayA)})))])) (def: array::delete @@ -88,12 +86,12 @@ [($_ <>.and .any .any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] + [indexA (<| (analysis/type.expecting Nat) + (phase archive indexC)) + [var_id varT] (analysis/type.check check.var) + arrayA (<| (analysis/type.expecting (type (Array varT))) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array varT)))] (in {analysis.#Extension extension (list indexA arrayA)})))])) (def: bundle::array @@ -125,9 +123,9 @@ [($_ <>.and .text .any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad - [objectA (analysis/type.with_type ..Object - (phase archive objectC)) - _ (analysis/type.infer .Any)] + [objectA (<| (analysis/type.expecting ..Object) + (phase archive objectC)) + _ (analysis/type.inference .Any)] (in {analysis.#Extension extension (list (analysis.text fieldC) objectA)})))])) @@ -137,10 +135,10 @@ [($_ <>.and .text .any (<>.some .any)) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] - [objectA (analysis/type.with_type ..Object - (phase archive objectC)) - inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) - _ (analysis/type.infer .Any)] + [objectA (<| (analysis/type.expecting ..Object) + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] (in {analysis.#Extension extension (list& (analysis.text methodC) objectA inputsA)})))])) @@ -161,7 +159,7 @@ [.text (function (_ extension phase archive name) (do phase.monad - [_ (analysis/type.infer Any)] + [_ (analysis/type.inference Any)] (in {analysis.#Extension extension (list (analysis.text name))})))])) (def: ruby::apply @@ -170,10 +168,10 @@ [($_ <>.and .any (<>.some .any)) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] - [abstractionA (analysis/type.with_type ..Function - (phase archive abstractionC)) - inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) - _ (analysis/type.infer Any)] + [abstractionA (<| (analysis/type.expecting ..Function) + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference Any)] (in {analysis.#Extension extension (list& abstractionA inputsA)})))])) (def: ruby::import @@ -182,7 +180,7 @@ [.text (function (_ extension phase archive name) (do phase.monad - [_ (analysis/type.infer Bit)] + [_ (analysis/type.inference Bit)] (in {analysis.#Extension extension (list (analysis.text name))})))])) (def: .public bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index e85b1325b..92be3af3c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -33,12 +33,12 @@ ["[1][0]" analysis] ["/[1]" // "_" [analysis - ["[0]" module] - ["[0]A" type]] + ["[0]" module]] ["/[1]" // "_" ["[1][0]" analysis [macro {"+" Expander}] - ["[1]/[0]" evaluation]] + ["[1]/[0]" evaluation] + ["[0]A" type]] ["[1][0]" synthesis {"+" Synthesis}] ["[1][0]" generation {"+" Context}] ["[1][0]" directive {"+" Import Requirements Phase Operation Handler Bundle}] @@ -98,11 +98,11 @@ .let [analyse (value@ [/////directive.#analysis /////directive.#phase] state) synthesize (value@ [/////directive.#synthesis /////directive.#phase] state) generate (value@ [/////directive.#generation /////directive.#phase] state)] - [_ codeA] (/////directive.lifted_analysis - (/////analysis.with_scope - (typeA.with_fresh_env - (typeA.with_type type - (analyse archive codeC))))) + [_ codeA] (<| /////directive.lifted_analysis + /////analysis.with_scope + typeA.fresh + (typeA.expecting type) + (analyse archive codeC)) codeS (/////directive.lifted_synthesis (synthesize archive codeA))] (evaluate!' archive generate type codeS))) @@ -138,21 +138,20 @@ generate (value@ [/////directive.#generation /////directive.#phase] state)] [_ code//type codeA] (/////directive.lifted_analysis (/////analysis.with_scope - (typeA.with_fresh_env - (case expected - {.#None} - (do ! - [[code//type codeA] (typeA.with_inference - (analyse archive codeC)) - code//type (typeA.with_env - (check.clean code//type))] - (in [code//type codeA])) - - {.#Some expected} - (do ! - [codeA (typeA.with_type expected - (analyse archive codeC))] - (in [expected codeA])))))) + (typeA.fresh + (case expected + {.#None} + (do ! + [[code//type codeA] (typeA.inferring + (analyse archive codeC)) + code//type (typeA.check (check.clean code//type))] + (in [code//type codeA])) + + {.#Some expected} + (do ! + [codeA (<| (typeA.expecting expected) + (analyse archive codeC))] + (in [expected codeA])))))) codeS (/////directive.lifted_synthesis (synthesize archive codeA))] (definition' archive generate name code//type codeS))) @@ -190,11 +189,11 @@ .let [analyse (value@ [/////directive.#analysis /////directive.#phase] state) synthesize (value@ [/////directive.#synthesis /////directive.#phase] state) generate (value@ [/////directive.#generation /////directive.#phase] state)] - [_ codeA] (/////directive.lifted_analysis - (/////analysis.with_scope - (typeA.with_fresh_env - (typeA.with_type codeT - (analyse archive codeC))))) + [_ codeA] (<| /////directive.lifted_analysis + /////analysis.with_scope + typeA.fresh + (typeA.expecting codeT) + (analyse archive codeC)) codeS (/////directive.lifted_synthesis (synthesize archive codeA))] ( archive generate extension codeT codeS)))] @@ -480,11 +479,11 @@ Code (Operation anchor expression directive Synthesis))) (do phase.monad - [[_ programA] (/////directive.lifted_analysis - (/////analysis.with_scope - (typeA.with_fresh_env - (typeA.with_type (type (-> (List Text) (IO Any))) - (analyse archive programC)))))] + [[_ programA] (<| /////directive.lifted_analysis + /////analysis.with_scope + typeA.fresh + (typeA.expecting (type (-> (List Text) (IO Any)))) + (analyse archive programC))] (/////directive.lifted_synthesis (synthesize archive programA)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux index ab9718b40..e11fc7aa6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux @@ -35,7 +35,7 @@ (def: (array::new [size]) (Unary Expression) - (_.do "new" (list size) {.#None} (_.local "Array"))) + (_.do "new" (list size) {.#None} (: _.CVar (_.manual "Array")))) (def: array::length (Unary Expression) @@ -104,7 +104,7 @@ (custom [.text (function (_ extension phase archive name) - (# ////////phase.monad in (_.local name)))])) + (# ////////phase.monad in (: _.CVar (_.manual name))))])) (def: ruby::apply (custom diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index 6ebc13360..00b7557af 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -172,7 +172,7 @@ (implementation (def: (evaluate context valueG) (# try.monad each product.left - (..evaluate! library loader (class_name context) valueG))) + (..evaluate! library loader (format "E" (..class_name context)) valueG))) (def: execute (..execute! library loader)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 16dab0814..2e9deb0e4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -19,8 +19,8 @@ ["/[1]" // "_" ["[1][0]" reference] ["//[1]" /// "_" - [analysis {"+" Environment Abstraction Application Analysis}] [synthesis {"+" Synthesis}] + [analysis {"+" Environment Abstraction Reification Analysis}] ["[1][0]" generation {"+" Context}] ["//[1]" /// "_" [arity {"+" Arity}] @@ -28,11 +28,11 @@ [reference [variable {"+" Register Variable}]] [meta - [archive - ["[0]" dependency]]]]]]]) + ["[0]" cache "_" + ["[1]/[0]" artifact]]]]]]]) (def: .public (apply expression archive [functionS argsS+]) - (Generator (Application Synthesis)) + (Generator (Reification Synthesis)) (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] @@ -66,7 +66,7 @@ (def: .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) (do [! ///////phase.monad] - [dependencies (dependency.dependencies archive bodyS) + [dependencies (cache/artifact.dependencies archive bodyS) [[function_module function_artifact] body!] (/////generation.with_new_context archive dependencies (/////generation.with_anchor 1 (statement expression archive bodyS))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index bccbf9fff..8a3196fb2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -37,7 +37,8 @@ [variable {"+" Register}]] [meta [archive {"+" Output Archive} - ["[0]" artifact {"+" Registry}]]]]]]) + ["[0]" artifact] + ["[0]" registry {"+" Registry}]]]]]]) (template [ ] [(type: .public @@ -83,7 +84,7 @@ 0) (def: $Numeric - !.CVar + _.CVar (_.manual "Numeric")) (def: mruby? @@ -115,7 +116,7 @@ (let [runtime (code.local_symbol (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.constant (~ (code.text (%.code runtime))))) g!name (code.local_symbol name)] - (in (list (` (def: .public (~ g!name) LVar (~ runtime_name))) + (in (list (` (def: .public (~ g!name) _.CVar (~ runtime_name))) (` (def: (~ (code.local_symbol (format "@" name))) Statement (~ (list#mix (function (_ [when then] else) @@ -621,8 +622,8 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id {.#None} ..runtime)] - (in [(|> artifact.empty - (artifact.resource true artifact.no_dependencies) + (in [(|> registry.empty + (registry.resource true artifact.no_dependencies) product.right) (sequence.sequence [..module_id {.#None} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux index 27361d558..271cf4954 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux @@ -10,7 +10,7 @@ ["[1][0]" primitive] ["///[1]" //// "_" [analysis - [composite {"+" Variant Tuple}]] + [complex {"+" Variant Tuple}]] ["[1][0]" synthesis {"+" Synthesis}] ["//[1]" /// "_" ["[1][0]" phase ("[1]#[0]" monad)]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux index 3009ce521..243ee7653 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux @@ -31,6 +31,7 @@ ["[0]" // {"+" Packager} [// ["[0]" archive {"+" Output} + [registry {"+" Registry}] ["[0]" descriptor {"+" Module Descriptor}] ["[0]" artifact] ["[0]" document {"+" Document}]] @@ -78,9 +79,9 @@ (-> archive.ID file.Path) (|>> %.nat (text.suffix ".rb"))) -(def: (write_module mapping necessary_dependencies [module [module_id [descriptor document output]]] sink) +(def: (write_module mapping necessary_dependencies [module [module_id [descriptor document output registry]]] sink) (-> (Dictionary Module archive.ID) (Set Context) - [Module [archive.ID [Descriptor (Document .Module) Output]]] + [Module [archive.ID [Descriptor (Document .Module) Output Registry]]] (List [archive.ID [Text Binary]]) (Try (List [archive.ID [Text Binary]]))) (do [! try.monad] @@ -103,7 +104,7 @@ "main.rb") (def: module_id_mapping - (-> Order (Dictionary Module archive.ID)) + (-> (Order .Module) (Dictionary Module archive.ID)) (|>> (list#each (function (_ [module [module_id [descriptor document output]]]) [module module_id])) (dictionary.of_list text.hash))) @@ -127,7 +128,7 @@ (let [relative_path (_.do "gsub" (list (_.string main_file) (_.string (..module_file module_id))) {.#None} - (_.local "__FILE__"))] + (: _.CVar (_.manual "__FILE__")))] (_.statement (_.require/1 relative_path))))) (list#mix _.then (_.comment "Lux program" (_.statement (_.string "")))) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 5537bc855..a7b2afa6f 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -47,13 +47,12 @@ ["[0]" artifact]]] [language [lux - ["[0]" analysis] ["[0]" synthesis] ["[0]" generation] ["[0]" directive] + ["[0]" analysis + ["[0]" type]] [phase - [analysis - ["[0]" type]] [generation (~~ (.for ["JVM" (~~ (.as_is ["[0]" jvm "_" ["[1]/[0]" runtime]]))] @@ -141,9 +140,9 @@ (directive: (..directive self phase archive [expression .any]) (do [! phase.monad] [analysis_phase directive.analysis - expressionA (directive.lifted_analysis - (type.with_type .Any - (analysis_phase archive expression))) + expressionA (<| directive.lifted_analysis + (type.expecting .Any) + (analysis_phase archive expression)) synthesis_phase directive.synthesis expressionS (directive.lifted_synthesis diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux index cec292c79..c8425f21d 100644 --- a/stdlib/source/test/lux/static.lux +++ b/stdlib/source/test/lux/static.lux @@ -1,78 +1,78 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - ["@" target] - ["[0]" meta] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]]] - [macro - ["[0]" code]] - [math - ["[0]" random] - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + ["@" target] + ["[0]" meta] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]]] + [macro + ["[0]" code]] + [math + ["[0]" random] + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]]]] + [\\library + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) - (for [@.old (_.test "PLACEHOLDER" true)] - (_.for [meta.eval] - (`` ($_ _.and - (~~ (template [ <=> <+> ] - [(_.cover [ ] - (with_expansions [ () - () - ( (<+> ))] - (case (' ) - [_ { l+r}] - (<=> l+r (<+> )) + (for [@.old (_.test "PLACEHOLDER" true)]) + (_.for [meta.eval]) + (`` ($_ _.and + (~~ (template [ <=> <+> ] + [(_.cover [ ] + (with_expansions [ () + () + ( (<+> ))] + (case (' ) + [_ { l+r}] + (<=> l+r (<+> )) - _ - false)))] + _ + false)))] - [/.nat /.random_nat n.= n.+ .#Nat] - [/.int /.random_int i.= i.+ .#Int] - [/.rev /.random_rev r.= r.+ .#Rev] - )) - (_.cover [/.frac /.random_frac] - (with_expansions [ (/.random_frac) - (/.random_frac) - (/.frac (f.+ ))] - (case (' ) - [_ {.#Frac l+r}] - (or (f.= l+r (f.+ )) - (and (f.not_a_number? l+r) - (f.not_a_number? (f.+ )) - (or (f.not_a_number? ) - (f.not_a_number? )))) + [/.nat /.random_nat n.= n.+ .#Nat] + [/.int /.random_int i.= i.+ .#Int] + [/.rev /.random_rev r.= r.+ .#Rev] + )) + (_.cover [/.frac /.random_frac] + (with_expansions [ (/.random_frac) + (/.random_frac) + (/.frac (f.+ ))] + (case (' ) + [_ {.#Frac l+r}] + (or (f.= l+r (f.+ )) + (and (f.not_a_number? l+r) + (f.not_a_number? (f.+ )) + (or (f.not_a_number? ) + (f.not_a_number? )))) - _ - false))) - (_.cover [/.text /.random] - (with_expansions [ (/.random code.text (random.ascii/alpha_num 1)) - (/.random code.text (random.ascii/alpha_num 1)) - (/.text (format ))] - (case (' ) - [_ {.#Text l+r}] - (text#= l+r (format )) + _ + false))) + (_.cover [/.text /.random] + (with_expansions [ (/.random code.text (random.ascii/alpha_num 1)) + (/.random code.text (random.ascii/alpha_num 1)) + (/.text (format ))] + (case (' ) + [_ {.#Text l+r}] + (text#= l+r (format )) - _ - false))) - (_.cover [/.literal] - (with_expansions [ (/.random code.text (random.ascii/alpha_num 1)) - (/.random code.text (random.ascii/alpha_num 1)) - (/.literal code.text (format ))] - (case (' ) - [_ {.#Text l+r}] - (text#= l+r (format )) + _ + false))) + (_.cover [/.literal] + (with_expansions [ (/.random code.text (random.ascii/alpha_num 1)) + (/.random code.text (random.ascii/alpha_num 1)) + (/.literal code.text (format ))] + (case (' ) + [_ {.#Text l+r}] + (text#= l+r (format )) - _ - false))) - )))))) + _ + false))) + )))) diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 7ec415b16..5a52dc1b8 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -298,6 +298,43 @@ (/.apply_lambda/* (list))))) ))) +(def: test|io + Test + (<| (do [! random.monad] + [left (random.ascii/upper 5) + right (random.ascii/upper 5) + $old (# ! each /.local (random.ascii/upper 1)) + $new (# ! each /.local (random.ascii/upper 2)) + .let [expected (format left right)]]) + (_.for [/.stdout]) + ($_ _.and + (_.cover [/.print/1] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/1 (/.string left))) + (/.statement (/.print/1 (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.print/2] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/2 (/.string left) (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) + (def: test|computation Test (do [! random.monad] @@ -317,6 +354,7 @@ ..test|array ..test|hash ..test|object + ..test|io (_.cover [/.?] (let [expected (if test then else)] (expression (|>> (:as Frac) (f.= expected)) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux index c1bc9d62e..f19111e2d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -28,6 +28,7 @@ ["[1][0]" complex] ["[1][0]" pattern] ["[1][0]" macro] + ["[1][0]" type] [//// ["[1][0]" reference ["[2][0]" variable]] @@ -438,4 +439,5 @@ /complex.test /pattern.test /macro.test + /type.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux new file mode 100644 index 000000000..66876be3c --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux @@ -0,0 +1,119 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" meta] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list ("[1]#[0]" monad)]]] + [macro + ["[0]" code ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["n" nat]]] + ["[0]" type ("[1]#[0]" equivalence) + ["[0]" check]]]] + ["$" /////// "_" + [macro + ["[1][0]" code]] + [meta + ["[1][0]" symbol]]] + [\\library + ["[0]" / + ["/[1]" // + [// + [phase + ["[2][0]" extension]] + [/// + ["[2][0]" phase]]]]]]) + +(def: random_state + (Random Lux) + (do random.monad + [version random.nat + host (random.ascii/lower 1)] + (in (//.state (//.info version host))))) + +(def: primitive + (Random Type) + (do random.monad + [name (random.ascii/lower 1)] + (in {.#Primitive name (list)}))) + +(def: .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + expected ..primitive + dummy (random.only (|>> (type#= expected) not) + ..primitive)] + ($_ _.and + (_.cover [/.expecting /.inference] + (and (|> (/.inference expected) + (/.expecting expected) + (/phase.result state) + (case> {try.#Success _} true + {try.#Failure _} false)) + (|> (/.inference dummy) + (/.expecting expected) + (/phase.result state) + (case> {try.#Success _} false + {try.#Failure _} true)) + (|> (/.inference expected) + (/.expecting dummy) + (/phase.result state) + (case> {try.#Success _} false + {try.#Failure _} true)))) + (_.cover [/.inferring] + (|> (/.inference expected) + /.inferring + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false))) + (_.cover [/.check] + (|> (do /phase.monad + [exT (/.check (do check.monad + [[id type] check.existential] + (in type)))] + (|> (/.inference exT) + (/.expecting exT))) + (/phase.result state) + (case> {try.#Success _} true + {try.#Failure _} false))) + (_.cover [/.fresh] + (and (|> (do /phase.monad + [varT (/.check (do check.monad + [[id type] check.var] + (in type)))] + (|> (/.inference expected) + (/.expecting varT))) + (/phase.result state) + (case> {try.#Success _} true + {try.#Failure _} false)) + (|> (do /phase.monad + [varT (/.check (do check.monad + [[id type] check.var] + (in type)))] + (|> (/.inference expected) + (/.expecting varT) + /.fresh)) + (/phase.result state) + (case> {try.#Success _} false + {try.#Failure _} true)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux index 015c9d362..a93b4c3e1 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -12,19 +12,18 @@ ["[0]" random]]]] [\\library ["[0]" / - [// - ["[1][0]" type] + [/// + ["[1][0]" extension] [// - ["[1][0]" extension] - [// - ["[1][0]" analysis {"+" Analysis Operation}] - [/// - ["[1][0]" phase]]]]]]]) + ["[1][0]" analysis {"+" Analysis Operation} + ["[2][0]" type]] + [/// + ["[1][0]" phase]]]]]]) (def: (analysis state type it ?) (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit) - (and (|> (/type.with_type type - it) + (and (|> it + (/type.expecting type) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Success analysis}) @@ -32,8 +31,8 @@ _ false)) - (|> (/type.with_type .Nothing - it) + (|> it + (/type.expecting .Nothing) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Failure error}) @@ -41,8 +40,8 @@ _ false)) - (|> (/type.with_inference - it) + (|> it + /type.inferring (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Success [inferred analysis]}) -- cgit v1.2.3