aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux168
-rw-r--r--stdlib/source/lux/data/collection/array.lux101
-rw-r--r--stdlib/source/lux/host/jvm/loader.old.lux (renamed from stdlib/source/lux/host/jvm/loader.jvm.lux)0
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux184
4 files changed, 255 insertions, 198 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index 45e025d0b..2e39860fc 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -61,60 +61,60 @@
<conversion>
(_.wrap <wrap>))))]
- [convert::double-to-float #$.Double _.D2F #$.Float]
- [convert::double-to-int #$.Double _.D2I #$.Int]
- [convert::double-to-long #$.Double _.D2L #$.Long]
- [convert::float-to-double #$.Float _.F2D #$.Double]
- [convert::float-to-int #$.Float _.F2I #$.Int]
- [convert::float-to-long #$.Float _.F2L #$.Long]
- [convert::int-to-byte #$.Int _.I2B #$.Byte]
- [convert::int-to-char #$.Int _.I2C #$.Char]
- [convert::int-to-double #$.Int _.I2D #$.Double]
- [convert::int-to-float #$.Int _.I2F #$.Float]
- [convert::int-to-long #$.Int _.I2L #$.Long]
- [convert::int-to-short #$.Int _.I2S #$.Short]
- [convert::long-to-double #$.Long _.L2D #$.Double]
- [convert::long-to-float #$.Long _.L2F #$.Float]
- [convert::long-to-int #$.Long _.L2I #$.Int]
- [convert::long-to-short #$.Long L2S #$.Short]
- [convert::long-to-byte #$.Long L2B #$.Byte]
- [convert::long-to-char #$.Long L2C #$.Char]
- [convert::char-to-byte #$.Char _.I2B #$.Byte]
- [convert::char-to-short #$.Char _.I2S #$.Short]
- [convert::char-to-int #$.Char _.NOP #$.Int]
- [convert::char-to-long #$.Char _.I2L #$.Long]
- [convert::byte-to-long #$.Byte _.I2L #$.Long]
- [convert::short-to-long #$.Short _.I2L #$.Long]
+ [conversion::double-to-float #$.Double _.D2F #$.Float]
+ [conversion::double-to-int #$.Double _.D2I #$.Int]
+ [conversion::double-to-long #$.Double _.D2L #$.Long]
+ [conversion::float-to-double #$.Float _.F2D #$.Double]
+ [conversion::float-to-int #$.Float _.F2I #$.Int]
+ [conversion::float-to-long #$.Float _.F2L #$.Long]
+ [conversion::int-to-byte #$.Int _.I2B #$.Byte]
+ [conversion::int-to-char #$.Int _.I2C #$.Char]
+ [conversion::int-to-double #$.Int _.I2D #$.Double]
+ [conversion::int-to-float #$.Int _.I2F #$.Float]
+ [conversion::int-to-long #$.Int _.I2L #$.Long]
+ [conversion::int-to-short #$.Int _.I2S #$.Short]
+ [conversion::long-to-double #$.Long _.L2D #$.Double]
+ [conversion::long-to-float #$.Long _.L2F #$.Float]
+ [conversion::long-to-int #$.Long _.L2I #$.Int]
+ [conversion::long-to-short #$.Long L2S #$.Short]
+ [conversion::long-to-byte #$.Long L2B #$.Byte]
+ [conversion::long-to-char #$.Long L2C #$.Char]
+ [conversion::char-to-byte #$.Char _.I2B #$.Byte]
+ [conversion::char-to-short #$.Char _.I2S #$.Short]
+ [conversion::char-to-int #$.Char _.NOP #$.Int]
+ [conversion::char-to-long #$.Char _.I2L #$.Long]
+ [conversion::byte-to-long #$.Byte _.I2L #$.Long]
+ [conversion::short-to-long #$.Short _.I2L #$.Long]
)
(def: conversion
Bundle
- (<| (bundle.prefix "convert")
+ (<| (bundle.prefix "conversion")
(|> (: Bundle bundle.empty)
- (bundle.install "double-to-float" (unary convert::double-to-float))
- (bundle.install "double-to-int" (unary convert::double-to-int))
- (bundle.install "double-to-long" (unary convert::double-to-long))
- (bundle.install "float-to-double" (unary convert::float-to-double))
- (bundle.install "float-to-int" (unary convert::float-to-int))
- (bundle.install "float-to-long" (unary convert::float-to-long))
- (bundle.install "int-to-byte" (unary convert::int-to-byte))
- (bundle.install "int-to-char" (unary convert::int-to-char))
- (bundle.install "int-to-double" (unary convert::int-to-double))
- (bundle.install "int-to-float" (unary convert::int-to-float))
- (bundle.install "int-to-long" (unary convert::int-to-long))
- (bundle.install "int-to-short" (unary convert::int-to-short))
- (bundle.install "long-to-double" (unary convert::long-to-double))
- (bundle.install "long-to-float" (unary convert::long-to-float))
- (bundle.install "long-to-int" (unary convert::long-to-int))
- (bundle.install "long-to-short" (unary convert::long-to-short))
- (bundle.install "long-to-byte" (unary convert::long-to-byte))
- (bundle.install "long-to-char" (unary convert::long-to-char))
- (bundle.install "char-to-byte" (unary convert::char-to-byte))
- (bundle.install "char-to-short" (unary convert::char-to-short))
- (bundle.install "char-to-int" (unary convert::char-to-int))
- (bundle.install "char-to-long" (unary convert::char-to-long))
- (bundle.install "byte-to-long" (unary convert::byte-to-long))
- (bundle.install "short-to-long" (unary convert::short-to-long))
+ (bundle.install "double-to-float" (unary conversion::double-to-float))
+ (bundle.install "double-to-int" (unary conversion::double-to-int))
+ (bundle.install "double-to-long" (unary conversion::double-to-long))
+ (bundle.install "float-to-double" (unary conversion::float-to-double))
+ (bundle.install "float-to-int" (unary conversion::float-to-int))
+ (bundle.install "float-to-long" (unary conversion::float-to-long))
+ (bundle.install "int-to-byte" (unary conversion::int-to-byte))
+ (bundle.install "int-to-char" (unary conversion::int-to-char))
+ (bundle.install "int-to-double" (unary conversion::int-to-double))
+ (bundle.install "int-to-float" (unary conversion::int-to-float))
+ (bundle.install "int-to-long" (unary conversion::int-to-long))
+ (bundle.install "int-to-short" (unary conversion::int-to-short))
+ (bundle.install "long-to-double" (unary conversion::long-to-double))
+ (bundle.install "long-to-float" (unary conversion::long-to-float))
+ (bundle.install "long-to-int" (unary conversion::long-to-int))
+ (bundle.install "long-to-short" (unary conversion::long-to-short))
+ (bundle.install "long-to-byte" (unary conversion::long-to-byte))
+ (bundle.install "long-to-char" (unary conversion::long-to-char))
+ (bundle.install "char-to-byte" (unary conversion::char-to-byte))
+ (bundle.install "char-to-short" (unary conversion::char-to-short))
+ (bundle.install "char-to-int" (unary conversion::char-to-int))
+ (bundle.install "char-to-long" (unary conversion::char-to-long))
+ (bundle.install "byte-to-long" (unary conversion::byte-to-long))
+ (bundle.install "short-to-long" (unary conversion::short-to-long))
)))
(template [<name> <op> <unwrapX> <unwrapY> <wrap>]
@@ -284,37 +284,49 @@
(bundle.install "<" (binary char::<))
)))
-(def: (array::length arrayD arrayI)
- (Binary Inst)
- (|>> arrayI
- (_.CHECKCAST arrayD)
- _.ARRAYLENGTH
- _.I2L
- (_.wrap #$.Long)))
+(def: (array-java-type nesting elem-class)
+ (-> Nat Text $.Type)
+ (_t.array nesting
+ (case elem-class
+ "boolean" _t.boolean
+ "byte" _t.byte
+ "short" _t.short
+ "int" _t.int
+ "long" _t.long
+ "float" _t.float
+ "double" _t.double
+ "char" _t.char
+ _ (_t.class elem-class (list)))))
+
+(def: (array::length proc generate inputs)
+ Handler
+ (case inputs
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
+ arrayS))
+ (do phase.monad
+ [arrayI (generate arrayS)]
+ (wrap (|>> arrayI
+ (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
+ _.ARRAYLENGTH
+ _.I2L
+ (_.wrap #$.Long))))
+
+ _
+ (phase.throw extension.invalid-syntax [proc %synthesis inputs])))
(def: (array::new proc generate inputs)
Handler
(case inputs
- (^ (list (synthesis.i64 level)
- (synthesis.text class)
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
lengthS))
(do phase.monad
- [lengthI (generate lengthS)
- #let [arrayJT (_t.array (.nat level)
- (case class
- "boolean" _t.boolean
- "byte" _t.byte
- "short" _t.short
- "int" _t.int
- "long" _t.long
- "float" _t.float
- "double" _t.double
- "char" _t.char
- _ (_t.class class (list))))]]
+ [lengthI (generate lengthS)]
(wrap (|>> lengthI
(_.unwrap #$.Long)
_.L2I
- (_.array arrayJT))))
+ (_.array (array-java-type (.nat nesting) elem-class)))))
_
(phase.throw extension.invalid-syntax [proc %synthesis inputs])))
@@ -322,13 +334,14 @@
(def: (array::read proc generate inputs)
Handler
(case inputs
- (^ (list (synthesis.text class)
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
idxS
arrayS))
(do phase.monad
[arrayI (generate arrayS)
idxI (generate idxS)
- #let [loadI (case class
+ #let [loadI (case elem-class
"boolean" (|>> _.BALOAD (_.wrap #$.Boolean))
"byte" (|>> _.BALOAD (_.wrap #$.Byte))
"short" (|>> _.SALOAD (_.wrap #$.Short))
@@ -339,6 +352,7 @@
"char" (|>> _.CALOAD (_.wrap #$.Char))
_ _.AALOAD)]]
(wrap (|>> arrayI
+ (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
idxI
(_.unwrap #$.Long)
_.L2I
@@ -350,7 +364,8 @@
(def: (array::write proc generate inputs)
Handler
(case inputs
- (^ (list (synthesis.text class)
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
idxS
valueS
arrayS))
@@ -358,7 +373,7 @@
[arrayI (generate arrayS)
idxI (generate idxS)
valueI (generate valueS)
- #let [storeI (case class
+ #let [storeI (case elem-class
"boolean" (|>> (_.unwrap #$.Boolean) _.BASTORE)
"byte" (|>> (_.unwrap #$.Byte) _.BASTORE)
"short" (|>> (_.unwrap #$.Short) _.SASTORE)
@@ -369,6 +384,7 @@
"char" (|>> (_.unwrap #$.Char) _.CASTORE)
_ _.AASTORE)]]
(wrap (|>> arrayI
+ (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
_.DUP
idxI
(_.unwrap #$.Long)
@@ -383,7 +399,7 @@
Bundle
(<| (bundle.prefix "array")
(|> (: Bundle bundle.empty)
- (bundle.install "length" (unary array::length))
+ (bundle.install "length" array::length)
(bundle.install "new" array::new)
(bundle.install "read" array::read)
(bundle.install "write" array::write)
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 04b215cf8..4cb89c71b 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -21,42 +21,75 @@
{#.doc "Mutable arrays."}
(#.Primitive ..type-name (#.Cons a #.Nil)))
-(def: #export (new size)
- (All [a] (-> Nat (Array a)))
- (`` (for {(~~ (static host.old))
- (:assume ("jvm anewarray" "(java.lang.Object )" size))})))
+(with-expansions [<elem-type> (primitive "java.lang.Object")
+ <array-type> (type (Array <elem-type>))]
+ (def: #export (new size)
+ (All [a] (-> Nat (Array a)))
+ (`` (for {(~~ (static host.old))
+ (:assume ("jvm anewarray" "(java.lang.Object )" size))
-(def: #export (size xs)
- (All [a] (-> (Array a) Nat))
- (`` (for {(~~ (static host.old))
- ("jvm arraylength" xs)})))
+ (~~ (static host.jvm))
+ (:assume
+ (: (Array (primitive "java.lang.Object"))
+ ("jvm array new" size)))})))
-(def: #export (read i xs)
- (All [a]
- (-> Nat (Array a) (Maybe a)))
- (if (n/< (size xs) i)
+ (def: #export (size array)
+ (All [a] (-> (Array a) Nat))
(`` (for {(~~ (static host.old))
- (let [value ("jvm aaload" xs i)]
- (if ("jvm object null?" value)
- #.None
- (#.Some value)))}))
- #.None))
+ ("jvm arraylength" array)
+
+ (~~ (static host.jvm))
+ ("jvm array length" (:coerce <array-type> array))})))
+
+ (def: #export (read index array)
+ (All [a]
+ (-> Nat (Array a) (Maybe a)))
+ (if (n/< (size array) index)
+ (`` (for {(~~ (static host.old))
+ (let [value ("jvm aaload" array index)]
+ (if ("jvm object null?" value)
+ #.None
+ (#.Some value)))
+
+ (~~ (static host.jvm))
+ (let [value ("jvm array read" index (:coerce <array-type> array))]
+ (if ("jvm object null?" value)
+ #.None
+ (#.Some (:assume value))))}))
+ #.None))
+
+ (def: #export (write index value array)
+ (All [a]
+ (-> Nat a (Array a) (Array a)))
+ (`` (for {(~~ (static host.old))
+ ("jvm aastore" array index value)
+
+ (~~ (static host.jvm))
+ (:assume
+ ("jvm array write" index (:coerce <elem-type> value)
+ (:coerce <array-type> array)))})))
+
+ (def: #export (delete index array)
+ (All [a]
+ (-> Nat (Array a) (Array a)))
+ (if (n/< (size array) index)
+ (`` (for {(~~ (static host.old))
+ (write index (:assume ("jvm object null")) array)
+
+ (~~ (static host.jvm))
+ (write index (:assume (: <elem-type> ("jvm object null"))) array)}))
+ array))
+ )
(def: #export (contains? index array)
(All [a]
(-> Nat (Array a) Bit))
(case (..read index array)
(#.Some _)
- #1
+ true
_
- #0))
-
-(def: #export (write i x xs)
- (All [a]
- (-> Nat a (Array a) (Array a)))
- (`` (for {(~~ (static host.old))
- ("jvm aastore" xs i x)})))
+ false))
(def: #export (update index transform array)
(All [a]
@@ -75,14 +108,6 @@
(|> array (read index) (maybe.default default) transform)
array))
-(def: #export (delete i xs)
- (All [a]
- (-> Nat (Array a) (Array a)))
- (if (n/< (size xs) i)
- (`` (for {(~~ (static host.old))
- (write i (:assume ("jvm object null")) xs)}))
- xs))
-
(def: #export (copy length src-start src-array dest-start dest-array)
(All [a]
(-> Nat Nat (Array a) Nat (Array a)
@@ -221,14 +246,14 @@
(and prev
(case [(read idx xs) (read idx ys)]
[#.None #.None]
- #1
+ true
[(#.Some x) (#.Some y)]
(,@= x y)
_
- #0)))
- #1
+ false)))
+ true
(list.indices sxs))))))
(structure: #export monoid (All [a] (Monoid (Array a)))
@@ -287,6 +312,6 @@
(recur (inc idx)))
<init>))))]
- [every? #1 and]
- [any? #0 or]
+ [every? true and]
+ [any? false or]
)
diff --git a/stdlib/source/lux/host/jvm/loader.jvm.lux b/stdlib/source/lux/host/jvm/loader.old.lux
index 0ca92fa23..0ca92fa23 100644
--- a/stdlib/source/lux/host/jvm/loader.jvm.lux
+++ b/stdlib/source/lux/host/jvm/loader.old.lux
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux
index 13762272e..fe9a63f09 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux
@@ -19,7 +19,7 @@
["." type
["." check]]
["." macro
- ["s" syntax]]
+ ["s" syntax (#+ Syntax)]]
["." host (#+ import:)]]
["." // #_
["#." common]
@@ -30,7 +30,8 @@
[".A" type]
[".A" inference]]
["#/" // #_
- ["#." analysis (#+ Analysis Operation Handler Bundle)]]]]])
+ ["#." analysis (#+ Analysis Operation Handler Bundle)]
+ ["#." synthesis]]]]])
(type: Method-Signature
{#method Type
@@ -73,7 +74,6 @@
[unknown-class]
[primitives-cannot-have-type-parameters]
[primitives-are-not-objects]
- [invalid-type-for-array-element]
[unknown-field]
[mistaken-field-owner]
@@ -131,7 +131,7 @@
(def: bundle::conversion
Bundle
- (<| (///bundle.prefix "convert")
+ (<| (///bundle.prefix "conversion")
(|> ///bundle.empty
(///bundle.install "double-to-float" (//common.unary Double Float))
(///bundle.install "double-to-int" (//common.unary Double Integer))
@@ -220,6 +220,33 @@
["char" "java.lang.Character"])
(dictionary.from-list text.hash)))
+(def: (array-type-info arrayT)
+ (-> Type (Operation [Nat Text]))
+ (loop [level 0
+ currentT arrayT]
+ (case currentT
+ (#.Apply inputT abstractionT)
+ (case (type.apply (list inputT) abstractionT)
+ (#.Some outputT)
+ (recur level outputT)
+
+ #.None
+ (/////analysis.throw non-array arrayT))
+
+ (^ (#.Primitive (static array.type-name) (list elemT)))
+ (recur (inc level) elemT)
+
+ (#.Primitive class #.Nil)
+ (////@wrap [level class])
+
+ (#.Primitive class _)
+ (if (dictionary.contains? class boxes)
+ (/////analysis.throw primitives-cannot-have-type-parameters class)
+ (////@wrap [level class]))
+
+ _
+ (/////analysis.throw non-array arrayT))))
+
(def: array::length
Handler
(function (_ extension-name analyse args)
@@ -229,8 +256,12 @@
[_ (typeA.infer Nat)
[var-id varT] (typeA.with-env check.var)
arrayA (typeA.with-type (type (Array varT))
- (analyse arrayC))]
- (wrap (#/////analysis.Extension extension-name (list arrayA))))
+ (analyse arrayC))
+ varT (typeA.with-env (check.clean varT))
+ [array-nesting elem-class] (array-type-info (type (Array varT)))]
+ (wrap (#/////analysis.Extension extension-name (list (/////analysis.nat array-nesting)
+ (/////analysis.text elem-class)
+ arrayA))))
_
(/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
@@ -244,26 +275,7 @@
[lengthA (typeA.with-type Nat
(analyse lengthC))
expectedT (///.lift macro.expected-type)
- [level elem-class] (: (Operation [Nat Text])
- (loop [analysisT expectedT
- level 0]
- (case analysisT
- (#.Apply inputT funcT)
- (case (type.apply (list inputT) funcT)
- (#.Some outputT)
- (recur outputT level)
-
- #.None
- (/////analysis.throw non-array expectedT))
-
- (^ (#.Primitive "#Array" (list elemT)))
- (recur elemT (inc level))
-
- (#.Primitive class _)
- (wrap [level class])
-
- _
- (/////analysis.throw non-array expectedT))))
+ [level elem-class] (array-type-info expectedT)
_ (if (n/> 0 level)
(wrap [])
(/////analysis.throw non-array expectedT))]
@@ -292,8 +304,8 @@
([#.UnivQ]
[#.ExQ])
- (#.Apply inputT funcT)
- (case (type.apply (list inputT) funcT)
+ (#.Apply inputT abstractionT)
+ (case (type.apply (list inputT) abstractionT)
(#.Some outputT)
(check-jvm outputT)
@@ -311,39 +323,25 @@
(/////analysis.throw primitives-are-not-objects name)
(////@wrap name))))
-(def: (box-array-element-type elemT)
- (-> Type (Operation [Type Text]))
- (case elemT
- (#.Primitive name #.Nil)
- (let [boxed-name (|> (dictionary.get name boxes)
- (maybe.default name))]
- (////@wrap [(#.Primitive boxed-name #.Nil)
- boxed-name]))
-
- (#.Primitive name _)
- (if (dictionary.contains? name boxes)
- (/////analysis.throw primitives-cannot-have-type-parameters name)
- (////@wrap [elemT name]))
-
- _
- (/////analysis.throw invalid-type-for-array-element (%type elemT))))
-
(def: array::read
Handler
(function (_ extension-name analyse args)
(case args
- (^ (list arrayC idxC))
+ (^ (list idxC arrayC))
(do ////.monad
[[var-id varT] (typeA.with-env check.var)
_ (typeA.infer varT)
arrayA (typeA.with-type (type (Array varT))
(analyse arrayC))
- ?elemT (typeA.with-env
- (check.read var-id))
- [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+ varT (typeA.with-env
+ (check.clean varT))
+ [nesting elem-class] (array-type-info varT)
idxA (typeA.with-type Nat
(analyse idxC))]
- (wrap (#/////analysis.Extension extension-name (list (/////analysis.text elem-class) idxA arrayA))))
+ (wrap (#/////analysis.Extension extension-name (list (/////analysis.nat (inc nesting))
+ (/////analysis.text elem-class)
+ idxA
+ arrayA))))
_
(/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
@@ -352,20 +350,24 @@
Handler
(function (_ extension-name analyse args)
(case args
- (^ (list arrayC idxC valueC))
+ (^ (list idxC valueC arrayC))
(do ////.monad
[[var-id varT] (typeA.with-env check.var)
_ (typeA.infer (type (Array varT)))
arrayA (typeA.with-type (type (Array varT))
(analyse arrayC))
- ?elemT (typeA.with-env
- (check.read var-id))
- [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+ varT (typeA.with-env
+ (check.clean varT))
+ [nesting elem-class] (array-type-info varT)
idxA (typeA.with-type Nat
(analyse idxC))
- valueA (typeA.with-type valueT
+ valueA (typeA.with-type varT
(analyse valueC))]
- (wrap (#/////analysis.Extension extension-name (list (/////analysis.text elem-class) idxA valueA arrayA))))
+ (wrap (#/////analysis.Extension extension-name (list (/////analysis.nat (inc nesting))
+ (/////analysis.text elem-class)
+ idxA
+ valueA
+ arrayA))))
_
(/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
@@ -533,7 +535,7 @@
(wrap (#/////analysis.Extension extension-name (list (/////analysis.text class)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
_
(/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
@@ -556,7 +558,7 @@
(/////analysis.throw cannot-possibly-be-an-instance (format object-class " !<= " class))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
_
(/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
@@ -644,7 +646,7 @@
[innerT (|> java-type
GenericArrayType::getGenericComponentType
(java-type-to-lux-type mappings))]
- (wrap (#.Primitive "#Array" (list innerT))))
+ (wrap (#.Primitive array.type-name (list innerT))))
_)
## else
@@ -756,7 +758,7 @@
" For value: " (%code valueC) text.new-line))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: bundle::object
Bundle
@@ -845,7 +847,7 @@
(wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
_
(/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
@@ -867,7 +869,7 @@
(wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) valueA))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
_
(/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
@@ -886,7 +888,7 @@
(wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) objectA))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
_
(/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
@@ -910,7 +912,7 @@
(wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) valueA objectA))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
_
(/////analysis.throw ///.incorrect-arity [extension-name 4 (list.size args)]))))
@@ -1163,6 +1165,10 @@
candidates
(/////analysis.throw too-many-candidates [class-name ..constructor-method candidates]))))
+(def: typed-input
+ (Syntax [Text Code])
+ (s.tuple (p.and s.text s.any)))
+
(def: (decorate-inputs typesT inputsA)
(-> (List Text) (List Analysis) (List Analysis))
(|> inputsA
@@ -1174,24 +1180,26 @@
Handler
(function (_ extension-name analyse args)
(case (: (Error [Text Text (List [Text Code])])
- (s.run args ($_ p.and s.text s.text (p.some (s.tuple (p.and s.text s.any))))))
+ (s.run args ($_ p.and s.text s.text (p.some ..typed-input))))
(#error.Success [class method argsTC])
(do ////.monad
[#let [argsT (list@map product.left argsTC)]
[methodT exceptionsT] (method-candidate class method #Static argsT)
[outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))
outputJC (check-jvm outputT)]
- (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (/////analysis.text method)
- (/////analysis.text outputJC) (decorate-inputs argsT argsA)))))
+ (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+ (/////analysis.text method)
+ (/////analysis.text outputJC)
+ (decorate-inputs argsT argsA)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: invoke::virtual
Handler
(function (_ extension-name analyse args)
(case (: (Error [Text Text Code (List [Text Code])])
- (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))))))
+ (s.run args ($_ p.and s.text s.text s.any (p.some ..typed-input))))
(#error.Success [class method objectC argsTC])
(do ////.monad
[#let [argsT (list@map product.left argsTC)]
@@ -1204,34 +1212,39 @@
_
(undefined))]
outputJC (check-jvm outputT)]
- (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (/////analysis.text method)
- (/////analysis.text outputJC) objectA (decorate-inputs argsT argsA)))))
+ (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+ (/////analysis.text method)
+ (/////analysis.text outputJC)
+ objectA
+ (decorate-inputs argsT argsA)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: invoke::special
Handler
(function (_ extension-name analyse args)
- (case (: (Error [(List Code) [Text Text Code (List [Text Code]) Any]])
- (p.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))) s.end!)))
- (#error.Success [_ [class method objectC argsTC _]])
+ (case (: (Error [Text Text Code (List [Text Code])])
+ (s.run args ($_ p.and s.text s.text s.any (p.some ..typed-input))))
+ (#error.Success [class method objectC argsTC])
(do ////.monad
[#let [argsT (list@map product.left argsTC)]
[methodT exceptionsT] (method-candidate class method #Special argsT)
[outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
outputJC (check-jvm outputT)]
- (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (/////analysis.text method)
- (/////analysis.text outputJC) (decorate-inputs argsT argsA)))))
+ (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+ (/////analysis.text method)
+ (/////analysis.text outputJC)
+ (decorate-inputs argsT argsA)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: invoke::interface
Handler
(function (_ extension-name analyse args)
(case (: (Error [Text Text Code (List [Text Code])])
- (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))))))
+ (s.run args ($_ p.and s.text s.text s.any (p.some ..typed-input))))
(#error.Success [class-name method objectC argsTC])
(do ////.monad
[#let [argsT (list@map product.left argsTC)]
@@ -1242,26 +1255,29 @@
[outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
outputJC (check-jvm outputT)]
(wrap (#/////analysis.Extension extension-name
- (list& (/////analysis.text class-name) (/////analysis.text method) (/////analysis.text outputJC)
+ (list& (/////analysis.text class-name)
+ (/////analysis.text method)
+ (/////analysis.text outputJC)
(decorate-inputs argsT argsA)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: invoke::constructor
Handler
(function (_ extension-name analyse args)
(case (: (Error [Text (List [Text Code])])
- (s.run args ($_ p.and s.text (p.some (s.tuple (p.and s.text s.any))))))
+ (s.run args ($_ p.and s.text (p.some ..typed-input))))
(#error.Success [class argsTC])
(do ////.monad
[#let [argsT (list@map product.left argsTC)]
[methodT exceptionsT] (constructor-candidate class argsT)
[outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))]
- (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class) (decorate-inputs argsT argsA)))))
+ (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+ (decorate-inputs argsT argsA)))))
_
- (/////analysis.throw ///.invalid-syntax [extension-name args]))))
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: bundle::member
Bundle
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 08:40:09 +0000