aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
authorEduardo Julian2022-03-04 04:03:55 -0400
committerEduardo Julian2022-03-04 04:03:55 -0400
commitab9dc5fd656ef42dbb0192f96d34e1c7b451a430 (patch)
treef2a39496a1b162acf0a3504f1b4eba61ffdf05d7 /stdlib/source/library
parentd4792368d8e63f9eb883a2cfbe9da5312b2ad557 (diff)
Keeping the JVM interop fixes coming...
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/debug.lux16
-rw-r--r--stdlib/source/library/lux/target/jvm/reflection.lux30
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux14
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux12
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux40
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux68
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux34
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux2
-rw-r--r--stdlib/source/library/lux/world/program.lux1
10 files changed, 124 insertions, 95 deletions
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
["<t>" 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 [<side> <accessor>]
- [{<side> lefts}
- (<accessor> (_.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>]
- [[{/.#Access {<access> [/side.#lefts newL /side.#right? <side>]}}
- {/.#Access {<access> [/side.#lefts oldL /side.#right? <side>]}}]
+ (^template [<access> <side> <lefts> <right?>]
+ [[{/.#Access {<access> [<lefts> newL <right?> <side>]}}
+ {/.#Access {<access> [<lefts> oldL <right?> <side>]}}]
(if (n.= newL oldL)
old
<default>)])
- ([/.#Side #0]
- [/.#Side #1])
+ ([/.#Side #0 /side.#lefts /side.#right?]
+ [/.#Side #1 /side.#lefts /side.#right?]
- (^template [<access> <side>]
- [[{/.#Access {<access> {<side> newL}}}
- {/.#Access {<access> {<side> oldL}}}]
- (if (n.= newL oldL)
- old
- <default>)])
- ([/.#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 @@
<default>)))
(def: (get patterns @selection)
- (-> (///complex.Tuple Pattern) Register (List /.Member))
+ (-> (///complex.Tuple Pattern) Register (List Member))
(loop [lefts 0
patterns patterns]
(with_expansions [<failure> (as_is (list))
<continue> (as_is (again (++ lefts)
tail))
- <member> (as_is (if (list.empty? tail)
- {.#Right (-- lefts)}
- {.#Left lefts}))]
+ <member> (as_is (let [right? (list.empty? tail)]
+ [/member.#lefts (if right?
+ (-- lefts)
+ lefts)
+ /member.#right? right?]))]
(case patterns
{.#End}
<failure>
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 {<tag> [[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 [<side> <name>]
- [(template: .public (<name> lefts)
- [(..side lefts <side>)])]
+(template [<name> <access> <lefts> <right?>]
+ [(template: .public (<name> lefts right?)
+ [(.<| {..#Access}
+ {<access>}
+ [<lefts> lefts
+ <right?> right?])])]
- [#0 side/left]
- [#1 side/right]
+ [side ..#Side /side.#lefts /side.#right?]
+ [member ..#Member /member.#lefts /member.#right?]
)
-(template [<name> <kind> <side>]
- [(template: .public (<name> content)
- [(.<| {..#Access}
- {<kind>}
- {<side>}
- content)])]
+(template [<access> <side> <name>]
+ [(template: .public (<name> lefts)
+ [(<access> lefts <side>)])]
+
+ [..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 [<name> <tag>]
@@ -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 @@
[[{<tag> reference} {<tag> sample}]
(# <equivalence> = reference sample)])
([#Side /side.equivalence]
- [#Member ..member_equivalence])
+ [#Member /member.equivalence])
_
false)))
@@ -459,7 +441,7 @@
[{<tag> value}
(# <hash> 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 <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 {<tag> it}
//.#mandatory? mandatory?]
dependencies]))
- (revised@ #resolver (dictionary.has (<name> it) [id <+resolver>]))
+ (revised@ #resolver (dictionary.has (<name> it) [id (: (Maybe //category.Definition) <+resolver>)]))
:abstraction)]))
(def: .public (<fetch> 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>
@.jvm <jvm>