diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/extension/analysis')
| -rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis/common.lux | 49 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux | 120 |
2 files changed, 90 insertions, 79 deletions
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux index 9fc807f75..8ec031066 100644 --- a/new-luxc/source/luxc/lang/extension/analysis/common.lux +++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux @@ -20,8 +20,13 @@ [".A" type]))) [///]) -(exception: #export Incorrect-Procedure-Arity) -(exception: #export Invalid-Syntax) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Incorrect-Procedure-Arity] + [Invalid-Syntax] + ) ## [Utils] (type: #export Bundle @@ -36,7 +41,7 @@ (-> Text Bundle Bundle) (|> bundle dict.entries - (list/map (function [[key val]] [(format prefix " " key) val])) + (list/map (function (_ [key val]) [(format prefix " " key) val])) (dict.from-list text.Hash<Text>))) (def: #export (wrong-arity proc expected actual) @@ -48,13 +53,13 @@ (def: (simple proc inputsT+ outputT) (-> Text (List Type) Type ///.Analysis) (let [num-expected (list.size inputsT+)] - (function [analyse eval args] + (function (_ analyse eval args) (let [num-actual (list.size args)] (if (n/= num-expected num-actual) (do macro.Monad<Meta> [_ (&.infer outputT) argsA (monad.map @ - (function [[argT argC]] + (function (_ [argT argC]) (&.with-type argT (analyse argC))) (list.zip2 inputsT+ args))] @@ -81,7 +86,7 @@ ## "lux is" represents reference/pointer equality. (def: (lux//is proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] ((binary varT varT Bool proc) @@ -91,7 +96,7 @@ ## error-handling facilities. (def: (lux//try proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list opC)) (do macro.Monad<Meta> @@ -106,7 +111,7 @@ (def: (lux//function proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list [_ (#.Symbol ["" func-name])] [_ (#.Symbol ["" arg-name])] @@ -118,7 +123,7 @@ (def: (lux//case proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list input [_ (#.Record branches)])) (caseA.analyse-case analyse input branches) @@ -128,7 +133,7 @@ (def: (lux//in-module proc) (-> Text ///.Analysis) - (function [analyse eval argsC+] + (function (_ analyse eval argsC+) (case argsC+ (^ (list [_ (#.Text module-name)] exprC)) (&.with-current-module module-name @@ -138,14 +143,14 @@ (&.throw Invalid-Syntax (format "Procedure: " proc "\n" " Inputs:" (|> argsC+ list.enumerate - (list/map (function [[idx argC]] + (list/map (function (_ [idx argC]) (format "\n " (%n idx) " " (%code argC)))) (text.join-with "")) "\n"))))) (do-template [<name> <analyser>] [(def: (<name> proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list typeC valueC)) (<analyser> analyse eval typeC valueC) @@ -158,7 +163,7 @@ (def: (lux//check//type proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list valueC)) (do macro.Monad<Meta> @@ -295,7 +300,7 @@ (def: (array//get proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] ((binary (type (Array varT)) Nat (type (Maybe varT)) proc) @@ -303,7 +308,7 @@ (def: (array//put proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] ((trinary (type (Array varT)) Nat varT (type (Array varT)) proc) @@ -311,7 +316,7 @@ (def: (array//remove proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] ((binary (type (Array varT)) Nat (type (Array varT)) proc) @@ -352,7 +357,7 @@ (def: (atom-new proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list initC)) (do macro.Monad<Meta> @@ -367,7 +372,7 @@ (def: (atom-read proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] ((unary (type (Atom varT)) varT proc) @@ -375,7 +380,7 @@ (def: (atom//compare-and-swap proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] ((trinary (type (Atom varT)) varT varT Bool proc) @@ -395,7 +400,7 @@ (def: (box//new proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (case args (^ (list initC)) (do macro.Monad<Meta> @@ -410,7 +415,7 @@ (def: (box//read proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[thread-id threadT] (&.with-type-env tc.var) [var-id varT] (&.with-type-env tc.var)] @@ -419,7 +424,7 @@ (def: (box//write proc) (-> Text ///.Analysis) - (function [analyse eval args] + (function (_ analyse eval args) (do macro.Monad<Meta> [[thread-id threadT] (&.with-type-env tc.var) [var-id varT] (&.with-type-env tc.var)] 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]) |