From fe0d9fc74740f1b51e2f498d4516579d3e48ed02 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 27 Jan 2022 04:41:30 -0400 Subject: Fixes for the pure-Lux JVM compiler machinery. [Part 11] --- stdlib/source/test/lux/program.lux | 42 +-- stdlib/source/test/lux/target/jvm.lux | 4 +- stdlib/source/test/lux/target/ruby.lux | 146 ++++++--- .../lux/tool/compiler/language/lux/analysis.lux | 2 + .../tool/compiler/language/lux/analysis/module.lux | 341 +++++++++++++++++++++ 5 files changed, 467 insertions(+), 68 deletions(-) create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index 0899dcb64..e78630278 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -1,25 +1,25 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io] - ["[0]" try] - ["<>" parser - ["<[0]>" code] - ["<[0]>" cli]]] - [data - ["[0]" text] - [collection - ["[0]" list]]] - [macro - [syntax {"+" syntax:}]] - [math - ["[0]" random]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" io] + ["[0]" try] + ["<>" parser + ["<[0]>" code] + ["<[0]>" cli]]] + [data + ["[0]" text] + [collection + ["[0]" list]]] + [macro + [syntax {"+" syntax:}]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]]) (syntax: (actual_program [actual_program (<| .form (<>.after (.text! "lux def program")) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 616f3f1f5..b6762f168 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -857,8 +857,8 @@ {.#None} (/name.internal "java.lang.Object") (list) - (list (/field.field /field.static class_field /type.long (sequence.sequence)) - (/field.field /field.public object_field /type.long (sequence.sequence))) + (list (/field.field /field.static class_field /type.long false (sequence.sequence)) + (/field.field /field.public object_field /type.long false (sequence.sequence))) (list (/method.method /method.private constructor constructor::type diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 5a52dc1b8..281ffe594 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -234,6 +234,8 @@ items (random.list size random.safe_frac) $class (# ! each (|>> %.nat (format "class_") /.local) random.nat) + $sub_class (# ! each (|>> %.nat (format "sub_class_") /.local) + random.nat) $method/0 (# ! each (|>> %.nat (format "method_") /.local) random.nat) $method/1 (|> random.nat @@ -296,6 +298,32 @@ (/.do (/.code $method/1) (list (/.float single)) {.#None})))) [(list)] (/.lambda {.#None}) (/.apply_lambda/* (list))))) + (_.for [/.module] + ($_ _.and + (_.cover [/.include/1] + (expression (|>> (:as Frac) (f.= (f.+ single single))) + (|> ($_ /.then + (/.set (list $class) (/.module [/.#parameters (list) + /.#body double])) + (/.set (list $sub_class) (/.class [/.#parameters (list) + /.#body (/.statement (/.include/1 $class))])) + (/.return (|> $sub_class + (/.new (list) {.#None}) + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.extend/1] + (expression (|>> (:as Frac) (f.= (f.+ single single))) + (|> ($_ /.then + (/.set (list $class) (/.module [/.#parameters (list) + /.#body double])) + (/.set (list $sub_class) (/.class [/.#parameters (list) + /.#body (/.statement (/.extend/1 $class))])) + (/.return (|> $sub_class + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + )) ))) (def: test|io @@ -305,34 +333,67 @@ right (random.ascii/upper 5) $old (# ! each /.local (random.ascii/upper 1)) $new (# ! each /.local (random.ascii/upper 2)) + $it (# ! each /.local (random.ascii/upper 3)) .let [expected (format left right)]]) - (_.for [/.stdout]) ($_ _.and - (_.cover [/.print/1] - (expression (|>> (:as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdout) - (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) - (/.set (list /.stdout) $new) - (/.statement (/.print/1 (/.string left))) - (/.statement (/.print/1 (/.string right))) - (/.set (list /.stdout) $old) - (/.return (/.the "string" $new))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.print/2] - (expression (|>> (:as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdout) - (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) - (/.set (list /.stdout) $new) - (/.statement (/.print/2 (/.string left) (/.string right))) - (/.set (list /.stdout) $old) - (/.return (/.the "string" $new))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) + (_.for [/.stdout] + ($_ _.and + (_.cover [/.print/1] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/1 (/.string left))) + (/.statement (/.print/1 (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.print/2] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/2 (/.string left) (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + )) + (_.for [/.stdin] + ($_ _.and + (_.cover [/.gets/0] + (expression (|>> (:as Text) (text#= (format left text.\n))) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdin) + (/.set (list /.stdin) (/.new (list (/.string (format left text.\n))) {.#None} + (/.manual "StringIO"))) + (/.set (list $it) /.gets/0) + (/.set (list /.stdin) $old) + (/.return $it)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_string_read] + (expression (|>> (:as Text) (text#= (format right text.\n))) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdin) + (/.set (list /.stdin) (/.new (list (/.string (format right text.\n))) {.#None} + (/.manual "StringIO"))) + (/.set (list $it) /.gets/0) + (/.set (list /.stdin) $old) + (/.return /.last_string_read)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_line_number_read] + (expression (|>> (:as Nat) (n.= 2)) + /.last_line_number_read)) + )) ))) (def: test|computation @@ -367,18 +428,6 @@ (/.float then)))) ))) -(def: test|expression - Test - (do [! random.monad] - [dummy random.safe_frac - expected random.safe_frac] - (`` ($_ _.and - (_.for [/.Literal] - ..test|literal) - (_.for [/.Computation] - ..test|computation) - )))) - (def: test|global Test (do [! random.monad] @@ -397,11 +446,6 @@ (|>> (:as Text) (text.ends_with? file))) /.script_name)) - (_.cover [/.script_name] - (expression (let [file (format (# file.default separator) packager.main_file)] - (|>> (:as Text) - (text.ends_with? file))) - /.script_name)) (_.cover [/.input_record_separator] (expression (|>> (:as Text) (text#= text.\n)) @@ -635,6 +679,20 @@ )) ))) +(def: test|expression + Test + (do [! random.monad] + [dummy random.safe_frac + expected random.safe_frac] + (`` ($_ _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + (_.for [/.Location] + ..test|location) + )))) + (def: test|label Test (do [! random.monad] @@ -948,8 +1006,6 @@ ..test|loop (_.for [/.Block] ..test|function) - (_.for [/.Location] - ..test|location) ))) (def: random_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 f19111e2d..8f6a7b381 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -29,6 +29,7 @@ ["[1][0]" pattern] ["[1][0]" macro] ["[1][0]" type] + ["[1][0]" module] [//// ["[1][0]" reference ["[2][0]" variable]] @@ -440,4 +441,5 @@ /pattern.test /macro.test /type.test + /module.test )))) 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 new file mode 100644 index 000000000..ab07c98b3 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux @@ -0,0 +1,341 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" meta] + [abstract + ["[0]" monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + ["/[1]" // + [// + [phase + ["[2][0]" extension]] + [/// + ["[2][0]" phase]]]]]]) + +(def: random_state + (Random Lux) + (do random.monad + [version random.nat + host (random.ascii/lower 1)] + (in (//.state (//.info version host))))) + +(def: primitive + (Random Type) + (do random.monad + [name (random.ascii/lower 1)] + (in {.#Primitive name (list)}))) + +(def: (new? hash it) + (-> Nat .Module Bit) + (and (same? hash (value@ .#module_hash it)) + (list.empty? (value@ .#module_aliases it)) + (list.empty? (value@ .#definitions it)) + (list.empty? (value@ .#imports it)) + (case (value@ .#module_state it) + {.#Active} + true + + _ + false))) + +(def: test|module + Test + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + name (random.ascii/lower 1) + hash random.nat + expected_import (random.ascii/lower 2) + expected_alias (random.ascii/lower 3)] + ($_ _.and + (_.cover [/.empty] + (..new? hash (/.empty hash))) + (_.cover [/.create] + (|> (do /phase.monad + [_ (/.create hash name)] + (/extension.lifted (meta.module name))) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.exists?] + (|> (do /phase.monad + [pre (/.exists? name) + _ (/.create hash name) + post (/.exists? name)] + (in (and (not pre) post))) + (/phase.result state) + (try.else false))) + (_.cover [/.with_module] + (|> (do /phase.monad + [[it _] (/.with_module hash name + (in []))] + (in it)) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.import] + (`` (and (~~ (template [] + [(|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it ?] (/.with_module hash name + (do ! + [_ (if + (/.import expected_import) + (in []))] + (/extension.lifted + (meta.imported? expected_import))))] + (in ?)) + (/phase.result state) + (try#each (bit#= )) + (try.else false))] + + [false] + [true]))))) + (_.cover [/.alias] + (|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it _] (/.with_module hash name + (do ! + [_ (/.import expected_import)] + (/.alias expected_alias expected_import)))] + (in it)) + (/phase.result state) + (try#each (|>> (value@ .#module_aliases) + (case> (^ (list [actual_alias actual_import])) + (and (same? expected_alias actual_alias) + (same? expected_import actual_import)) + + _ + false))) + (try.else false))) + ))) + +(def: test|state + Test + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + name (random.ascii/lower 1) + hash random.nat] + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [ ] + (|> (do [! /phase.monad] + [[it ?] (/.with_module hash name + (do ! + [_ ( name) + ? ( name) + ~0 ( name) + ~1 ( name)] + (in (and ? (not ~0) (not ~1)))))] + (in ?)) + (/phase.result state) + (try.else false)))] + + [/.set_active /.active? /.compiled? /.cached?] + [/.set_compiled /.compiled? /.cached? /.active?] + [/.set_cached /.cached? /.active? /.compiled?] + )) + (_.cover [/.can_only_change_state_of_active_module] + (and (~~ (template [
 ]
+                                [(|> (/.with_module hash name
+                                       (do /phase.monad
+                                         [_ (
 name)]
+                                         ( name)))
+                                     (/phase.result state)
+                                     (case> {try.#Success _}
+                                            false
+                                            
+                                            {try.#Failure error}
+                                            (text.contains? (value@ exception.#label /.can_only_change_state_of_active_module) error)))]
+
+                                [/.set_compiled /.set_active]
+                                [/.set_compiled /.set_compiled]
+                                [/.set_compiled /.set_cached]
+                                [/.set_cached /.set_active]
+                                [/.set_cached /.set_compiled]
+                                [/.set_cached /.set_cached]
+                                ))))
+            (_.cover [/.unknown_module]
+                     (and (~~ (template []
+                                [(|> ( name)
+                                     (/phase.result state)
+                                     (case> {try.#Success _}
+                                            false
+                                            
+                                            {try.#Failure error}
+                                            (text.contains? (value@ exception.#label /.unknown_module) error)))]
+
+                                [/.set_active]
+                                [/.set_compiled]
+                                [/.set_cached]
+                                ))))
+            ))))
+
+(def: test|definition
+  Test
+  (do [! random.monad]
+    [lux ..random_state
+     .let [state [/extension.#bundle /extension.empty
+                  /extension.#state lux]]
+     module_name (random.ascii/lower 1)
+     hash random.nat
+     def_name (random.ascii/lower 2)
+     alias_name (random.ascii/lower 3)
+
+     public? random.bit
+     def_type ..primitive
+     arity (# ! each (|>> (n.% 10) ++) random.nat)
+     labels|head (random.ascii/lower 1)
+     labels|tail (|> (random.ascii/lower 1)
+                     (random.only (|>> (text#= labels|head) not))
+                     (random.set text.hash (-- arity))
+                     (# ! each set.list))
+     index (# ! each (n.% arity) random.nat)
+     .let [definition {.#Definition [public? def_type []]}
+           alias {.#Alias [module_name def_name]}]]
+    ($_ _.and
+        (_.cover [/.define]
+                 (`` (and (~~ (template []
+                                [(|> (/.with_module hash module_name
+                                       (/.define def_name ))
+                                     (/phase.result state)
+                                     (case> {try.#Success _} true
+                                            {try.#Failure _} false))]
+
+                                [definition]
+                                [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}]
+                                [{.#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
+                                (do /phase.monad
+                                  [_ (/.define def_name definition)]
+                                  (/.define alias_name alias)))
+                              (/phase.result state)
+                              (case> {try.#Success _} true
+                                     {try.#Failure _} false)))))
+        (_.cover [/.cannot_define_more_than_once]
+                 (`` (and (~~ (template []
+                                [(|> (/.with_module hash module_name
+                                       (do /phase.monad
+                                         [_ (/.define def_name )]
+                                         (/.define def_name )))
+                                     (/phase.result state)
+                                     (case> {try.#Success _} false
+                                            {try.#Failure _} true))]
+
+                                [{.#Definition [public? def_type []]}]
+                                [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}]
+                                [{.#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
+                                (do /phase.monad
+                                  [_ (/.define def_name definition)
+                                   _ (/.define alias_name alias)]
+                                  (/.define alias_name alias)))
+                              (/phase.result state)
+                              (case> {try.#Success _} false
+                                     {try.#Failure _} true)))))
+        )))
+
+(def: test|label
+  Test
+  (do [! random.monad]
+    [lux ..random_state
+     .let [state [/extension.#bundle /extension.empty
+                  /extension.#state lux]]
+     module_name (random.ascii/lower 1)
+     hash random.nat
+     def_name (random.ascii/lower 2)
+     foreign_module (random.ascii/lower 3)
+
+     public? random.bit
+     def_type ..primitive
+     arity (# ! each (|>> (n.% 10) ++) random.nat)
+     labels|head (random.ascii/lower 1)
+     labels|tail (|> (random.ascii/lower 1)
+                     (random.only (|>> (text#= labels|head) not))
+                     (random.set text.hash (-- arity))
+                     (# ! each set.list))]
+    ($_ _.and
+        (_.cover [/.declare_labels]
+                 (`` (and (~~ (template [   ]
+                                [(|> (/.with_module 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]}]})
+                                          _ (/.declare_labels  (list& labels|head labels|tail) public? it)]
+                                         (monad.each ! (|>> [module_name]  /extension.lifted)
+                                                     (list& labels|head labels|tail))))
+                                     (/phase.result state)
+                                     (case> {try.#Success _} 
+                                            {try.#Failure _} (not )))]
+
+                                [.#Left false meta.tag true]
+                                [.#Left false meta.slot false]
+                                [.#Right true meta.slot true]
+                                [.#Right true meta.tag false])))))
+        (_.cover [/.cannot_declare_labels_for_anonymous_type]
+                 (`` (and (~~ (template [ ]
+                                [(|> (/.with_module hash module_name
+                                       (do [! /phase.monad]
+                                         [.let [it def_type]
+                                          _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})]
+                                         (/.declare_labels  (list& labels|head labels|tail) public? it)))
+                                     (/phase.result state)
+                                     (case> {try.#Success _}
+                                            false
+                                            
+                                            {try.#Failure error}
+                                            (text.contains? (value@ exception.#label /.cannot_declare_labels_for_anonymous_type) error)))]
+
+                                [.#Left false]
+                                [.#Right true])))))
+        (_.cover [/.cannot_declare_labels_for_foreign_type]
+                 (`` (and (~~ (template [ ]
+                                [(|> (/.with_module 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]}]})]
+                                         (/.declare_labels  (list& labels|head labels|tail) public? it)))
+                                     (/phase.result state)
+                                     (case> {try.#Success _}
+                                            false
+                                            
+                                            {try.#Failure error}
+                                            (text.contains? (value@ exception.#label /.cannot_declare_labels_for_foreign_type) error)))]
+
+                                [.#Left false]
+                                [.#Right true])))))
+        )))
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      ($_ _.and
+          ..test|module
+          ..test|state
+          ..test|definition
+          (_.for [/.Label]
+                 ..test|label)
+          )))
-- 
cgit v1.2.3