diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux | 120 |
1 files changed, 63 insertions, 57 deletions
diff --git a/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux index 5acc0cd46..9d9fef5ac 100644 --- a/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux +++ b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux @@ -29,44 +29,50 @@ [///] ) -(exception: #export Wrong-Syntax) -(def: (wrong-syntax procedure args) - (-> Text (List Code) Text) - (format "Procedure: " procedure "\n" - "Arguments: " (%code (code.tuple args)))) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Wrong-Syntax] -(exception: #export JVM-Type-Is-Not-Class) + [JVM-Type-Is-Not-Class] -(exception: #export Non-Interface) -(exception: #export Non-Object) -(exception: #export Non-Array) -(exception: #export Non-Throwable) -(exception: #export Non-JVM-Type) + [Non-Interface] + [Non-Object] + [Non-Array] + [Non-Throwable] + [Non-JVM-Type] -(exception: #export Unknown-Class) -(exception: #export Primitives-Cannot-Have-Type-Parameters) -(exception: #export Primitives-Are-Not-Objects) -(exception: #export Invalid-Type-For-Array-Element) + [Unknown-Class] + [Primitives-Cannot-Have-Type-Parameters] + [Primitives-Are-Not-Objects] + [Invalid-Type-For-Array-Element] -(exception: #export Unknown-Field) -(exception: #export Mistaken-Field-Owner) -(exception: #export Not-Virtual-Field) -(exception: #export Not-Static-Field) -(exception: #export Cannot-Set-Final-Field) + [Unknown-Field] + [Mistaken-Field-Owner] + [Not-Virtual-Field] + [Not-Static-Field] + [Cannot-Set-Final-Field] -(exception: #export No-Candidates) -(exception: #export Too-Many-Candidates) + [No-Candidates] + [Too-Many-Candidates] -(exception: #export Cannot-Cast) + [Cannot-Cast] -(exception: #export Cannot-Possibly-Be-Instance) + [Cannot-Possibly-Be-Instance] -(exception: #export Cannot-Convert-To-Class) -(exception: #export Cannot-Convert-To-Parameter) -(exception: #export Cannot-Convert-To-Lux-Type) -(exception: #export Unknown-Type-Var) -(exception: #export Type-Parameter-Mismatch) -(exception: #export Cannot-Correspond-Type-With-Class) + [Cannot-Convert-To-Class] + [Cannot-Convert-To-Parameter] + [Cannot-Convert-To-Lux-Type] + [Unknown-Type-Var] + [Type-Parameter-Mismatch] + [Cannot-Correspond-Type-With-Class] + ) + +(def: (wrong-syntax procedure args) + (-> Text (List Code) Text) + (format "Procedure: " procedure "\n" + "Arguments: " (%code (code.tuple args)))) (do-template [<name> <class>] [(def: #export <name> Type (#.Primitive <class> (list)))] @@ -186,7 +192,7 @@ (def: (array-length proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list arrayC)) (do macro.Monad<Meta> @@ -201,7 +207,7 @@ (def: (array-new proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list lengthC)) (do macro.Monad<Meta> @@ -292,7 +298,7 @@ (def: (array-read proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list arrayC idxC)) (do macro.Monad<Meta> @@ -312,7 +318,7 @@ (def: (array-write proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list arrayC idxC valueC)) (do macro.Monad<Meta> @@ -344,7 +350,7 @@ (def: (object//null proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list)) (do macro.Monad<Meta> @@ -357,7 +363,7 @@ (def: (object//null? proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list objectC)) (do macro.Monad<Meta> @@ -372,7 +378,7 @@ (def: (object//synchronized proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list monitorC exprC)) (do macro.Monad<Meta> @@ -467,7 +473,7 @@ (def: (object//throw proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list exceptionC)) (do macro.Monad<Meta> @@ -487,7 +493,7 @@ (def: (object//class proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list classC)) (case classC @@ -505,7 +511,7 @@ (def: (object//instance? proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list classC objectC)) (case classC @@ -635,7 +641,7 @@ (def: (object//cast proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list valueC)) (do macro.Monad<Meta> @@ -680,7 +686,7 @@ " For value: " (%code valueC) "\n") (Class::isAssignableFrom [current-class] to-class)) candiate-parents (monad.map @ - (function [java-type] + (function (_ java-type) (do @ [class-name (java-type-to-class java-type) class (load-class class-name)] @@ -732,7 +738,7 @@ (case (Class::getDeclaredField [field-name] class) (#e.Success field) (let [owner (Field::getDeclaringClass [] field)] - (if (is owner class) + (if (is? owner class) (wrap [class field]) (&.throw Mistaken-Field-Owner (format " Field: " field-name "\n" @@ -789,7 +795,7 @@ (def: (static//get proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list classC fieldC)) (case [classC fieldC] @@ -806,7 +812,7 @@ (def: (static//put proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list classC fieldC valueC)) (case [classC fieldC] @@ -828,7 +834,7 @@ (def: (virtual//get proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list classC fieldC objectC)) (case [classC fieldC] @@ -847,7 +853,7 @@ (def: (virtual//put proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list classC fieldC valueC objectC)) (case [classC fieldC] @@ -919,7 +925,7 @@ _ true) (n/= (list.size arg-classes) (list.size parameters)) - (list/fold (function [[expectedJC actualJC] prev] + (list/fold (function (_ [expectedJC actualJC] prev) (and prev (text/= expectedJC actualJC))) true @@ -933,7 +939,7 @@ (monad.map @ java-type-to-parameter))] (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor)) (n/= (list.size arg-classes) (list.size parameters)) - (list/fold (function [[expectedJC actualJC] prev] + (list/fold (function (_ [expectedJC actualJC] prev) (and prev (text/= expectedJC actualJC))) true @@ -1004,7 +1010,7 @@ candidates (|> class (Class::getDeclaredMethods []) array.to-list - (monad.map @ (function [method] + (monad.map @ (function (_ method) (do @ [passes? (check-method class method-name method-type arg-classes method)] (wrap [passes? method])))))] @@ -1060,7 +1066,7 @@ candidates (|> class (Class::getConstructors []) array.to-list - (monad.map @ (function [constructor] + (monad.map @ (function (_ constructor) (do @ [passes? (check-constructor class arg-classes constructor)] (wrap [passes? constructor])))))] @@ -1078,12 +1084,12 @@ (-> (List Text) (List la.Analysis) (List la.Analysis)) (|> inputsA (list.zip2 (list/map code.text typesT)) - (list/map (function [[type value]] + (list/map (function (_ [type value]) (la.product (list type value)))))) (def: (invoke//static proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case (: (e.Error [Text Text (List [Text Code])]) (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any)))))) (#e.Success [class method argsTC]) @@ -1100,7 +1106,7 @@ (def: (invoke//virtual proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case (: (e.Error [Text Text Code (List [Text Code])]) (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any)))))) (#e.Success [class method objectC argsTC]) @@ -1123,7 +1129,7 @@ (def: (invoke//special proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Unit]]) (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!))) (#e.Success [_ [class method objectC argsTC _]]) @@ -1140,7 +1146,7 @@ (def: (invoke//interface proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case (: (e.Error [Text Text Code (List [Text Code])]) (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any)))))) (#e.Success [class-name method objectC argsTC]) @@ -1161,7 +1167,7 @@ (def: (invoke//constructor proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case (: (e.Error [Text (List [Text Code])]) (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any)))))) (#e.Success [class argsTC]) |