diff options
author | Eduardo Julian | 2022-02-08 04:08:38 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-02-08 04:08:38 -0400 |
commit | 0755768bb993cfb3924986eeb0486204a90bfeee (patch) | |
tree | 79698c3854c720c4839155454dc1f7fa2abdf256 /stdlib/source/test | |
parent | 7065801a9ad1724c6a82e9803c218b2981bc59b3 (diff) |
Optimizations for the pure-Lux JVM compiler. [Part 1]
Diffstat (limited to 'stdlib/source/test')
6 files changed, 267 insertions, 136 deletions
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 [<expected>] [(|> (do [! /phase.monad] [_ (/.create hash expected_import) - [it ?] (/.with_module hash name + [it ?] (/.with hash name (do ! [_ (if <expected> (/.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 [<set> <query> <not/0> <not/1>] [(_.cover [<set> <query>] (|> (do [! /phase.monad] - [[it ?] (/.with_module hash name + [[it ?] (/.with hash name (do ! [_ (<set> name) ? (<query> name) @@ -156,7 +156,7 @@ )) (_.cover [/.can_only_change_state_of_active_module] (and (~~ (template [<pre> <post>] - [(|> (/.with_module hash name + [(|> (/.with hash name (do /phase.monad [_ (<pre> name)] (<post> name))) @@ -215,7 +215,7 @@ ($_ _.and (_.cover [/.define] (`` (and (~~ (template [<global>] - [(|> (/.with_module hash module_name + [(|> (/.with hash module_name (/.define def_name <global>)) (/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 [<global>] - [(|> (/.with_module hash module_name + [(|> (/.with hash module_name (do /phase.monad [_ (/.define def_name <global>)] (/.define def_name <global>))) @@ -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 [<side> <record?> <query> <on_success>] - [(|> (/.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 {<side> [labels|head labels|tail]}]}) @@ -297,7 +297,7 @@ [.#Right true meta.tag false]))))) (_.cover [/.cannot_declare_labels_for_anonymous_type] (`` (and (~~ (template [<side> <record?>] - [(|> (/.with_module hash module_name + [(|> (/.with hash module_name (do [! /phase.monad] [.let [it def_type] _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] @@ -313,7 +313,7 @@ [.#Right true]))))) (_.cover [/.cannot_declare_labels_for_foreign_type] (`` (and (~~ (template [<side> <record?>] - [(|> (/.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 {<side> [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 [<name> <on_success> <on_failure>] - [(def: <name> - Check - (|>> (case> {try.#Success _} - <on_success> + _ + false))) + (try.else false)) - {try.#Failure _} - <on_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]})))) )))) |