From 290de8ebcb7edc92877f2ccc333171214e5eae23 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 6 Feb 2022 03:15:39 -0400 Subject: Finishing the meta-compiler [Part 1] --- stdlib/source/test/lux/target/python.lux | 24 ++- .../lux/tool/compiler/language/lux/analysis.lux | 18 +- .../tool/compiler/language/lux/analysis/scope.lux | 203 +++++++++++++++++++++ .../tool/compiler/language/lux/analysis/type.lux | 2 +- .../language/lux/phase/analysis/complex.lux | 15 +- stdlib/source/test/lux/tool/compiler/meta/cli.lux | 35 +++- 6 files changed, 270 insertions(+), 27 deletions(-) create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index e936ba850..dc4a3871f 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -5,7 +5,10 @@ ["[0]" ffi] [abstract [monad {"+" do}] - ["[0]" predicate]] + ["[0]" predicate] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash]]] [control ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try} ("[1]#[0]" functor)]] @@ -125,6 +128,12 @@ [/.>= f.>=] [/.= f.=] )) + (_.cover [/.float/1] + (expression (|>> (:as Frac) (f.= subject)) + (/.float/1 (/.string (%.frac subject))))) + (_.cover [/.repr/1] + (expression (|>> (:as Text) (text#= (text.replaced "+" "" (%.frac subject)))) + (/.repr/1 (/.float subject)))) )))) (def: int/16 @@ -163,6 +172,12 @@ (expression (|>> (:as Frac) f.int (i.= expected)) (/.bit_shr (/.int (.int shift)) (/.int i16))))) + (_.cover [/.int/1] + (expression (|>> (:as Int) (i.= left)) + (/.int/1 (/.string (%.int left))))) + (_.cover [/.str/1] + (expression (|>> (:as Text) (text#= (text.replaced "+" "" (%.int left)))) + (/.str/1 (/.int left)))) )))) (def: test|array @@ -301,10 +316,15 @@ (def: .public test Test (do [! random.monad] - [] + [.let [random (# ! each /.int random.int)]] (<| (_.covering /._) (_.for [/.Code /.code]) ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random)) + (_.for [/.hash] + ($hash.spec /.hash random)) + (_.for [/.Expression] ..test|expression) )))) 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 ccca4213f..135ac5840 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -24,13 +24,14 @@ [number ["f" frac]]]]] ["[0]" / "_" - ["[1][0]" simple] ["[1][0]" complex] - ["[1][0]" pattern] + ["[1][0]" inference] ["[1][0]" macro] - ["[1][0]" type] ["[1][0]" module] - ["[1][0]" inference] + ["[1][0]" pattern] + ["[1][0]" scope] + ["[1][0]" simple] + ["[1][0]" type] [//// ["[1][0]" reference ["[2][0]" variable]] @@ -437,11 +438,12 @@ (bit#= (# /.equivalence = left right) (text#= (/.format left) (/.format right)))) - /simple.test /complex.test - /pattern.test + /inference.test /macro.test - /type.test /module.test - /inference.test + /pattern.test + /scope.test + /simple.test + /type.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux new file mode 100644 index 000000000..dbd1f83de --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux @@ -0,0 +1,203 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" product] + [collection + ["[0]" list]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + ["[0]" type "_" + ["$[1]" \\test]]]] + [\\library + ["[0]" / + ["/[1]" // + [// + [phase + ["[1][0]" extension]] + [/// + ["[1][0]" phase ("[1]#[0]" monad)] + [reference + ["[1][0]" variable {"+" Register Variable}]]]]]]] + ["$[0]" // "_" + ["[1][0]" type]]) + +(template [ ] + [(def: ( expected_type expected_register [actual_type actual_var]) + (-> Type Register [Type Variable] Bit) + (and (same? expected_type actual_type) + (case actual_var + { actual_register} + (n.= expected_register actual_register) + + _ + false)))] + + [local? //variable.#Local] + [foreign? //variable.#Foreign] + ) + +(def: .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [lux $//type.random_state + .let [state [//extension.#bundle //extension.empty + //extension.#state lux]] + name/0 (random.ascii/lower 1) + name/1 (random.ascii/lower 2) + type/0 ($type.random 0) + type/1 ($type.random 0)] + ($_ _.and + (_.cover [/.find] + (|> (/.find name/0) + /.with + (//phase.result state) + (try#each (|>> product.right + (case> {.#None} true + {.#Some _} false))) + (try.else false))) + (_.cover [/.with_local] + (|> (/.with_local [name/0 type/0] + (/.find name/0)) + /.with + (//phase.result state) + (try#each (|>> product.right + (maybe#each (..local? type/0 0)) + (maybe.else false))) + (try.else false))) + (_.cover [/.next] + (|> (<| (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (do ! + [var/0 (/.find name/0)]) + (do ! + [register/1 /.next]) + (/.with_local [name/1 type/1]) + (do ! + [var/1 (/.find name/1)]) + (in (do maybe.monad + [var/0 var/0 + var/1 var/1] + (in [[register/0 var/0] [register/1 var/1]])))) + /.with + (//phase.result state) + (try#each (|>> product.right + (maybe#each (function (_ [[register/0 var/0] [register/1 var/1]]) + (and (..local? type/0 register/0 var/0) + (..local? type/1 register/1 var/1)))) + (maybe.else false))) + (try.else false))) + (_.cover [/.no_scope] + (and (|> (/.with_local [name/0 type/0] + (//phase#in false)) + (//phase.result state) + (exception.otherwise (exception.match? /.no_scope))) + (|> (do //phase.monad + [_ /.next] + (in false)) + (//phase.result state) + (exception.otherwise (exception.match? /.no_scope))))) + (_.cover [/.reset] + (and (|> /.next + (/.with_local [name/0 type/0]) + /.with + (//phase.result state) + (try#each (|>> product.right + (n.= 1))) + (try.else false)) + (|> /.next + /.reset + (/.with_local [name/0 type/0]) + /.with + (//phase.result state) + (try#each (|>> product.right + (n.= 0))) + (try.else false)))) + (_.cover [/.drained] + (|> (function (_ [bundle state]) + {try.#Success [[bundle (with@ .#scopes (list) state)] + false]}) + (/.with_local [name/0 type/0]) + /.with + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (exception.match? /.drained)))) + (_.cover [/.with] + (|> (<| /.with + (/.with_local [name/0 type/0]) + (do //phase.monad + [var/0' (/.find name/0) + [scope/1 var/0''] (/.with (/.find name/0))] + (<| //phase.lifted + try.of_maybe + (do maybe.monad + [var/0' var/0' + var/0'' var/0''] + (in [var/0' scope/1 var/0'']))))) + (//phase.result state) + (try#each (function (_ [scope/0 var/0' scope/1 var/0'']) + (and (local? type/0 0 var/0') + (n.= 0 (list.size (value@ [.#locals .#mappings] scope/0))) + (n.= 0 (list.size (value@ [.#captured .#mappings] scope/0))) + + (foreign? type/0 0 var/0'') + (n.= 0 (list.size (value@ [.#locals .#mappings] scope/1))) + (n.= 1 (list.size (value@ [.#captured .#mappings] scope/1)))))) + (try.else false))) + (_.cover [/.environment] + (let [(^open "list#[0]") (list.equivalence //variable.equivalence)] + (and (|> (<| /.with + (/.with_local [name/0 type/0]) + (/.with_local [name/1 type/1]) + (do //phase.monad + [[scope/1 _] (/.with (in []))] + (in (/.environment scope/1)))) + (//phase.result state) + (try#each (|>> product.right + (list#= (list)))) + (try.else false)) + (|> (<| /.with + (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (/.with_local [name/1 type/1]) + (do ! + [[scope/1 _] (/.with (/.find name/0))] + (in [register/0 (/.environment scope/1)]))) + (//phase.result state) + (try#each (function (_ [_ [register/0 environment]]) + (list#= (list {//variable.#Local register/0}) + environment))) + (try.else false)) + (|> (<| /.with + (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (do [! //phase.monad] + [register/1 /.next]) + (/.with_local [name/1 type/1]) + (do [! //phase.monad] + [[scope/1 _] (/.with (do ! + [_ (/.find name/1) + _ (/.find name/0)] + (in [])))] + (in [register/0 register/1 (/.environment scope/1)]))) + (//phase.result state) + (try#each (function (_ [_ [register/0 register/1 environment]]) + (list#= (list {//variable.#Local register/1} + {//variable.#Local register/0}) + environment))) + (try.else false))))) + )))) 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 index 781a7f38f..2e63f1bc8 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux @@ -22,7 +22,7 @@ [/// ["[2][0]" phase]]]]]]) -(def: random_state +(def: .public random_state (Random Lux) (do random.monad [version random.nat 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 89c341c2a..fcf0a556e 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 @@ -42,7 +42,8 @@ ["[2][0]" macro] ["[2][0]" type] ["[2][0]" module] - ["[2][0]" complex]] + ["[2][0]" complex] + ["[2][0]" scope]] [/// ["[1][0]" phase ("[1]#[0]" monad)] [meta @@ -488,7 +489,7 @@ (//phase.result state) (case> {try.#Success {.#None}} true - + _ false))))) (_.cover [/.order] @@ -499,7 +500,7 @@ (|> (do //phase.monad [_ (//module.declare_labels true slots/0 false :record:)] (/.order pattern_matching? input)) - //analysis.with_scope + //scope.with (//module.with_module 0 module) (//phase#each (|>> product.right product.right)) (//phase.result state) @@ -554,7 +555,7 @@ (|> (do //phase.monad [_ (//module.declare_labels true slots/0 false :record:)] (/.order pattern_matching? input)) - //analysis.with_scope + //scope.with (//module.with_module 0 module) (//phase.result state) (..failure? /.record_size_mismatch))))] @@ -574,7 +575,7 @@ [_ (//module.declare_labels true slots/0 false :record:) _ (//module.declare_labels true slots/1 false :record:)] (/.order pattern_matching? input)) - //analysis.with_scope + //scope.with (//module.with_module 0 module) (//phase.result state) (..failure? /.slot_does_not_belong_to_record))))] @@ -589,7 +590,7 @@ [_ (//module.declare_labels true slots false type)] (/.record ..analysis archive.empty tuple)) (//type.expecting type) - //analysis.with_scope + //scope.with (//module.with_module 0 module) (//phase#each (|>> product.right product.right)) (//phase.result state) @@ -601,7 +602,7 @@ [_ (//module.declare_labels true slots/0 false :record:)] (//type.inferring (/.record ..analysis archive.empty record))) - //analysis.with_scope + //scope.with (//module.with_module 0 module) (//phase#each (|>> product.right product.right)) (//phase.result state) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cli.lux b/stdlib/source/test/lux/tool/compiler/meta/cli.lux index 7c5f0266e..5a128b0ff 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cli.lux @@ -15,12 +15,23 @@ [collection ["[0]" list ("[1]#[0]" monoid monad)]]] [math - ["[0]" random] + ["[0]" random {"+" Random}] [number - ["n" nat]]]]] + ["n" nat]]] + [meta + ["[0]" symbol "_" + ["$[1]" \\test]]]]] [\\library ["[0]" /]]) +(def: random_compiler + (Random /.Compiler) + (do [! random.monad] + [definition ($symbol.random 1 1) + amount (# ! each (n.% 5) random.nat) + parameters (random.list amount (random.ascii/lower 2))] + (in [definition parameters]))) + (def: .public test Test (<| (_.covering /._) @@ -33,10 +44,12 @@ libraries (random.list amount (random.ascii/lower 3)) target (random.ascii/lower 4) module (random.ascii/lower 5) + compilers (random.list amount ..random_compiler) .let [compilation' ($_ list#composite - (list#conjoint (list#each (|>> (list "--source")) sources)) (list#conjoint (list#each (|>> (list "--host_dependency")) host_dependencies)) (list#conjoint (list#each (|>> (list "--library")) libraries)) + (list#conjoint (list#each (|>> /.compiler_format (list "--compiler")) compilers)) + (list#conjoint (list#each (|>> (list "--source")) sources)) (list "--target" target) (list "--module" module)) export ($_ list#composite @@ -58,9 +71,10 @@ false))) (try.else false)))] - [/.Source /.#sources (list#= sources)] [/.Host_Dependency /.#host_dependencies (list#= host_dependencies)] [/.Library /.#libraries (list#= libraries)] + [/.Compiler /.#compilers (# (list.equivalence /.compiler_equivalence) = compilers)] + [/.Source /.#sources (list#= sources)] [/.Target /.#target (same? target)] [/.Module /.#module (same? module)] )) @@ -78,9 +92,10 @@ false))) (try.else false))] - [/.#sources (list#= sources)] [/.#host_dependencies (list#= host_dependencies)] [/.#libraries (list#= libraries)] + [/.#compilers (# (list.equivalence /.compiler_equivalence) = compilers)] + [/.#sources (list#= sources)] [/.#target (same? target)] [/.#module (same? module)] ))))) @@ -104,14 +119,16 @@ (`` (and (~~ (template [] [(same? target (/.target ))] - [{/.#Compilation [/.#sources sources - /.#host_dependencies host_dependencies + [{/.#Compilation [/.#host_dependencies host_dependencies /.#libraries libraries + /.#compilers compilers + /.#sources sources /.#target target /.#module module]}] - [{/.#Interpretation [/.#sources sources - /.#host_dependencies host_dependencies + [{/.#Interpretation [/.#host_dependencies host_dependencies /.#libraries libraries + /.#compilers compilers + /.#sources sources /.#target target /.#module module]}] [{/.#Export [sources target]}] -- cgit v1.2.3