From 0755768bb993cfb3924986eeb0486204a90bfeee Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 8 Feb 2022 04:08:38 -0400 Subject: Optimizations for the pure-Lux JVM compiler. [Part 1] --- stdlib/source/library/lux/control/maybe.lux | 62 ++- stdlib/source/library/lux/control/try.lux | 43 +- stdlib/source/library/lux/target/jvm/bytecode.lux | 611 +++++++++++---------- .../tool/compiler/language/lux/analysis/module.lux | 2 +- .../language/lux/phase/analysis/reference.lux | 18 +- stdlib/source/test/lux/target/python.lux | 42 +- stdlib/source/test/lux/tool.lux | 4 +- .../compiler/language/lux/analysis/inference.lux | 6 +- .../tool/compiler/language/lux/analysis/module.lux | 26 +- .../language/lux/phase/analysis/complex.lux | 32 +- .../language/lux/phase/analysis/reference.lux | 293 ++++++---- 11 files changed, 669 insertions(+), 470 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index a8d97f232..597953a64 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -1,15 +1,15 @@ (.using - [library - [lux {"-" list} - [abstract - [monoid {"+" Monoid}] - [equivalence {"+" Equivalence}] - [hash {"+" Hash}] - [apply {"+" Apply}] - ["[0]" functor {"+" Functor}] - ["[0]" monad {"+" Monad do}]] - [meta - ["[0]" location]]]]) + [library + [lux {"-" list} + [abstract + [monoid {"+" Monoid}] + [equivalence {"+" Equivalence}] + [hash {"+" Hash}] + [apply {"+" Apply}] + ["[0]" functor {"+" Functor}] + ["[0]" monad {"+" Monad do}]] + [meta + ["[0]" location]]]]) ... (type: (Maybe a) ... {.#None} @@ -34,8 +34,12 @@ (def: (each f ma) (case ma - {.#None} {.#None} - {.#Some a} {.#Some (f a)}))) + {.#Some a} + {.#Some (f a)} + + ... {.#None} + it + (:expected it)))) (implementation: .public apply (Apply Maybe) @@ -60,11 +64,12 @@ (def: (conjoint mma) (case mma - {.#None} - {.#None} - {.#Some mx} - mx))) + mx + + ... {.#None} + it + (:expected it)))) (implementation: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Maybe a)))) @@ -89,7 +94,7 @@ (def: (hash value) (case value {.#None} - 0 + 1 {.#Some value} (# super hash value)))) @@ -109,11 +114,12 @@ (do monad [mMma MmMma] (case mMma - {.#None} - (in {.#None}) - {.#Some Mma} - Mma)))) + Mma + + ... {.#None} + it + (in (:expected it)))))) (def: .public (lifted monad) (All (_ M a) (-> (Monad M) (-> (M a) (M (Maybe a))))) @@ -127,7 +133,8 @@ {.#Some (~ g!temp)} (~ g!temp) - {.#None} + ... {.#None} + (~ g!temp) (~ else))))]}) _ @@ -140,11 +147,12 @@ (def: .public (list value) (All (_ a) (-> (Maybe a) (List a))) (case value - {.#None} - {.#End} - {.#Some value} - {.#Item value {.#End}})) + {.#Item value {.#End}} + + ... {.#None} + _ + {.#End})) (macro: .public (when tokens state) (case tokens diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index 3e62dda4b..a82b72d33 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -19,11 +19,12 @@ (def: (each f ma) (case ma - {#Failure msg} - {#Failure msg} - {#Success datum} - {#Success (f datum)}))) + {#Success (f datum)} + + ... {#Failure msg} + it + (:expected it)))) (implementation: .public apply (Apply Try) @@ -37,11 +38,13 @@ {#Success a} {#Success (f a)} - {#Failure msg} - {#Failure msg}) + ... {#Failure msg} + it + (:expected it)) - {#Failure msg} - {#Failure msg}))) + ... {#Failure msg} + it + (:expected it)))) (implementation: .public monad (Monad Try) @@ -53,11 +56,12 @@ (def: (conjoint mma) (case mma - {#Failure msg} - {#Failure msg} - {#Success ma} - ma))) + ma + + ... {#Failure msg} + it + (:expected it)))) (implementation: .public (with monad) ... TODO: Replace (All (_ a) (! (Try a))) with (functor.Then ! Try) @@ -75,11 +79,12 @@ (do monad [eMea MeMea] (case eMea - {#Failure try} - (in {#Failure try}) - {#Success Mea} - Mea)))) + Mea + + ... {#Failure error} + it + (in (:expected it)))))) (def: .public (lifted monad) (All (_ ! a) (-> (Monad !) (-> (! a) (! (Try a))))) @@ -117,7 +122,8 @@ {#Success value} {.#Some value} - {#Failure message} + ... {#Failure message} + _ {.#None})) (def: .public (of_maybe maybe) @@ -138,7 +144,8 @@ {..#Success (~' g!temp)} (~' g!temp) - {..#Failure (~ [location.dummy {.#Symbol ["" ""]}])} + ... {..#Failure (~' g!temp)} + (~' g!temp) (~ else))))]} _ diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 17f2dd229..5c70611bf 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -1,55 +1,55 @@ (.using - [library - [lux {"-" Type Label int try} - ["[0]" ffi {"+" import:}] - [abstract - [monoid {"+" Monoid}] - ["[0]" monad {"+" Monad do}]] - [control - ["[0]" writer {"+" Writer}] - ["[0]" state {"+" +State}] - ["[0]" function] - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence {"+" Sequence}]]] - [macro - ["[0]" template]] - [math - [number - ["n" nat] - ["i" int] - ["[0]" i32 {"+" I32}]]]]] - ["[0]" / "_" - ["[1][0]" address {"+" Address}] - ["[1][0]" jump {"+" Jump Big_Jump}] - ["_" instruction {"+" Primitive_Array_Type Instruction Estimator} ("[1]#[0]" monoid)] - ["[1][0]" environment {"+" Environment} - [limit - ["/[0]" registry {"+" Register Registry}] - ["/[0]" stack {"+" Stack}]]] - ["/[1]" // "_" - ["[1][0]" index {"+" Index}] - [encoding - ["[1][0]" name] - ["[1][0]" unsigned {"+" U1 U2}] - ["[1][0]" signed {"+" S1 S2 S4}]] - ["[1][0]" constant {"+" UTF8} - ["[1]/[0]" pool {"+" Pool Resource}]] - [attribute - [code - ["[1][0]" exception {"+" Exception}]]] - ["[0]" type {"+" Type} - [category {"+" Class Object Value' Value Return' Return Method}] - ["[0]" reflection] - ["[0]" parser]]]]) + [library + [lux {"-" Type Label int try} + ["[0]" ffi {"+" import:}] + [abstract + [monoid {"+" Monoid}] + [functor {"+" Functor}] + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" writer {"+" Writer}] + ["[0]" state {"+" +State}] + ["[0]" maybe] + ["[0]" try {"+" Try} ("[1]#[0]" monad)] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence {"+" Sequence}]]] + [macro + ["[0]" template]] + [math + [number + ["n" nat] + ["i" int] + ["[0]" i32 {"+" I32}]]]]] + ["[0]" / "_" + ["[1][0]" address {"+" Address}] + ["[1][0]" jump {"+" Jump Big_Jump}] + ["_" instruction {"+" Primitive_Array_Type Instruction Estimator} ("[1]#[0]" monoid)] + ["[1][0]" environment {"+" Environment} + [limit + ["/[0]" registry {"+" Register Registry}] + ["/[0]" stack {"+" Stack}]]] + ["/[1]" // "_" + ["[1][0]" index {"+" Index}] + [encoding + ["[1][0]" name] + ["[1][0]" unsigned {"+" U1 U2}] + ["[1][0]" signed {"+" S1 S2 S4}]] + ["[1][0]" constant {"+" UTF8} + ["[1]/[0]" pool {"+" Pool Resource}]] + [attribute + [code + ["[1][0]" exception {"+" Exception}]]] + ["[0]" type {"+" Type} + [category {"+" Class Object Value' Value Return' Return Method}] + ["[0]" reflection] + ["[0]" parser]]]]) (type: .public Label Nat) @@ -76,29 +76,42 @@ (Sequence Exception) sequence.empty) -(def: relative_identity +(def: relative#identity Relative - (function.constant {try.#Success [..no_exceptions _.empty]})) + (function (_ _) + {try.#Success [..no_exceptions _.empty]})) -(implementation: relative_monoid - (Monoid Relative) +(template: (try|do ) + [(.case + {try.#Success } + - (def: identity ..relative_identity) + failure + (:expected failure))]) - (def: (composite left right) - (cond (same? ..relative_identity left) - right +(template: (try|in ) + [{try.#Success }]) - (same? ..relative_identity right) - left +(def: (relative#composite left right) + (-> Relative Relative Relative) + (cond (same? ..relative#identity left) + right - ... else - (function (_ resolver) - (do try.monad - [[left_exceptions left_instruction] (left resolver) - [right_exceptions right_instruction] (right resolver)] - (in [(# sequence.monoid composite left_exceptions right_exceptions) - (_#composite left_instruction right_instruction)])))))) + (same? ..relative#identity right) + left + + ... else + (function (_ resolver) + (<| (try|do [left_exceptions left_instruction] (left resolver)) + (try|do [right_exceptions right_instruction] (right resolver)) + (try|in [(# sequence.monoid composite left_exceptions right_exceptions) + (_#composite left_instruction right_instruction)]))))) + +(implementation: relative_monoid + (Monoid Relative) + + (def: identity ..relative#identity) + (def: composite ..relative#composite)) (type: .public (Bytecode a) (+State Try [Pool Environment Tracker] (Writer Relative a))) @@ -109,7 +122,7 @@ {try.#Success [[pool environment (revised@ #next ++ tracker)] - [..relative_identity + [..relative#identity (value@ #next tracker)]]})) (exception: .public (label_has_already_been_set [label Label]) @@ -133,7 +146,7 @@ (function (_ state) (let [[pool environment tracker] state] {try.#Success [state - [..relative_identity + [..relative#identity (case (dictionary.value label (value@ #known tracker)) {.#Some [expected {.#Some address}]} {.#Some [expected address]} @@ -146,7 +159,7 @@ (function (_ state) (let [[pool environment tracker] state] {try.#Success [state - [..relative_identity + [..relative#identity (case (dictionary.value label (value@ #known tracker)) {.#Some [expected {.#None}]} {.#Some expected} @@ -159,16 +172,16 @@ (function (_ state) (let [[pool environment tracker] state] {try.#Success [state - [..relative_identity + [..relative#identity (value@ /environment.#stack environment)]]}))) -(with_expansions [ (as_is (in [[pool - environment - (revised@ #known - (dictionary.has label [actual {.#Some @here}]) - tracker)] - [..relative_identity - []]]))] +(with_expansions [ (as_is (try|in [[pool + environment + (revised@ #known + (dictionary.has label [actual {.#Some @here}]) + tracker)] + [..relative#identity + []]]))] (def: .public (set_label label) (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) @@ -178,46 +191,82 @@ (exception.except ..label_has_already_been_set [label]) {.#Some [expected {.#None}]} - (do try.monad - [[actual environment] (/environment.continue expected environment)] - ) - - {.#None} - (do try.monad - [[actual environment] (/environment.continue (|> environment - (value@ /environment.#stack) - (maybe.else /stack.empty)) - environment)] - )))))) - -(def: .public monad + (<| (try|do [actual environment] (/environment.continue expected environment)) + ) + + ... {.#None} + _ + (<| (try|do [actual environment] (/environment.continue (|> environment + (value@ /environment.#stack) + (maybe.else /stack.empty)) + environment)) + )))))) + +(implementation: .public functor + (Functor Bytecode) + (def: (each $ it) + (function (_ state) + (case (it state) + {try.#Success [state' [relative it]]} + {try.#Success [state' [relative ($ it)]]} + + ... {try.#Failure error} + it + (:expected it))))) + +(implementation: .public monad (Monad Bytecode) - (<| (:as (Monad Bytecode)) - (writer.with ..relative_monoid) - (: (Monad (+State Try [Pool Environment Tracker]))) - state.with - (: (Monad Try)) - try.monad)) + + (def: &functor ..functor) + + (def: (in it) + (function (_ state) + {try.#Success [state [relative#identity it]]})) + + (def: (conjoint ^^it) + (function (_ state) + (case (^^it state) + {try.#Success [state' [left ^it]]} + (case (^it state') + {try.#Success [state'' [right it]]} + {try.#Success [state'' [(relative#composite left right) it]]} + + ... {try.#Failure error} + it + (:expected it)) + + ... {try.#Failure error} + it + (:expected it))))) (def: .public (when_continuous it) (-> (Bytecode Any) (Bytecode Any)) (do ..monad [stack ..stack] (.case stack - {.#None} (in []) - {.#Some _} it))) + {.#Some _} + it + + ... {.#None} + _ + (in [])))) (def: .public (when_acknowledged @ it) (-> Label (Bytecode Any) (Bytecode Any)) (do ..monad [?@ (..acknowledged? @)] (.case ?@ - {.#None} (in []) - {.#Some _} it))) + {.#Some _} + it -(def: .public failure + ... {.#None} + _ + (in [])))) + +(def: .public (failure error) (-> Text Bytecode) - (|>> {try.#Failure} function.constant)) + (function (_ _) + {try.#Failure error})) (def: .public (except exception value) (All (_ e) (-> (exception.Exception e) e Bytecode)) @@ -226,10 +275,9 @@ (def: .public (resolve environment bytecode) (All (_ a) (-> Environment (Bytecode a) (Resource [Environment (Sequence Exception) Instruction a]))) (function (_ pool) - (do try.monad - [[[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh]) - [exceptions instruction] (relative (value@ #known tracker))] - (in [pool [environment exceptions instruction output]])))) + (<| (try|do [[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh])) + (try|do [exceptions instruction] (relative (value@ #known tracker))) + (try|in [pool [environment exceptions instruction output]])))) (def: (step estimator counter) (-> Estimator Address (Try Address)) @@ -238,17 +286,18 @@ (def: (bytecode consumption production registry [estimator bytecode] input) (All (_ a) (-> U2 U2 Registry [Estimator (-> [a] Instruction)] a (Bytecode Any))) (function (_ [pool environment tracker]) - (do [! try.monad] - [environment' (|> environment - (/environment.consumes consumption) - (monad.then ! (/environment.produces production)) - (monad.then ! (/environment.has registry))) - program_counter' (step estimator (value@ #program_counter tracker))] - (in [[pool - environment' - (with@ #program_counter program_counter' tracker)] - [(function.constant (in [..no_exceptions (bytecode input)])) - []]])))) + (<| (try|do environment' (|> environment + (/environment.consumes consumption) + (monad.then try.monad (|>> (/environment.produces production) + (try#each (/environment.has registry)) + try#conjoint)))) + (try|do program_counter' (step estimator (value@ #program_counter tracker))) + (try|in [[pool + environment' + (with@ #program_counter program_counter' tracker)] + [(function (_ _) + (try|in [..no_exceptions (bytecode input)])) + []]])))) (template [ ] [(def: U2 @@ -461,13 +510,12 @@ (def: discontinuity! (Bytecode Any) (function (_ [pool environment tracker]) - (do try.monad - [_ (/environment.stack environment)] - (in [[pool - (/environment.discontinue environment) - tracker] - [..relative_identity - []]])))) + (<| (try|do _ (/environment.stack environment)) + (try|in [[pool + (/environment.discontinue environment) + tracker] + [..relative#identity + []]])))) (template [ ] [(def: .public @@ -495,11 +543,10 @@ (-> (Resource a) (Bytecode a))) (function (_ [pool environment tracker]) - (do try.monad - [[pool' output] (resource pool)] - (in [[pool' environment tracker] - [..relative_identity - output]])))) + (<| (try|do [pool' output] (resource pool)) + (try|in [[pool' environment tracker] + [..relative#identity + output]])))) (def: .public (string value) (-> //constant.UTF8 (Bytecode Any)) @@ -747,16 +794,15 @@ (def: (jump @from @to) (-> Address Address (Try Any_Jump)) - (do [! try.monad] - [jump (# ! each //signed.value - (/address.jump @from @to))] - (let [big? (or (i.> (//signed.value //signed.maximum/2) - jump) - (i.< (//signed.value //signed.minimum/2) - jump))] + (<| (try|do jump (try#each //signed.value + (/address.jump @from @to))) + (let [big? (or (i.> (//signed.value //signed.maximum/2) + jump) + (i.< (//signed.value //signed.minimum/2) + jump))]) (if big? - (# ! each (|>> {.#Left}) (//signed.s4 jump)) - (# ! each (|>> {.#Right}) (//signed.s2 jump)))))) + (try#each (|>> {.#Left}) (//signed.s4 jump)) + (try#each (|>> {.#Right}) (//signed.s2 jump))))) (exception: .public (unset_label [label Label]) (exception.report @@ -771,7 +817,8 @@ {.#Some [actual {.#None}]} (exception.except ..unset_label [label]) - {.#None} + ... {.#None} + _ (exception.except ..unknown_label [label]))) (def: (acknowledge_label stack label tracker) @@ -780,7 +827,8 @@ {.#Some _} tracker - {.#None} + ... {.#None} + _ (revised@ #known (dictionary.has label [stack {.#None}]) tracker))) (template [ ] @@ -788,31 +836,29 @@ (-> Label (Bytecode Any)) (let [[estimator bytecode] ] (function (_ [pool environment tracker]) - (let [@here (value@ #program_counter tracker)] - (do try.monad - [environment' (|> environment - (/environment.consumes )) - actual (/environment.stack environment') - program_counter' (step estimator @here)] - (in (let [@from @here] - [[pool - environment' - (|> tracker - (..acknowledge_label actual label) - (with@ #program_counter program_counter'))] - [(function (_ resolver) - (do try.monad - [[expected @to] (..resolve_label label resolver) - _ (exception.assertion ..mismatched_environments [(symbol ) label @here expected actual] - (# /stack.equivalence = expected actual)) - jump (..jump @from @to)] - (case jump - {.#Left jump} - (exception.except ..cannot_do_a_big_jump [label @from jump]) - - {.#Right jump} - (in [..no_exceptions (bytecode jump)])))) - []]])))))))] + (<| (let [@here (value@ #program_counter tracker)]) + (try|do environment' (|> environment + (/environment.consumes ))) + (try|do actual (/environment.stack environment')) + (try|do program_counter' (step estimator @here)) + (try|in (let [@from @here] + [[pool + environment' + (|> tracker + (..acknowledge_label actual label) + (with@ #program_counter program_counter'))] + [(function (_ resolver) + (<| (try|do [expected @to] (..resolve_label label resolver)) + (try|do _ (exception.assertion ..mismatched_environments [(symbol ) label @here expected actual] + (# /stack.equivalence = expected actual))) + (try|do jump (..jump @from @to)) + (case jump + {.#Left jump} + (exception.except ..cannot_do_a_big_jump [label @from jump]) + + {.#Right jump} + (try|in [..no_exceptions (bytecode jump)])))) + []]]))))))] [$1 ifeq _.ifeq] [$1 ifne _.ifne] @@ -840,43 +886,42 @@ (-> Label (Bytecode Any)) (let [[estimator bytecode] ] (function (_ [pool environment tracker]) - (do try.monad - [actual (/environment.stack environment) - .let [@here (value@ #program_counter tracker)] - program_counter' (step estimator @here)] - (in (let [@from @here] - [[pool - (/environment.discontinue environment) - (|> tracker - (..acknowledge_label actual label) - (with@ #program_counter program_counter'))] - [(function (_ resolver) - (case (dictionary.value label resolver) - {.#Some [expected {.#Some @to}]} - (do try.monad - [_ (exception.assertion ..mismatched_environments [(symbol ) label @here expected actual] - (# /stack.equivalence = expected actual)) - jump (..jump @from @to)] - (case jump - {.#Left jump} - - - {.#Right jump} - )) - - {.#Some [expected {.#None}]} - (exception.except ..unset_label [label]) - - {.#None} - (exception.except ..unknown_label [label]))) - []]]))))))] + (<| (try|do actual (/environment.stack environment)) + (let [@here (value@ #program_counter tracker)]) + (try|do program_counter' (step estimator @here)) + (try|in (let [@from @here] + [[pool + (/environment.discontinue environment) + (|> tracker + (..acknowledge_label actual label) + (with@ #program_counter program_counter'))] + [(function (_ resolver) + (case (dictionary.value label resolver) + {.#Some [expected {.#Some @to}]} + (<| (try|do _ (exception.assertion ..mismatched_environments [(symbol ) label @here expected actual] + (# /stack.equivalence = expected actual))) + (try|do jump (..jump @from @to)) + (case jump + {.#Left jump} + + + {.#Right jump} + )) + + {.#Some [expected {.#None}]} + (exception.except ..unset_label [label]) + + ... {.#None} + _ + (exception.except ..unknown_label [label]))) + []]]))))))] [goto _.goto (exception.except ..cannot_do_a_big_jump [label @from jump]) - (in [..no_exceptions (bytecode jump)])] + (try|in [..no_exceptions (bytecode jump)])] [goto_w _.goto_w - (in [..no_exceptions (bytecode jump)]) - (in [..no_exceptions (bytecode (/jump.lifted jump))])] + (try|in [..no_exceptions (bytecode jump)]) + (try|in [..no_exceptions (bytecode (/jump.lifted jump))])] ) (def: (big_jump jump) @@ -894,38 +939,37 @@ (-> S4 Label [Label (List Label)] (Bytecode Any)) (let [[estimator bytecode] _.tableswitch] (function (_ [pool environment tracker]) - (do try.monad - [environment' (|> environment - (/environment.consumes $1)) - actual (/environment.stack environment') - program_counter' (step (estimator (list.size afterwards)) (value@ #program_counter tracker))] - (in (let [@from (value@ #program_counter tracker)] - [[pool - environment' - (|> (list#mix (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) - (with@ #program_counter program_counter'))] - [(function (_ resolver) - (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) - (function (_ label) - (dictionary.value label resolver)))] - (case (do [! maybe.monad] - [@default (|> default get (monad.then ! product.right)) - @at_minimum (|> at_minimum get (monad.then ! product.right)) - @afterwards (|> afterwards - (monad.each ! get) - (monad.then ! (monad.each ! product.right)))] - (in [@default @at_minimum @afterwards])) - {.#Some [@default @at_minimum @afterwards]} - (do [! try.monad] - [>default (# ! each ..big_jump (..jump @from @default)) - >at_minimum (# ! each ..big_jump (..jump @from @at_minimum)) - >afterwards (monad.each ! (|>> (..jump @from) (# ! each ..big_jump)) - @afterwards)] - (in [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) - - {.#None} - (exception.except ..invalid_tableswitch [])))) - []]])))))) + (<| (try|do environment' (|> environment + (/environment.consumes $1))) + (try|do actual (/environment.stack environment')) + (try|do program_counter' (step (estimator (list.size afterwards)) (value@ #program_counter tracker))) + (try|in (let [@from (value@ #program_counter tracker)] + [[pool + environment' + (|> (list#mix (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) + (with@ #program_counter program_counter'))] + [(function (_ resolver) + (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) + (function (_ label) + (dictionary.value label resolver)))] + (case (do [! maybe.monad] + [@default (|> default get (monad.then ! product.right)) + @at_minimum (|> at_minimum get (monad.then ! product.right))] + (|> afterwards + (monad.each ! get) + (monad.then ! (monad.each ! product.right)) + (# ! each (|>> [@default @at_minimum])))) + {.#Some [@default @at_minimum @afterwards]} + (<| (try|do >default (try#each ..big_jump (..jump @from @default))) + (try|do >at_minimum (try#each ..big_jump (..jump @from @at_minimum))) + (try|do >afterwards (monad.each try.monad (|>> (..jump @from) (try#each ..big_jump)) + @afterwards)) + (try|in [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) + + ... {.#None} + _ + (exception.except ..invalid_tableswitch [])))) + []]])))))) (exception: .public invalid_lookupswitch) @@ -937,37 +981,36 @@ cases) [estimator bytecode] _.lookupswitch] (function (_ [pool environment tracker]) - (do try.monad - [environment' (|> environment - (/environment.consumes $1)) - actual (/environment.stack environment') - program_counter' (step (estimator (list.size cases)) (value@ #program_counter tracker))] - (in (let [@from (value@ #program_counter tracker)] - [[pool - environment' - (|> (list#mix (..acknowledge_label actual) tracker (list& default (list#each product.right cases))) - (with@ #program_counter program_counter'))] - [(function (_ resolver) - (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) - (function (_ label) - (dictionary.value label resolver)))] - (case (do [! maybe.monad] - [@default (|> default get (monad.then ! product.right)) - @cases (|> cases - (monad.each ! (|>> product.right get)) - (monad.then ! (monad.each ! product.right)))] - (in [@default @cases])) - {.#Some [@default @cases]} - (do [! try.monad] - [>default (# ! each ..big_jump (..jump @from @default)) - >cases (|> @cases - (monad.each ! (|>> (..jump @from) (# ! each ..big_jump))) - (# ! each (|>> (list.zipped/2 (list#each product.left cases)))))] - (in [..no_exceptions (bytecode >default >cases)])) - - {.#None} - (exception.except ..invalid_lookupswitch [])))) - []]])))))) + (<| (try|do environment' (|> environment + (/environment.consumes $1))) + (try|do actual (/environment.stack environment')) + (try|do program_counter' (step (estimator (list.size cases)) (value@ #program_counter tracker))) + (try|in (let [@from (value@ #program_counter tracker)] + [[pool + environment' + (|> (list#mix (..acknowledge_label actual) tracker (list& default (list#each product.right cases))) + (with@ #program_counter program_counter'))] + [(function (_ resolver) + (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) + (function (_ label) + (dictionary.value label resolver)))] + (case (do [! maybe.monad] + [@default (|> default get (monad.then ! product.right))] + (|> cases + (monad.each ! (|>> product.right get)) + (monad.then ! (monad.each ! product.right)) + (# ! each (|>> [@default])))) + {.#Some [@default @cases]} + (<| (try|do >default (try#each ..big_jump (..jump @from @default))) + (try|do >cases (|> @cases + (monad.each try.monad (|>> (..jump @from) (try#each ..big_jump))) + (try#each (|>> (list.zipped/2 (list#each product.left cases)))))) + (try|in [..no_exceptions (bytecode >default >cases)])) + + ... {.#None} + _ + (exception.except ..invalid_lookupswitch [])))) + []]])))))) (def: reflection (All (_ category) @@ -1080,24 +1123,34 @@ environment (..acknowledge_label /stack.catch @handler tracker)] [(function (_ resolver) - (do try.monad - [[_ @start] (..resolve_label @start resolver) - [_ @end] (..resolve_label @end resolver) - _ (if (/address.after? @start @end) - (in []) - (exception.except ..invalid_range_for_try [@start @end])) - [_ @handler] (..resolve_label @handler resolver)] - (in [(sequence.sequence - [//exception.#start @start - //exception.#end @end - //exception.#handler @handler - //exception.#catch @catch]) - _.empty]))) + (<| (try|do [_ @start] (..resolve_label @start resolver)) + (try|do [_ @end] (..resolve_label @end resolver)) + (try|do _ (if (/address.after? @start @end) + (try|in []) + (exception.except ..invalid_range_for_try [@start @end]))) + (try|do [_ @handler] (..resolve_label @handler resolver)) + (try|in [(sequence.sequence + [//exception.#start @start + //exception.#end @end + //exception.#handler @handler + //exception.#catch @catch]) + _.empty]))) []]]}))) (def: .public (composite pre post) (All (_ pre post) (-> (Bytecode pre) (Bytecode post) (Bytecode post))) - (do ..monad - [_ pre] - post)) + (function (_ state) + (case (pre state) + {try.#Success [state' [left _]]} + (case (post state') + {try.#Success [state'' [right it]]} + {try.#Success [state'' [(relative#composite left right) it]]} + + ... {try.#Failure error} + it + it) + + ... {try.#Failure error} + it + (:expected it)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux index e0798d438..a3084664d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux @@ -145,7 +145,7 @@ state) []]}))) -(def: .public (with_module hash name action) +(def: .public (with hash name action) (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) (do ///.monad [_ (..create hash name) 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 5bedbd7bf..7b24ab177 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 @@ -57,8 +57,8 @@ [imported! (///extension.lifted (meta.imported_by? ::module current))] (if imported! - (/.except foreign_module_has_not_been_imported [current ::module def_name]))) - (/.except definition_has_not_been_exported def_name)))) + (/.except ..foreign_module_has_not_been_imported [current ::module def_name]))) + (/.except ..definition_has_not_been_exported def_name)))) {.#Type [exported? value labels]} (do ! @@ -72,14 +72,14 @@ [imported! (///extension.lifted (meta.imported_by? ::module current))] (if imported! - (/.except foreign_module_has_not_been_imported [current ::module def_name]))) - (/.except definition_has_not_been_exported def_name)))) + (/.except ..foreign_module_has_not_been_imported [current ::module def_name]))) + (/.except ..definition_has_not_been_exported def_name)))) {.#Tag _} - (/.except labels_are_not_definitions [def_name]) + (/.except ..labels_are_not_definitions [def_name]) {.#Slot _} - (/.except labels_are_not_definitions [def_name]))))) + (/.except ..labels_are_not_definitions [def_name]))))) (def: (variable var_name) (-> Text (Operation (Maybe Analysis))) @@ -94,9 +94,9 @@ {.#None} (in {.#None})))) -(def: .public (reference reference) +(def: .public (reference it) (-> Symbol (Operation Analysis)) - (case reference + (case it ["" simple_name] (do [! ///.monad] [?var (variable simple_name)] @@ -110,4 +110,4 @@ (definition [this_module simple_name])))) _ - (definition reference))) + (definition it))) diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index dc4a3871f..39c51b2a7 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -10,6 +10,7 @@ ["$[0]" equivalence] ["$[0]" hash]]] [control + ["[0]" function] ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try} ("[1]#[0]" functor)]] [data @@ -180,6 +181,19 @@ (/.str/1 (/.int left)))) )))) +(def: test|text + Test + (do [! random.monad] + [expected_code (# ! each (n.% 128) random.nat) + .let [expected_char (text.of_char expected_code)]] + ($_ _.and + (_.cover [/.chr/1 /.ord/1] + (and (expression (|>> (:as Int) .nat (n.= expected_code)) + (/.ord/1 (/.chr/1 (/.int (.int expected_code))))) + (expression (|>> (:as Text) (text#= expected_char)) + (/.chr/1 (/.ord/1 (/.string expected_char)))))) + ))) + (def: test|array Test (do [! random.monad] @@ -195,14 +209,16 @@ to (/.int (.int (n.+ plus from))) from (/.int (.int from))]] ($_ _.and - (_.cover [/.list /.item] - (expression (|>> (:as Frac) (f.= expected)) - (/.item (/.int (.int index)) - (/.list (list#each /.float items))))) - (_.cover [/.tuple /.item] - (expression (|>> (:as Frac) (f.= expected)) - (/.item (/.int (.int index)) - (/.tuple (list#each /.float items))))) + (_.for [/.item] + ($_ _.and + (_.cover [/.list] + (expression (|>> (:as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.list (list#each /.float items))))) + (_.cover [/.tuple] + (expression (|>> (:as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.tuple (list#each /.float items))))))) (_.cover [/.slice /.len/1] (expression (|>> (:as Int) (i.= (.int plus))) (|> (/.list (list#each /.float items)) @@ -238,7 +254,7 @@ else random.safe_frac bool random.bit - float random.frac + float (random.only (|>> f.not_a_number? not) random.frac) string (random.ascii/upper 5) comment (random.ascii/upper 10)] @@ -246,6 +262,7 @@ ..test|bool ..test|float ..test|int + ..test|text ..test|array ..test|dict (_.cover [/.?] @@ -258,6 +275,13 @@ (expression (|>> (:as Frac) (f.= then)) (/.comment comment (/.float then)))) + (_.cover [/.__import__/1] + (expression (function.constant true) + (/.__import__/1 (/.string "math")))) + (_.cover [/.do] + (expression (|>> (:as Frac) (f.= (math.ceil float))) + (|> (/.__import__/1 (/.string "math")) + (/.do "ceil" (list (/.float float)))))) ))) (def: test|function diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 2291880ec..9d9d6c3a2 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -16,7 +16,8 @@ ["[1]/[0]" extension] ["[1]/[0]" analysis "_" ["[1]/[0]" simple] - ["[1]/[0]" complex]] + ["[1]/[0]" complex] + ["[1]/[0]" reference]] ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" @@ -37,6 +38,7 @@ /phase/extension.test /phase/analysis/simple.test /phase/analysis/complex.test + /phase/analysis/reference.test ... /syntax.test ... /synthesis.test )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux index 1a5ece06a..fa3df9c67 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux @@ -186,7 +186,7 @@ (type (Ex (_ a) (-> a a))) (list (` ("lux io error" "")))) //type.inferring - (//module.with_module 0 (product.left name)) + (//module.with 0 (product.left name)) (/phase#each (|>> product.right product.left check.clean //type.check)) /phase#conjoint (/phase.result state) @@ -231,7 +231,7 @@ {.#None} (in true))) - (//module.with_module 0 (product.left name)) + (//module.with 0 (product.left name)) (/phase#each product.right) (/phase.result state) (try.else false)))) @@ -331,7 +331,7 @@ {.#None} (in true))) - (//module.with_module 0 (product.left name)) + (//module.with 0 (product.left name)) (/phase#each product.right) (/phase.result state) (try.else false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux index ab07c98b3..d5cc7e0b8 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux @@ -82,9 +82,9 @@ (in (and (not pre) post))) (/phase.result state) (try.else false))) - (_.cover [/.with_module] + (_.cover [/.with] (|> (do /phase.monad - [[it _] (/.with_module hash name + [[it _] (/.with hash name (in []))] (in it)) (/phase.result state) @@ -94,7 +94,7 @@ (`` (and (~~ (template [] [(|> (do [! /phase.monad] [_ (/.create hash expected_import) - [it ?] (/.with_module hash name + [it ?] (/.with hash name (do ! [_ (if (/.import expected_import) @@ -111,7 +111,7 @@ (_.cover [/.alias] (|> (do [! /phase.monad] [_ (/.create hash expected_import) - [it _] (/.with_module hash name + [it _] (/.with hash name (do ! [_ (/.import expected_import)] (/.alias expected_alias expected_import)))] @@ -139,7 +139,7 @@ (~~ (template [ ] [(_.cover [ ] (|> (do [! /phase.monad] - [[it ?] (/.with_module hash name + [[it ?] (/.with hash name (do ! [_ ( name) ? ( name) @@ -156,7 +156,7 @@ )) (_.cover [/.can_only_change_state_of_active_module] (and (~~ (template [
 ]
-                                [(|> (/.with_module hash name
+                                [(|> (/.with hash name
                                        (do /phase.monad
                                          [_ (
 name)]
                                          ( name)))
@@ -215,7 +215,7 @@
     ($_ _.and
         (_.cover [/.define]
                  (`` (and (~~ (template []
-                                [(|> (/.with_module hash module_name
+                                [(|> (/.with hash module_name
                                        (/.define def_name ))
                                      (/phase.result state)
                                      (case> {try.#Success _} true
@@ -226,7 +226,7 @@
                                 [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}]
                                 [{.#Tag [public? def_type (list& labels|head labels|tail) index]}]
                                 [{.#Slot [public? def_type (list& labels|head labels|tail) index]}]))
-                          (|> (/.with_module hash module_name
+                          (|> (/.with hash module_name
                                 (do /phase.monad
                                   [_ (/.define def_name definition)]
                                   (/.define alias_name alias)))
@@ -235,7 +235,7 @@
                                      {try.#Failure _} false)))))
         (_.cover [/.cannot_define_more_than_once]
                  (`` (and (~~ (template []
-                                [(|> (/.with_module hash module_name
+                                [(|> (/.with hash module_name
                                        (do /phase.monad
                                          [_ (/.define def_name )]
                                          (/.define def_name )))
@@ -248,7 +248,7 @@
                                 [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}]
                                 [{.#Tag [public? def_type (list& labels|head labels|tail) index]}]
                                 [{.#Slot [public? def_type (list& labels|head labels|tail) index]}]))
-                          (|> (/.with_module hash module_name
+                          (|> (/.with hash module_name
                                 (do /phase.monad
                                   [_ (/.define def_name definition)
                                    _ (/.define alias_name alias)]
@@ -280,7 +280,7 @@
     ($_ _.and
         (_.cover [/.declare_labels]
                  (`` (and (~~ (template [   ]
-                                [(|> (/.with_module hash module_name
+                                [(|> (/.with hash module_name
                                        (do [! /phase.monad]
                                          [.let [it {.#Named [module_name def_name] def_type}]
                                           _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})
@@ -297,7 +297,7 @@
                                 [.#Right true meta.tag false])))))
         (_.cover [/.cannot_declare_labels_for_anonymous_type]
                  (`` (and (~~ (template [ ]
-                                [(|> (/.with_module hash module_name
+                                [(|> (/.with hash module_name
                                        (do [! /phase.monad]
                                          [.let [it def_type]
                                           _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})]
@@ -313,7 +313,7 @@
                                 [.#Right true])))))
         (_.cover [/.cannot_declare_labels_for_foreign_type]
                  (`` (and (~~ (template [ ]
-                                [(|> (/.with_module hash module_name
+                                [(|> (/.with hash module_name
                                        (do [! /phase.monad]
                                          [.let [it {.#Named [foreign_module def_name] def_type}]
                                           _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})]
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index fcf0a556e..f559e98c4 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -153,7 +153,7 @@
 
                                              _
                                              false)))
-                                     (//module.with_module 0 (product.left name))
+                                     (//module.with 0 (product.left name))
                                      (//phase#each product.right)
                                      (//phase.result state)
                                      (try.else false))))]
@@ -172,7 +172,7 @@
 
                                     _
                                     false)))
-                            (//module.with_module 0 (product.left name))
+                            (//module.with 0 (product.left name))
                             (//phase#each product.right)
                             (//phase.result state)
                             (try.else false))
@@ -246,7 +246,7 @@
 
                                                           _
                                                           false)))
-                                                  (//module.with_module 0 module)
+                                                  (//module.with 0 module)
                                                   (//phase#each product.right)
                                                   (//phase.result state)
                                                   (try.else false))))
@@ -265,7 +265,7 @@
 
                                                           _
                                                           false)))
-                                                  (//module.with_module 0 module)
+                                                  (//module.with 0 module)
                                                   (//phase#each product.right)
                                                   (//phase.result state)
                                                   (try.else false))))]
@@ -313,7 +313,7 @@
 
                                                  _
                                                  false)))
-                                         (//module.with_module 0 module)
+                                         (//module.with 0 module)
                                          (//phase#each product.right)
                                          (//phase.result state)
                                          (try.else false))))]
@@ -338,7 +338,7 @@
 
                                     _
                                     false)))
-                            (//module.with_module 0 module)
+                            (//module.with 0 module)
                             (//phase#each product.right)
                             (//phase.result state)
                             (try.else false))
@@ -357,7 +357,7 @@
 
                                     _
                                     false)))
-                            (//module.with_module 0 module)
+                            (//module.with 0 module)
                             (//phase#each product.right)
                             (//phase.result state)
                             (try.else false))
@@ -380,7 +380,7 @@
 
                                     _
                                     false)))
-                            (//module.with_module 0 module)
+                            (//module.with 0 module)
                             (//phase#each product.right)
                             (//phase.result state)
                             (try.else false))
@@ -398,7 +398,7 @@
 
                                     _
                                     false)))
-                            (//module.with_module 0 module)
+                            (//module.with 0 module)
                             (//phase#each product.right)
                             (//phase.result state)
                             (try.else false)))))
@@ -473,7 +473,7 @@
                                     (|> (do //phase.monad
                                           [_ (//module.declare_labels true slots/0 false :record:)]
                                           (/.normal input))
-                                        (//module.with_module 0 module)
+                                        (//module.with 0 module)
                                         (//phase#each product.right)
                                         (//phase.result state)
                                         (case> {try.#Success {.#Some actual}}
@@ -501,7 +501,7 @@
                                            [_ (//module.declare_labels true slots/0 false :record:)]
                                            (/.order pattern_matching? input))
                                          //scope.with
-                                         (//module.with_module 0 module)
+                                         (//module.with 0 module)
                                          (//phase#each (|>> product.right product.right))
                                          (//phase.result state)
                                          (case> {try.#Success {.#Some [actual_arity actual_tuple actual_type]}}
@@ -541,7 +541,7 @@
                                       (|> (do //phase.monad
                                             [_ (//module.declare_labels true slots/0 false :record:)]
                                             (/.order pattern_matching? (list.repeated arity [[module head_slot/0] head_term/0])))
-                                          (//module.with_module 0 module)
+                                          (//module.with 0 module)
                                           (//phase#each product.right)
                                           (//phase.result state)
                                           (..failure? /.cannot_repeat_slot))))]
@@ -556,7 +556,7 @@
                                               [_ (//module.declare_labels true slots/0 false :record:)]
                                               (/.order pattern_matching? input))
                                             //scope.with
-                                            (//module.with_module 0 module)
+                                            (//module.with 0 module)
                                             (//phase.result state)
                                             (..failure? /.record_size_mismatch))))]
                    (and (mismatched? false (list.first slice local_record))
@@ -576,7 +576,7 @@
                                                _ (//module.declare_labels true slots/1 false :record:)]
                                               (/.order pattern_matching? input))
                                             //scope.with
-                                            (//module.with_module 0 module)
+                                            (//module.with 0 module)
                                             (//phase.result state)
                                             (..failure? /.slot_does_not_belong_to_record))))]
                    (and (mismatched? false local_record)
@@ -591,7 +591,7 @@
                                           (/.record ..analysis archive.empty tuple))
                                         (//type.expecting type)
                                         //scope.with
-                                        (//module.with_module 0 module)
+                                        (//module.with 0 module)
                                         (//phase#each (|>> product.right product.right))
                                         (//phase.result state)
                                         (try#each (analysed? expected))
@@ -603,7 +603,7 @@
                                             (//type.inferring
                                              (/.record ..analysis archive.empty record)))
                                           //scope.with
-                                          (//module.with_module 0 module)
+                                          (//module.with 0 module)
                                           (//phase#each (|>> product.right product.right))
                                           (//phase.result state)
                                           (try#each (function (_ [actual_type actual_term])
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
index 39bd5fd28..c16cbf491 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
@@ -1,108 +1,213 @@
 (.using
+ [library
   [lux "*"
-   [abstract
-    ["[0]" monad {"+" do}]]
-   ["r" math/random {"+" Random}]
    ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
    [control
-    pipe
-    ["[0]" try {"+" Try}]]
+    [pipe {"+" case>}]
+    ["[0]" try ("[1]#[0]" functor)]
+    ["[0]" exception]]
    [data
-    ["[0]" text ("[1]#[0]" equivalence)]
-    [number
-     ["n" nat]]]
-   ["[0]" type ("[1]#[0]" equivalence)]
-   [macro
-    ["[0]" code]]
-   [meta
-    ["[0]" symbol ("[1]#[0]" equivalence)]]]
-  [//
-   ["_[0]" primitive]]
-  [\\
-   ["[0]" /
-    ["/[1]" //
-     ["[1][0]" scope]
-     ["[1][0]" module]
-     ["[1][0]" type]
-     ["/[1]" // "_"
-      ["/[1]" //
-       ["[1][0]" analysis {"+" Analysis Variant Tag Operation}]
-       [///
-        ["[1][0]" reference]
-        ["[0]" phase]
-        [meta
-         ["[0]" archive]]]]]]]])
+    ["[0]" product]
+    ["[0]" text]]
+   [math
+    ["[0]" random]]
+   ["[0]" type ("[1]#[0]" equivalence)
+    ["$[1]" \\test]]]]
+ [\\library
+  ["[0]" /
+   ["/[1]" // "_"
+    [//
+     ["[1][0]" extension]
+     [//
+      ["[1][0]" analysis
+       ["[2][0]" scope]
+       ["[2][0]" module]
+       ["[2][0]" type
+        ["$[1]" \\test]]]
+      [///
+       ["[1][0]" phase ("[1]#[0]" monad)]]]]]]])
 
-(type: Check (-> (Try Any) Bit))
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [lux $//type.random_state
+         .let [state [//extension.#bundle //extension.empty
+                      //extension.#state lux]]
+         expected_name (random.ascii/lower 1)
+         expected_type ($type.random 0)
+         expected_module (random.ascii/lower 2)
+         import (random.ascii/lower 3)
+         expected_label (random.ascii/lower 4)
+         record? random.bit]
+        ($_ _.and
+            (_.cover [/.reference]
+                     (let [can_find_local_variable!
+                           (|> (/.reference ["" expected_name])
+                               (//scope.with_local [expected_name expected_type])
+                               //type.inferring
+                               //scope.with
+                               (//phase.result state)
+                               (try#each (|>> product.right
+                                              (case> (^ [actual_type (//analysis.local 0)])
+                                                     (type#= expected_type actual_type)
 
-(template [  ]
-  [(def: 
-     Check
-     (|>> (case> {try.#Success _}
-                 
+                                                     _
+                                                     false)))
+                               (try.else false))
 
-                 {try.#Failure _}
-                 )))]
+                           can_find_foreign_variable!
+                           (|> (/.reference ["" expected_name])
+                               //type.inferring
+                               //scope.with
+                               (//scope.with_local [expected_name expected_type])
+                               //scope.with
+                               (//phase.result state)
+                               (try#each (|>> product.right
+                                              product.right
+                                              (case> (^ [actual_type (//analysis.foreign 0)])
+                                                     (type#= expected_type actual_type)
 
-  [success? true false]
-  [failure? false true]
-  )
+                                                     _
+                                                     false)))
+                               (try.else false))
 
-(def: (reach_test var_name [export? def_module] [import? dependent_module] check!)
-  (-> Text [Bit Text] [Bit Text] Check Bit)
-  (|> (do [! phase.monad]
-        [_ (//module.with_module 0 def_module
-             (//module.define var_name {.#Right [export? Any []]}))]
-        (//module.with_module 0 dependent_module
-          (do !
-            [_ (if import?
-                 (//module.import def_module)
-                 (in []))]
-            (//type.with_inference
-              (_primitive.phase archive.empty (code.symbol [def_module var_name]))))))
-      (phase.result _primitive.state)
-      check!))
+                           can_find_local_definition!
+                           (|> (do //phase.monad
+                                 [_ (//module.define expected_name {.#Definition [#0 expected_type []]})]
+                                 (/.reference ["" expected_name]))
+                               //type.inferring
+                               (//module.with 0 expected_module)
+                               (//phase.result state)
+                               (try#each (|>> product.right
+                                              (case> (^ [actual_type (//analysis.constant [actual_module actual_name])])
+                                                     (and (type#= expected_type actual_type)
+                                                          (same? expected_module actual_module)
+                                                          (same? expected_name actual_name))
 
-(def: .public test
-  (<| (_.context (symbol.module (symbol /._)))
-      (do r.monad
-        [[expectedT _] _primitive.primitive
-         def_module (r.unicode 5)
-         scope_name (r.unicode 5)
-         var_name (r.unicode 5)
-         dependent_module (|> (r.unicode 5)
-                              (r.only (|>> (text#= def_module) not)))]
-        ($_ _.and
-            (_.test "Can analyse variable."
-                    (|> (//scope.with_scope scope_name
-                          (//scope.with_local [var_name expectedT]
-                            (//type.with_inference
-                              (_primitive.phase archive.empty (code.local_symbol var_name)))))
-                        (phase.result _primitive.state)
-                        (case> (^ {try.#Success [inferredT {////analysis.#Reference (////reference.local var)}]})
-                               (and (type#= expectedT inferredT)
-                                    (n.= 0 var))
+                                                     _
+                                                     false)))
+                               (try.else false))
+
+                           can_find_foreign_definition!
+                           (|> (do //phase.monad
+                                 [_ (//module.with 0 import
+                                      (//module.define expected_name {.#Definition [#1 expected_type []]}))
+                                  _ (//module.import import)]
+                                 (/.reference [import expected_name]))
+                               //type.inferring
+                               (//module.with 0 expected_module)
+                               (//phase.result state)
+                               (try#each (|>> product.right
+                                              (case> (^ [actual_type (//analysis.constant [actual_module actual_name])])
+                                                     (and (type#= expected_type actual_type)
+                                                          (same? import actual_module)
+                                                          (same? expected_name actual_name))
+
+                                                     _
+                                                     false)))
+                               (try.else false))
+
+                           can_find_alias!
+                           (|> (do //phase.monad
+                                 [_ (//module.with 0 import
+                                      (//module.define expected_name {.#Definition [#1 expected_type []]}))
+                                  _ (//module.import import)
+                                  _ (//module.define expected_name {.#Alias [import expected_name]})]
+                                 (/.reference [expected_module expected_name]))
+                               //type.inferring
+                               (//module.with 0 expected_module)
+                               (//phase.result state)
+                               (try#each (|>> product.right
+                                              (case> (^ [actual_type (//analysis.constant [actual_module actual_name])])
+                                                     (and (type#= expected_type actual_type)
+                                                          (same? import actual_module)
+                                                          (same? expected_name actual_name))
+
+                                                     _
+                                                     false)))
+                               (try.else false))
+
+                           can_find_type!
+                           (|> (do //phase.monad
+                                 [_ (//module.define expected_name {.#Type [#0 expected_type
+                                                                            (if record?
+                                                                              {.#Right [expected_label (list)]}
+                                                                              {.#Left [expected_label (list)]})]})]
+                                 (/.reference [expected_module expected_name]))
+                               //type.inferring
+                               (//module.with 0 expected_module)
+                               (//phase.result state)
+                               (try#each (|>> product.right
+                                              (case> (^ [actual_type (//analysis.constant [actual_module actual_name])])
+                                                     (and (type#= .Type actual_type)
+                                                          (same? expected_module actual_module)
+                                                          (same? expected_name actual_name))
 
-                               _
-                               false)))
-            (_.test "Can analyse definition (in the same module)."
-                    (let [def_name [def_module var_name]]
-                      (|> (do phase.monad
-                            [_ (//module.define var_name {.#Right [false expectedT []]})]
-                            (//type.with_inference
-                              (_primitive.phase archive.empty (code.symbol def_name))))
-                          (//module.with_module 0 def_module)
-                          (phase.result _primitive.state)
-                          (case> (^ {try.#Success [_ inferredT {////analysis.#Reference (////reference.constant constant_name)}]})
-                                 (and (type#= expectedT inferredT)
-                                      (symbol#= def_name constant_name))
+                                                     _
+                                                     false)))
+                               (try.else false))]
+                       (and can_find_local_variable!
+                            can_find_foreign_variable!
+                            
+                            can_find_local_definition!
+                            can_find_foreign_definition!
 
-                                 _
-                                 false))))
-            (_.test "Can analyse definition (if exported from imported module)."
-                    (reach_test var_name [true def_module] [true dependent_module] success?))
-            (_.test "Cannot analyse definition (if not exported from imported module)."
-                    (reach_test var_name [false def_module] [true dependent_module] failure?))
-            (_.test "Cannot analyse definition (if exported from non-imported module)."
-                    (reach_test var_name [true def_module] [false dependent_module] failure?))
+                            can_find_alias!
+                            can_find_type!)))
+            (_.cover [/.foreign_module_has_not_been_imported]
+                     (let [scenario (: (-> Type Global Bit)
+                                       (function (_ expected_type it)
+                                         (|> (do //phase.monad
+                                               [_ (//module.with 0 import
+                                                    (//module.define expected_name it))
+                                                _ (/.reference [import expected_name])]
+                                               (in false))
+                                             (//type.expecting expected_type)
+                                             (//module.with 0 expected_module)
+                                             (//phase#each product.right)
+                                             (//phase.result state)
+                                             (exception.otherwise (text.contains? (value@ exception.#label /.foreign_module_has_not_been_imported)))
+                                             )))]
+                       (and (scenario expected_type {.#Definition [#1 expected_type []]})
+                            (scenario .Type {.#Type [#1 expected_type
+                                                     (if record?
+                                                       {.#Right [expected_label (list)]}
+                                                       {.#Left [expected_label (list)]})]}))))
+            (_.cover [/.definition_has_not_been_exported]
+                     (let [scenario (: (-> Type Global Bit)
+                                       (function (_ expected_type it)
+                                         (|> (do //phase.monad
+                                               [_ (//module.with 0 import
+                                                    (//module.define expected_name it))
+                                                _ (/.reference [import expected_name])]
+                                               (in false))
+                                             (//type.expecting expected_type)
+                                             (//module.with 0 expected_module)
+                                             (//phase#each product.right)
+                                             (//phase.result state)
+                                             (exception.otherwise (text.contains? (value@ exception.#label /.definition_has_not_been_exported)))
+                                             )))]
+                       (and (scenario expected_type {.#Definition [#0 expected_type []]})
+                            (scenario .Type {.#Type [#0 expected_type
+                                                     (if record?
+                                                       {.#Right [expected_label (list)]}
+                                                       {.#Left [expected_label (list)]})]}))))
+            (_.cover [/.labels_are_not_definitions]
+                     (let [scenario (: (-> Type Global Bit)
+                                       (function (_ expected_type it)
+                                         (|> (do //phase.monad
+                                               [_ (//module.with 0 import
+                                                    (//module.define expected_label it))
+                                                _ (/.reference [import expected_label])]
+                                               (in false))
+                                             (//type.expecting expected_type)
+                                             (//module.with 0 expected_module)
+                                             (//phase#each product.right)
+                                             (//phase.result state)
+                                             (exception.otherwise (text.contains? (value@ exception.#label /.labels_are_not_definitions))))))]
+                       (and (scenario expected_type {.#Tag [#1 expected_type (list) 0]})
+                            (scenario expected_type {.#Slot [#1 expected_type (list) 0]}))))
             ))))
-- 
cgit v1.2.3