From ab9dc5fd656ef42dbb0192f96d34e1c7b451a430 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 4 Mar 2022 04:03:55 -0400 Subject: Keeping the JVM interop fixes coming... --- stdlib/source/library/lux/debug.lux | 16 ++--- .../source/library/lux/target/jvm/reflection.lux | 30 ++++++++-- .../language/lux/phase/generation/jvm/case.lux | 14 ++--- .../language/lux/phase/generation/ruby/case.lux | 12 ++-- .../compiler/language/lux/phase/synthesis/case.lux | 40 ++++++------- .../language/lux/phase/synthesis/variable.lux | 2 +- .../lux/tool/compiler/language/lux/synthesis.lux | 68 ++++++++-------------- .../compiler/language/lux/synthesis/member.lux | 34 +++++++++++ .../lux/tool/compiler/meta/archive/registry.lux | 2 +- stdlib/source/library/lux/world/program.lux | 1 + 10 files changed, 124 insertions(+), 95 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 2e4e790fe..6940b2f5e 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -170,7 +170,7 @@ (|> (%.format (%.nat (.nat (ffi.of_long (java/lang/Integer::longValue tag)))) " " (%.bit last?) " " (inspection choice)) - (text.enclosed ["(" ")"]))) + (text.enclosed ["{" "}"]))) _ (tuple_inspection inspection value))) @@ -199,7 +199,7 @@ (|> (%.format (JSON::stringify variant_tag) " " (%.bit (not ("js object null?" variant_flag))) " " (inspection variant_value)) - (text.enclosed ["(" ")"])) + (text.enclosed ["{" "}"])) (not (or ("js object undefined?" ("js object get" "_lux_low" value)) ("js object undefined?" ("js object get" "_lux_high" value)))) @@ -240,7 +240,7 @@ (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (|> variant_flag "python object none?" not %.bit) " " (inspection variant_value)) - (text.enclosed ["(" ")"])))) + (text.enclosed ["{" "}"])))) _ (..str value))) _ @@ -273,7 +273,7 @@ (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("lua object nil?" variant_flag))) " " (inspection variant_value)) - (text.enclosed ["(" ")"])))) + (text.enclosed ["{" "}"])))) _ (..tostring value)) @@ -311,7 +311,7 @@ (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("ruby object nil?" variant_flag))) " " (inspection variant_value)) - (text.enclosed ["(" ")"])))) + (text.enclosed ["{" "}"])))) (same? (class_of [[] []]) value_class) (tuple_inspection inspection value) @@ -341,7 +341,7 @@ (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("php object null?" variant_flag))) " " (inspection variant_value)) - (text.enclosed ["(" ")"])))) + (text.enclosed ["{" "}"])))) _ (..strval value)) @@ -369,7 +369,7 @@ (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("scheme object nil?" variant_flag))) " " (inspection variant_value)) - (text.enclosed ["(" ")"]))) + (text.enclosed ["{" "}"]))) (..format ["~s" value]))) ... else @@ -463,7 +463,7 @@ _ (undefined)))] - (%.format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")")))))) + (%.format "{" (%.nat lefts) " " (%.bit right?) " " sub_repr "}")))))) (def: (tuple_representation representation) (-> (Parser Representation) (Parser Representation)) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index f8cce5214..6d170ac6b 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -6,7 +6,7 @@ [abstract ["[0]" monad {"+" do}]] [control - ["[0]" try {"+" Try}] + ["[0]" try {"+" Try} ("[1]#[0]" functor)] ["[0]" exception {"+" exception:}] [parser ["" text]]] @@ -86,7 +86,9 @@ (getName [] java/lang/String) (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean) (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))]) - (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field)]) + (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field) + (isArray [] boolean) + (getComponentType [] (java/lang/Class java/lang/Object))]) (exception: .public (unknown_class [class External]) (exception.report @@ -147,18 +149,19 @@ {.#Some reflection} (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)] (case (ffi.check java/lang/Class raw) - {.#Some raw} + {.#Some raw'} (let [! try.monad] (|> reflection java/lang/reflect/ParameterizedType::getActualTypeArguments (array.list {.#None}) (monad.each ! parameter) - (# ! each (/.class (|> raw + (# ! each (/.class (|> raw' (:as (java/lang/Class java/lang/Object)) - java/lang/Class::getName))))) + java/lang/Class::getName))) + (exception.with ..cannot_convert_to_a_lux_type [reflection]))) _ - (exception.except ..not_a_class [raw]))) + (exception.except ..not_a_class [reflection]))) _) ... else (exception.except ..cannot_convert_to_a_lux_type [reflection]))) @@ -199,6 +202,15 @@ type (# try.monad each /.array)) _) + (case (ffi.check java/lang/Class reflection) + {.#Some class} + (if (java/lang/Class::isArray class) + (|> class + java/lang/Class::getComponentType + type + (try#each /.array)) + (..class' (parameter type) reflection)) + _) (..class' (parameter type) reflection))) (def: .public (type reflection) @@ -272,6 +284,12 @@ (def: .public (correspond class type) (-> (java/lang/Class java/lang/Object) Type (Try Mapping)) (case type + (^ {.#Primitive (static array.type_name) (list :member:)}) + (if (java/lang/Class::isArray class) + (correspond (java/lang/Class::getComponentType class) + :member:) + (exception.except ..cannot_correspond [class type])) + {.#Primitive name params} (let [class_name (java/lang/Class::getName class) class_params (array.list {.#None} (java/lang/Class::getTypeParameters class)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index da2a15d70..e2e1df881 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -28,8 +28,9 @@ ["[1][0]" value] ["[1][0]" structure] [//// - ["[0]" synthesis {"+" Path Fork Synthesis}] ["[0]" generation] + ["[0]" synthesis {"+" Path Fork Synthesis} + ["[0]" member {"+" Member}]] [/// ["[0]" phase ("operation#[0]" monad)] [reference @@ -294,16 +295,13 @@ body!)))) (def: .public (get phase archive [path recordS]) - (Generator [(List synthesis.Member) Synthesis]) + (Generator [(List Member) Synthesis]) (do phase.monad [record! (phase archive recordS)] (in (list#mix (function (_ step so_far!) - (.let [next! (.case step - {.#Left lefts} - (..left_projection lefts) - - {.#Right lefts} - (..right_projection lefts))] + (.let [next! (.if (value@ member.#right? step) + (..right_projection (value@ member.#lefts step)) + (..left_projection (value@ member.#lefts step)))] ($_ _.composite so_far! next!))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 400e47cfb..f78fb404b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -27,8 +27,9 @@ [synthesis ["[0]" case]] ["/[1]" // "_" - ["[1][0]" synthesis {"+" Member Synthesis Path}] ["[1][0]" generation] + ["[1][0]" synthesis {"+" Synthesis Path} + ["[0]" member {"+" Member}]] ["//[1]" /// "_" [reference ["[1][0]" variable {"+" Register}]] @@ -109,12 +110,9 @@ (do ///////phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) - (.let [method (.case side - (^template [ ] - [{ lefts} - ( (_.int (.int lefts)))]) - ([.#Left //runtime.tuple//left] - [.#Right //runtime.tuple//right]))] + (.let [method (.if (value@ member.#right? side) + (//runtime.tuple//right (_.int (.int (value@ member.#lefts side)))) + (//runtime.tuple//left (_.int (.int (value@ member.#lefts side)))))] (method source))) valueO (list.reversed pathP))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 589de1abc..5441ec92f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -25,7 +25,8 @@ ["[2][0]" complex] ["[2][0]" pattern {"+" Pattern}]] ["/" synthesis {"+" Path Synthesis Operation Phase} - ["[1][0]" side]] + ["[1][0]" side] + ["[1][0]" member {"+" Member}]] [/// ["[1]" phase ("[1]#[0]" monad)] ["[1][0]" reference @@ -83,9 +84,10 @@ _ (let [right? (n.= tuple::last tuple::lefts) end?' (and end? right?)] - (<| (///#each (|>> {/.#Seq {/.#Access {/.#Member (if right? - {.#Right (-- tuple::lefts)} - {.#Left tuple::lefts})}}})) + (<| (///#each (|>> {/.#Seq {/.#Access {/.#Member [/member.#lefts (if right? + (-- tuple::lefts) + tuple::lefts) + /member.#right? right?]}}})) (path' tuple::member end?') (when> [(new> (not end?') [])] [(///#each ..clean_up)]) nextC)))) @@ -174,23 +176,17 @@ [/.#F64_Fork frac.equivalence] [/.#Text_Fork text.equivalence]) - (^template [ ] - [[{/.#Access { [/side.#lefts newL /side.#right? ]}} - {/.#Access { [/side.#lefts oldL /side.#right? ]}}] + (^template [ ] + [[{/.#Access { [ newL ]}} + {/.#Access { [ oldL ]}}] (if (n.= newL oldL) old )]) - ([/.#Side #0] - [/.#Side #1]) + ([/.#Side #0 /side.#lefts /side.#right?] + [/.#Side #1 /side.#lefts /side.#right?] - (^template [ ] - [[{/.#Access { { newL}}} - {/.#Access { { oldL}}}] - (if (n.= newL oldL) - old - )]) - ([/.#Member .#Left] - [/.#Member .#Right]) + [/.#Member #0 /member.#lefts /member.#right?] + [/.#Member #1 /member.#lefts /member.#right?]) [{/.#Bind newR} {/.#Bind oldR}] (if (n.= newR oldR) @@ -201,15 +197,17 @@ ))) (def: (get patterns @selection) - (-> (///complex.Tuple Pattern) Register (List /.Member)) + (-> (///complex.Tuple Pattern) Register (List Member)) (loop [lefts 0 patterns patterns] (with_expansions [ (as_is (list)) (as_is (again (++ lefts) tail)) - (as_is (if (list.empty? tail) - {.#Right (-- lefts)} - {.#Left lefts}))] + (as_is (let [right? (list.empty? tail)] + [/member.#lefts (if right? + (-- lefts) + lefts) + /member.#right? right?]))] (case patterns {.#End} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index beccd504c..ba6f29f89 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -282,7 +282,7 @@ (in [redundancy [else_test else_then]])))) [redundancy elses])] (in [redundancy { [[test then] elses]}]))]) - ([/.#I64_Fork (I64 Any)] + ([/.#I64_Fork I64] [/.#F64_Fork Frac] [/.#Text_Fork Text]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index 409e97353..a5767f301 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -27,6 +27,7 @@ ["[0]" / "_" ["[1][0]" simple {"+" Simple}] ["[1][0]" side {"+" Side}] + ["[1][0]" member {"+" Member}] [// ["[0]" analysis {"+" Environment Analysis} ["[1]/[0]" complex {"+" Complex}]] @@ -56,9 +57,6 @@ [#locals 0 #currying? false]) -(type: .public Member - (Either Nat Nat)) - (type: .public Access (Variant {#Side Side} @@ -73,7 +71,7 @@ {#Bind Register} {#Access Access} {#Bit_Fork Bit (Path' s) (Maybe (Path' s))} - {#I64_Fork (Fork (I64 Any) (Path' s))} + {#I64_Fork (Fork I64 (Path' s))} {#F64_Fork (Fork Frac (Path' s))} {#Text_Fork (Fork Text (Path' s))} {#Seq (Path' s) (Path' s)} @@ -158,29 +156,26 @@ [path/member ..#Member] ) -(template: .public (side lefts right?) - [(.<| {..#Access} - {..#Side} - [/side.#lefts lefts - /side.#right? right?])]) - -(template [ ] - [(template: .public ( lefts) - [(..side lefts )])] +(template [ ] + [(template: .public ( lefts right?) + [(.<| {..#Access} + {} + [ lefts + right?])])] - [#0 side/left] - [#1 side/right] + [side ..#Side /side.#lefts /side.#right?] + [member ..#Member /member.#lefts /member.#right?] ) -(template [ ] - [(template: .public ( content) - [(.<| {..#Access} - {} - {} - content)])] +(template [ ] + [(template: .public ( lefts) + [( lefts )])] + + [..side #0 side/left] + [..side #1 side/right] - [member/left ..#Member .#Left] - [member/right ..#Member .#Right] + [..member #0 member/left] + [..member #1 member/right] ) (template [ ] @@ -313,13 +308,8 @@ {#Side it} (/side.format it) - {#Member member} - (case member - {.#Left lefts} - (format "[" (%.nat lefts) " #0" "]") - - {.#Right lefts} - (format "[" (%.nat lefts) " #1" "]"))) + {#Member it} + (/member.format it)) {#Bind register} (format "(@ " (%.nat register) ")") @@ -426,14 +416,6 @@ (Format Path) (%path' %synthesis)) -(def: member_hash - (Hash Member) - (sum.hash n.hash n.hash)) - -(def: member_equivalence - (Equivalence Member) - (# ..member_hash &equivalence)) - (implementation: .public access_equivalence (Equivalence Access) @@ -443,7 +425,7 @@ [[{ reference} { sample}] (# = reference sample)]) ([#Side /side.equivalence] - [#Member ..member_equivalence]) + [#Member /member.equivalence]) _ false))) @@ -459,7 +441,7 @@ [{ value} (# hash value)]) ([#Side /side.hash] - [#Member ..member_hash])))) + [#Member /member.hash])))) (implementation: .public (path'_equivalence equivalence) (All (_ a) (-> (Equivalence a) (Equivalence (Path' a)))) @@ -481,7 +463,7 @@ (# (list.equivalence (product.equivalence =)) = {.#Item reference_item} {.#Item sample_item})]) - ([#I64_Fork i64.equivalence] + ([#I64_Fork (: (Equivalence I64) i64.equivalence)] [#F64_Fork f.equivalence] [#Text_Fork text.equivalence]) @@ -568,7 +550,7 @@ [{#Get [reference_path reference_record]} {#Get [sample_path sample_record]}] - (and (# (list.equivalence ..member_equivalence) = reference_path sample_path) + (and (# (list.equivalence /member.equivalence) = reference_path sample_path) (#= reference_record sample_record)) [{#Case [reference_input reference_path]} @@ -606,7 +588,7 @@ {#Get [path record]} ($_ n.* 7 - (# (list.hash ..member_hash) hash path) + (# (list.hash /member.hash) hash path) (# super hash record)) {#Case [input path]} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux new file mode 100644 index 000000000..4e1ed910b --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux @@ -0,0 +1,34 @@ +(.using + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]] + [data + ["[0]" product] + ["[0]" bit] + [text + ["%" format]]] + [math + [number + ["[0]" nat]]]]]) + +(type: .public Member + (Record + [#lefts Nat + #right? Bit])) + +(def: .public (format it) + (%.Format Member) + (%.format "[" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "]")) + +(def: .public hash + (Hash Member) + ($_ product.hash + nat.hash + bit.hash + )) + +(def: .public equivalence + (Equivalence Member) + (# ..hash &equivalence)) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux index 02b8e7055..6489b6fb7 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -68,7 +68,7 @@ //.#category { it} //.#mandatory? mandatory?] dependencies])) - (revised@ #resolver (dictionary.has ( it) [id <+resolver>])) + (revised@ #resolver (dictionary.has ( it) [id (: (Maybe //category.Definition) <+resolver>)])) :abstraction)])) (def: .public ( registry) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 2eb9e3f62..95118c399 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -310,6 +310,7 @@ java/util/Map::keySet java/util/Set::iterator ..jvm##consume + (list#each (|>> ffi.of_string)) io.io)] (for [@.old @.jvm -- cgit v1.2.3