diff options
| author | Eduardo Julian | 2018-04-06 08:32:41 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2018-04-06 08:32:41 -0400 |
| commit | ca238f9c89d3156842b0a3d5fe24a5d69b2eedb0 (patch) | |
| tree | 50ba106541f2357daf27393df28e8b263f7311e1 /new-luxc/source/luxc/lang | |
| parent | 84d7e87817cd2c074653b34d028c8fa807febc7f (diff) | |
- Adapted new-luxc's code to latest stdlib changes.
Diffstat (limited to 'new-luxc/source/luxc/lang')
72 files changed, 754 insertions, 582 deletions
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux index e33f51927..369e9dd7e 100644 --- a/new-luxc/source/luxc/lang/analysis.lux +++ b/new-luxc/source/luxc/lang/analysis.lux @@ -68,7 +68,7 @@ (def: #export (apply args func) (-> (List Analysis) Analysis Analysis) - (list/fold (function [arg func] + (list/fold (function (_ arg func) (` ("lux apply" (~ arg) (~ func)))) func args)) diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index c40bb2ac3..a9731a1d7 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -22,13 +22,18 @@ [".A" structure] (case [".A" coverage]))))) -(exception: #export Cannot-Match-Type-With-Pattern) -(exception: #export Sum-Type-Has-No-Case) -(exception: #export Unrecognized-Pattern-Syntax) -(exception: #export Cannot-Simplify-Type-For-Pattern-Matching) -(exception: #export Cannot-Have-Empty-Branches) -(exception: #export Non-Exhaustive-Pattern-Matching) -(exception: #export Symbols-Must-Be-Unqualified-Inside-Patterns) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Cannot-Match-Type-With-Pattern] + [Sum-Type-Has-No-Case] + [Unrecognized-Pattern-Syntax] + [Cannot-Simplify-Type-For-Pattern-Matching] + [Cannot-Have-Empty-Branches] + [Non-Exhaustive-Pattern-Matching] + [Symbols-Must-Be-Unqualified-Inside-Patterns] + ) (def: (pattern-error type pattern) (-> Type Code Text) @@ -204,7 +209,7 @@ [[memberP+ thenA] (list/fold (: (All [a] (-> [Type Code] (Meta [(List la.Pattern) a]) (Meta [(List la.Pattern) a]))) - (function [[memberT memberC] then] + (function (_ [memberT memberC] then) (do @ [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a]))) analyse-pattern) @@ -292,7 +297,7 @@ (analyse inputC)) outputH (analyse-pattern #.None inputT patternH (analyse bodyH)) outputT (monad.map @ - (function [[patternT bodyT]] + (function (_ [patternT bodyT]) (analyse-pattern #.None inputT patternT (analyse bodyT))) branchesT) outputHC (|> outputH product.left coverageA.determine) diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux index ae72b47e4..b81a3b7a9 100644 --- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux +++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux @@ -13,6 +13,9 @@ (luxc ["&" lang] (lang ["la" analysis]))) +(exception: #export (Unknown-Pattern {message Text}) + message) + ## The coverage of a pattern-matching expression summarizes how well ## all the possible values of an input are being covered by the ## different patterns involved. @@ -42,8 +45,6 @@ _ false)) -(exception: #export Unknown-Pattern) - (def: #export (determine pattern) (-> la.Pattern (Meta Coverage)) (case pattern @@ -142,7 +143,7 @@ (let [flatR (flatten-alt reference) flatS (flatten-alt sample)] (and (n/= (list.size flatR) (list.size flatS)) - (list.every? (function [[coverageR coverageS]] + (list.every? (function (_ [coverageR coverageS]) (= coverageR coverageS)) (list.zip2 flatR flatS)))) @@ -184,7 +185,7 @@ ## else (do e.Monad<Error> [casesM (monad.fold @ - (function [[tagA coverageA] casesSF'] + (function (_ [tagA coverageA] casesSF') (case (dict.get tagA casesSF') (#.Some coverageSF) (do @ @@ -251,7 +252,7 @@ [#let [fuse-once (: (-> Coverage (List Coverage) (e.Error [(Maybe Coverage) (List Coverage)])) - (function [coverage possibilities] + (function (_ coverage possibilities) (loop [alts possibilities] (case alts #.Nil @@ -284,7 +285,7 @@ #.None (case (list.reverse possibilities) (#.Cons last prevs) - (wrap (list/fold (function [left right] (#Alt left right)) + (wrap (list/fold (function (_ left right) (#Alt left right)) last prevs)) diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux index aeed656a8..c4ff4bfde 100644 --- a/new-luxc/source/luxc/lang/analysis/common.lux +++ b/new-luxc/source/luxc/lang/analysis/common.lux @@ -19,7 +19,8 @@ knownT (&.with-type-env (tc.clean varT))] (wrap [knownT analysis]))) -(exception: #export Variant-Tag-Out-Of-Bounds) +(exception: #export (Variant-Tag-Out-Of-Bounds {message Text}) + message) (def: #export (variant-out-of-bounds-error type size tag) (All [a] (-> Type Nat Nat (Meta a))) diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux index 8907ba665..aaa64940b 100644 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -22,14 +22,19 @@ [".A" reference] [".A" structure])) -(exception: #export Macro-Expression-Must-Have-Single-Expansion) -(exception: #export Unrecognized-Syntax) -(exception: #export Macro-Expansion-Failed) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Macro-Expression-Must-Have-Single-Expansion] + [Unrecognized-Syntax] + [Macro-Expansion-Failed] + ) (def: #export (analyser eval) (-> &.Eval &.Analyser) (: (-> Code (Meta la.Analysis)) - (function analyse [code] + (function (analyse code) (do macro.Monad<Meta> [expectedT macro.expected-type] (let [[cursor code'] code] @@ -96,7 +101,7 @@ (#.Some macro) (do @ [expansion (: (Meta (List Code)) - (function [compiler] + (function (_ compiler) (case (macroL.expand macro args compiler) (#e.Error error) ((&.throw Macro-Expansion-Failed error) compiler) diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux index a502a9d19..eaddfa5bb 100644 --- a/new-luxc/source/luxc/lang/analysis/function.lux +++ b/new-luxc/source/luxc/lang/analysis/function.lux @@ -17,9 +17,14 @@ ["&." inference]) [".L" variable #+ Variable]))) -(exception: #export Cannot-Analyse-Function) -(exception: #export Invalid-Function-Type) -(exception: #export Cannot-Apply-Function) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Cannot-Analyse-Function] + [Invalid-Function-Type] + [Cannot-Apply-Function] + ) ## [Analysers] (def: #export (analyse-function analyse func-name arg-name body) @@ -28,10 +33,12 @@ [functionT macro.expected-type] (loop [expectedT functionT] (&.with-stacked-errors - (function [_] (Cannot-Analyse-Function (format " Type: " (%type expectedT) "\n" - "Function: " func-name "\n" - "Argument: " arg-name "\n" - " Body: " (%code body)))) + (function (_ _) + (ex.construct Cannot-Analyse-Function + (format " Type: " (%type expectedT) "\n" + "Function: " func-name "\n" + "Argument: " arg-name "\n" + " Body: " (%code body)))) (case expectedT (#.Named name unnamedT) (recur unnamedT) @@ -73,7 +80,7 @@ )) (#.Function inputT outputT) - (<| (:: @ map (function [[scope bodyA]] + (<| (:: @ map (function (_ [scope bodyA]) (` ("lux function" [(~+ (list/map code.int (variableL.environment scope)))] (~ bodyA))))) &.with-scope @@ -91,13 +98,14 @@ (def: #export (analyse-apply analyse funcT funcA args) (-> &.Analyser Type Analysis (List Code) (Meta Analysis)) (&.with-stacked-errors - (function [_] - (Cannot-Apply-Function (format " Function: " (%type funcT) "\n" - "Arguments:" (|> args - list.enumerate - (list/map (function [[idx argC]] - (format "\n " (%n idx) " " (%code argC)))) - (text.join-with ""))))) + (function (_ _) + (ex.construct Cannot-Apply-Function + (format " Function: " (%type funcT) "\n" + "Arguments:" (|> args + list.enumerate + (list/map (function (_ [idx argC]) + (format "\n " (%n idx) " " (%code argC)))) + (text.join-with ""))))) (do macro.Monad<Meta> [[applyT argsA] (&inference.general analyse funcT args)] (wrap (la.apply argsA funcA))))) diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux index 3919ff78d..9bc668050 100644 --- a/new-luxc/source/luxc/lang/analysis/inference.lux +++ b/new-luxc/source/luxc/lang/analysis/inference.lux @@ -13,23 +13,28 @@ (lang ["la" analysis #+ Analysis] (analysis ["&." common])))) -(exception: #export Cannot-Infer) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Cannot-Infer] + [Cannot-Infer-Argument] + [Smaller-Variant-Than-Expected] + [Invalid-Type-Application] + [Not-A-Record-Type] + [Not-A-Variant-Type] + ) + (def: (cannot-infer type args) (-> Type (List Code) Text) (format " Type: " (%type type) "\n" "Arguments:" (|> args list.enumerate - (list/map (function [[idx argC]] + (list/map (function (_ [idx argC]) (format "\n " (%n idx) " " (%code argC)))) (text.join-with "")))) -(exception: #export Cannot-Infer-Argument) -(exception: #export Smaller-Variant-Than-Expected) -(exception: #export Invalid-Type-Application) -(exception: #export Not-A-Record-Type) -(exception: #export Not-A-Variant-Type) - (def: (replace-bound bound-idx replacementT type) (-> Nat Type Type Type) (case type @@ -131,9 +136,10 @@ (do macro.Monad<Meta> [[outputT' args'A] (general analyse outputT args') argA (&.with-stacked-errors - (function [_] (Cannot-Infer-Argument - (format "Inferred Type: " (%type inputT) "\n" - " Argument: " (%code argC)))) + (function (_ _) + (ex.construct Cannot-Infer-Argument + (format "Inferred Type: " (%type inputT) "\n" + " Argument: " (%code argC)))) (&.with-type inputT (analyse argC)))] (wrap [outputT' (list& argA args'A)])) diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index 403fe4730..c5be94df6 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -21,27 +21,34 @@ [".A" primitive] ["&." inference])))) -(exception: #export Invalid-Variant-Type) -(exception: #export Invalid-Tuple-Type) -(exception: #export Not-Quantified-Type) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] -(exception: #export Cannot-Analyse-Variant) -(exception: #export Cannot-Analyse-Tuple) + [Invalid-Variant-Type] + [Invalid-Tuple-Type] + [Not-Quantified-Type] -(exception: #export Cannot-Infer-Numeric-Tag) -(exception: #export Record-Keys-Must-Be-Tags) -(exception: #export Cannot-Repeat-Tag) -(exception: #export Tag-Does-Not-Belong-To-Record) -(exception: #export Record-Size-Mismatch) + [Cannot-Analyse-Variant] + [Cannot-Analyse-Tuple] + + [Cannot-Infer-Numeric-Tag] + [Record-Keys-Must-Be-Tags] + [Cannot-Repeat-Tag] + [Tag-Does-Not-Belong-To-Record] + [Record-Size-Mismatch] + ) (def: #export (analyse-sum analyse tag valueC) (-> &.Analyser Nat Code (Meta la.Analysis)) (do macro.Monad<Meta> [expectedT macro.expected-type] (&.with-stacked-errors - (function [_] (Cannot-Analyse-Variant (format " Type: " (%type expectedT) "\n" - " Tag: " (%n tag) "\n" - "Expression: " (%code valueC)))) + (function (_ _) + (ex.construct Cannot-Analyse-Variant + (format " Type: " (%type expectedT) "\n" + " Tag: " (%n tag) "\n" + "Expression: " (%code valueC)))) (case expectedT (#.Sum _) (let [flat (type.flatten-variant expectedT) @@ -74,9 +81,10 @@ ## Cannot do inference when the tag is numeric. ## This is because there is no way of knowing how many ## cases the inferred sum type would have. - (&.throw Cannot-Infer-Numeric-Tag (format " Type: " (%type expectedT) "\n" - " Tag: " (%n tag) "\n" - "Expression: " (%code valueC))) + (&.throw Cannot-Infer-Numeric-Tag + (format " Type: " (%type expectedT) "\n" + " Tag: " (%n tag) "\n" + "Expression: " (%code valueC))) )) (^template [<tag> <instancer>] @@ -169,8 +177,10 @@ (do macro.Monad<Meta> [expectedT macro.expected-type] (&.with-stacked-errors - (function [_] (Cannot-Analyse-Tuple (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~+ membersC)]))))) + (function (_ _) + (ex.construct Cannot-Analyse-Tuple + (format " Type: " (%type expectedT) "\n" + "Expression: " (%code (` [(~+ membersC)]))))) (case expectedT (#.Product _) (analyse-typed-product analyse membersC) @@ -218,8 +228,9 @@ (analyse-product analyse membersC)) _ - (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~+ membersC)])))))) + (&.throw Invalid-Tuple-Type + (format " Type: " (%type expectedT) "\n" + "Expression: " (%code (` [(~+ membersC)])))))) _ (case (type.apply (list inputT) funT) @@ -231,8 +242,9 @@ (analyse-product analyse membersC)))) _ - (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~+ membersC)])))) + (&.throw Invalid-Tuple-Type + (format " Type: " (%type expectedT) "\n" + "Expression: " (%code (` [(~+ membersC)])))) )))) (def: #export (analyse-tagged-sum analyse tag valueC) @@ -260,7 +272,7 @@ (def: #export (normalize record) (-> (List [Code Code]) (Meta (List [Ident Code]))) (monad.map macro.Monad<Meta> - (function [[key val]] + (function (_ [key val]) (case key [_ (#.Tag key)] (do macro.Monad<Meta> @@ -268,8 +280,9 @@ (wrap [key val])) _ - (&.throw Record-Keys-Must-Be-Tags (format " Key: " (%code key) "\n" - "Record: " (%code (code.record record)))))) + (&.throw Record-Keys-Must-Be-Tags + (format " Key: " (%code key) "\n" + "Record: " (%code (code.record record)))))) record)) ## Lux already possesses the means to analyse tuples, so @@ -295,13 +308,13 @@ " Actual: " (|> size-record nat-to-int %i) "\n" " Type: " (%type recordT) "\n" "Expression: " (%code (|> record - (list/map (function [[keyI valueC]] + (list/map (function (_ [keyI valueC]) [(code.tag keyI) valueC])) code.record))))) #let [tuple-range (list.n/range +0 (n/dec size-ts)) tag->idx (dict.from-list ident.Hash<Ident> (list.zip2 tag-set tuple-range))] idx->val (monad.fold @ - (function [[key val] idx->val] + (function (_ [key val] idx->val) (do @ [key (macro.normalize key)] (case (dict.get key tag->idx) @@ -314,14 +327,14 @@ (if (dict.contains? idx idx->val) (&.throw Cannot-Repeat-Tag (format " Tag: " (%code (code.tag key)) "\n" - "Record: " (%code (code.record (list/map (function [[keyI valC]] + "Record: " (%code (code.record (list/map (function (_ [keyI valC]) [(code.tag keyI) valC]) record))))) (wrap (dict.put idx val idx->val)))))) (: (Dict Nat Code) (dict.new number.Hash<Nat>)) record) - #let [ordered-tuple (list/map (function [idx] (maybe.assume (dict.get idx idx->val))) + #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val))) tuple-range)]] (wrap [ordered-tuple recordT])) )) diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux index c5e6a8e25..e8121b9b6 100644 --- a/new-luxc/source/luxc/lang/extension.lux +++ b/new-luxc/source/luxc/lang/extension.lux @@ -10,15 +10,20 @@ (// ["la" analysis] ["ls" synthesis])) -(exception: #export Unknown-Analysis) -(exception: #export Unknown-Synthesis) -(exception: #export Unknown-Translation) -(exception: #export Unknown-Statement) - -(exception: #export Cannot-Define-Analysis-More-Than-Once) -(exception: #export Cannot-Define-Synthesis-More-Than-Once) -(exception: #export Cannot-Define-Translation-More-Than-Once) -(exception: #export Cannot-Define-Statement-More-Than-Once) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Unknown-Analysis] + [Unknown-Synthesis] + [Unknown-Translation] + [Unknown-Statement] + + [Cannot-Define-Analysis-More-Than-Once] + [Cannot-Define-Synthesis-More-Than-Once] + [Cannot-Define-Translation-More-Than-Once] + [Cannot-Define-Statement-More-Than-Once] + ) (type: #export Analysis (-> (-> Code (Meta Code)) @@ -51,13 +56,13 @@ (def: get (Meta Extensions) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.extensions) (:! Extensions))]))) (def: (set extensions) (-> Extensions (Meta Unit)) - (function [compiler] + (function (_ compiler) (#e.Success [(set@ #.extensions (:! Void extensions) compiler) []]))) diff --git a/new-luxc/source/luxc/lang/extension/analysis.lux b/new-luxc/source/luxc/lang/extension/analysis.lux index 30f43acef..cc7de89b1 100644 --- a/new-luxc/source/luxc/lang/extension/analysis.lux +++ b/new-luxc/source/luxc/lang/extension/analysis.lux @@ -10,7 +10,7 @@ (def: realize (-> /common.Bundle (Dict Text //.Analysis)) (|>> dict.entries - (list/map (function [[name proc]] [name (proc name)])) + (list/map (function (_ [name proc]) [name (proc name)])) (dict.from-list text.Hash<Text>))) (def: #export defaults 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]) diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux index c084055b7..81b43f205 100644 --- a/new-luxc/source/luxc/lang/extension/statement.lux +++ b/new-luxc/source/luxc/lang/extension/statement.lux @@ -22,8 +22,13 @@ [".T" eval])) [".L" eval]))) -(exception: #export Invalid-Statement) -(exception: #export Invalid-Alias) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Statement] + [Invalid-Alias] + ) (def: (throw-invalid-statement procedure inputsC+) (All [a] (-> Text (List Code) (Meta a))) @@ -32,7 +37,7 @@ " Inputs:" (|> inputsC+ list.enumerate - (list/map (function [[idx inputC]] + (list/map (function (_ [idx inputC]) (format "\n " (%n idx) " " (%code inputC)))) (text.join-with "")) "\n"))) @@ -58,7 +63,7 @@ (def: (lux//def procedure) (-> Text //.Statement) - (function [inputsC+] + (function (_ inputsC+) (case inputsC+ (^ (list [_ (#.Symbol ["" def-name])] valueC annotationsC)) (hostL.with-context def-name @@ -96,7 +101,7 @@ (def: (lux//program procedure) (-> Text //.Statement) - (function [inputsC+] + (function (_ inputsC+) (case inputsC+ (^ (list [_ (#.Symbol ["" args])] programC)) (do macro.Monad<Meta> @@ -115,7 +120,7 @@ (do-template [<mame> <type> <installer>] [(def: (<mame> procedure) (-> Text //.Statement) - (function [inputsC+] + (function (_ inputsC+) (case inputsC+ (^ (list [_ (#.Text name)] valueC)) (do macro.Monad<Meta> diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux index 58b79cfa4..b9261f7b0 100644 --- a/new-luxc/source/luxc/lang/host.jvm.lux +++ b/new-luxc/source/luxc/lang/host.jvm.lux @@ -94,7 +94,7 @@ (def: #export (with-anchor anchor expr) (All [a] (-> [Label Register] (Meta a) (Meta a))) - (.function [compiler] + (.function (_ compiler) (let [old (:! commonT.Host (get@ #.host compiler))] (case (expr (set@ #.host (:! Void (set@ #commonT.anchor (#.Some anchor) old)) @@ -110,11 +110,12 @@ (#e.Error error) (#e.Error error))))) -(exception: #export No-Anchor) +(exception: #export (No-Anchor {message Text}) + message) (def: #export anchor (Meta [Label Register]) - (.function [compiler] + (.function (_ compiler) (case (|> compiler (get@ #.host) (:! commonT.Host) (get@ #commonT.anchor)) (#.Some anchor) (#e.Success [compiler @@ -125,7 +126,7 @@ (def: #export (with-context name expr) (All [a] (-> Text (Meta a) (Meta a))) - (.function [compiler] + (.function (_ compiler) (let [old (:! commonT.Host (get@ #.host compiler))] (case (expr (set@ #.host (:! Void (set@ #commonT.context [(&.normalize-name name) +0] old)) @@ -143,7 +144,7 @@ (def: #export (with-sub-context expr) (All [a] (-> (Meta a) (Meta [Text a]))) - (.function [compiler] + (.function (_ compiler) (let [old (:! commonT.Host (get@ #.host compiler)) [old-name old-sub] (get@ #commonT.context old) new-name (format old-name "$" (%i (nat-to-int old-sub)))] @@ -163,7 +164,7 @@ (def: #export context (Meta Text) - (.function [compiler] + (.function (_ compiler) (#e.Success [compiler (|> (get@ #.host compiler) (:! commonT.Host) @@ -173,7 +174,7 @@ (def: #export class-loader (Meta ClassLoader) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.host) diff --git a/new-luxc/source/luxc/lang/host/js.lux b/new-luxc/source/luxc/lang/host/js.lux index 41dc0965e..e8f86ebdd 100644 --- a/new-luxc/source/luxc/lang/host/js.lux +++ b/new-luxc/source/luxc/lang/host/js.lux @@ -44,7 +44,7 @@ (def: #export (cond! clauses else!) (-> (List [Expression Statement]) Statement Statement) - (list/fold (.function [[test then!] next!] + (list/fold (.function (_ [test then!] next!) (if! test then! next!)) else! (list.reverse clauses))) @@ -79,7 +79,7 @@ (-> (List [Text Expression]) Expression) (format "({" (|> fields - (list/map (.function [[key val]] + (list/map (.function (_ [key val]) (format key ": " val))) (text.join-with ", ")) "})")) diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index 67b28b7b0..c76c5144d 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -89,26 +89,26 @@ g!tags+ (list/map code.local-tag options) g!_left (code.local-symbol "_left") g!_right (code.local-symbol "_right") - g!options+ (list/map (function [option] + g!options+ (list/map (function (_ option) (` (def: (~' #export) (~ (code.local-symbol option)) (~ g!type) (|> (~ g!none) (set@ (~ (code.local-tag option)) true))))) options)] (wrap (list& (` (type: (~' #export) (~ g!type) - (~ (code.record (list/map (function [tag] + (~ (code.record (list/map (function (_ tag) [tag (` .Bool)]) g!tags+))))) (` (def: (~' #export) (~ g!none) (~ g!type) - (~ (code.record (list/map (function [tag] + (~ (code.record (list/map (function (_ tag) [tag (` false)]) g!tags+))))) (` (def: (~' #export) ((~ (code.local-symbol ++)) (~ g!_left) (~ g!_right)) (-> (~ g!type) (~ g!type) (~ g!type)) - (~ (code.record (list/map (function [tag] + (~ (code.record (list/map (function (_ tag) [tag (` (or (get@ (~ tag) (~ g!_left)) (get@ (~ tag) (~ g!_right))))]) g!tags+))))) diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 8c73c1086..4cb7aba3e 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -63,7 +63,7 @@ (def: (string-array values) (-> (List Text) (Array Text)) (let [output (host.array String (list.size values))] - (exec (list/map (function [[idx value]] + (exec (list/map (function (_ [idx value]) (host.array-write idx value output)) (list.enumerate values)) output))) @@ -206,7 +206,7 @@ (def: #export (method visibility config name type then) (-> $.Visibility $.Method-Config Text $.Method $.Inst $.Def) - (function [writer] + (function (_ writer) (let [=method (ClassWriter::visitMethod [($_ i/+ (visibility-flag visibility) (method-flags config)) @@ -224,7 +224,7 @@ (def: #export (abstract-method visibility config name type) (-> $.Visibility $.Method-Config Text $.Method $.Def) - (function [writer] + (function (_ writer) (let [=method (ClassWriter::visitMethod [($_ i/+ (visibility-flag visibility) (method-flags config) @@ -239,7 +239,7 @@ (def: #export (field visibility config name type) (-> $.Visibility $.Field-Config Text $.Type $.Def) - (function [writer] + (function (_ writer) (let [=field (do-to (ClassWriter::visitField [($_ i/+ (visibility-flag visibility) (field-flags config)) @@ -253,7 +253,7 @@ (do-template [<name> <lux-type> <jvm-type> <prepare>] [(def: #export (<name> visibility config name value) (-> $.Visibility $.Field-Config Text <lux-type> $.Def) - (function [writer] + (function (_ writer) (let [=field (do-to (ClassWriter::visitField [($_ i/+ (visibility-flag visibility) (field-flags config)) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 0b1904020..f993f0c48 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -20,7 +20,7 @@ (syntax: (declare [codes (p.many s.local-symbol)]) (|> codes - (list/map (function [code] (` ((~' #static) (~ (code.local-symbol code)) (~' int))))) + (list/map (function (_ code) (` ((~' #static) (~ (code.local-symbol code)) (~' int))))) wrap)) (`` (host.import org/objectweb/asm/Opcodes @@ -113,7 +113,7 @@ ## [Insts] (def: #export make-label (Meta Label) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (Label::new [])]))) (def: #export (with-label action) @@ -123,7 +123,7 @@ (do-template [<name> <type> <prepare>] [(def: #export (<name> value) (-> <type> $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitLdcInsn [(<prepare> value)]))))] @@ -140,14 +140,14 @@ (def: #export NULL $.Inst - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix ACONST_NULL)])))) (do-template [<name>] [(def: #export <name> $.Inst - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix <name>)]))))] @@ -208,7 +208,7 @@ (do-template [<name>] [(def: #export (<name> register) (-> Nat $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitVarInsn [(prefix <name>) (nat-to-int register)]))))] @@ -219,7 +219,7 @@ (do-template [<name> <inst>] [(def: #export (<name> class field type) (-> Text Text $.Type $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitFieldInsn [<inst> ($t.binary-name class) field ($t.descriptor type)]))))] @@ -233,7 +233,7 @@ (do-template [<name> <inst>] [(def: #export (<name> class) (-> Text $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitTypeInsn [<inst> ($t.binary-name class)]))))] @@ -245,7 +245,7 @@ (def: #export (NEWARRAY type) (-> $.Primitive $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type #$.Boolean Opcodes::T_BOOLEAN @@ -260,7 +260,7 @@ (do-template [<name> <inst>] [(def: #export (<name> class method-name method-signature interface?) (-> Text Text $.Method Bool $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitMethodInsn [<inst> ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))] @@ -273,7 +273,7 @@ (do-template [<name>] [(def: #export (<name> @where) (-> $.Label $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitJumpInsn [(prefix <name>) @where]))))] @@ -284,7 +284,7 @@ (def: #export (TABLESWITCH min max default labels) (-> Int Int $.Label (List $.Label) $.Inst) - (function [visitor] + (function (_ visitor) (let [num-labels (list.size labels) labels-array (host.array Label num-labels) _ (loop [idx +0] @@ -299,13 +299,13 @@ (def: #export (try @from @to @handler exception) (-> $.Label $.Label $.Label Text $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitTryCatchBlock [@from @to @handler ($t.binary-name exception)])))) (def: #export (label @label) (-> $.Label $.Inst) - (function [visitor] + (function (_ visitor) (do-to visitor (MethodVisitor::visitLabel [@label])))) diff --git a/new-luxc/source/luxc/lang/host/lua.lux b/new-luxc/source/luxc/lang/host/lua.lux index 943b0377e..8f057bc29 100644 --- a/new-luxc/source/luxc/lang/host/lua.lux +++ b/new-luxc/source/luxc/lang/host/lua.lux @@ -87,7 +87,7 @@ (def: #export (cond! clauses else!) (-> (List [Expression Statement]) Statement Statement) - (list/fold (.function [[test then!] next!] + (list/fold (.function (_ [test then!] next!) (if! test then! next!)) else! (list.reverse clauses))) @@ -139,7 +139,7 @@ (-> (List [Text Expression]) Expression) (format "{" (|> fields - (list/map (.function [[key val]] + (list/map (.function (_ [key val]) (format key " = " val))) (text.join-with ", ")) "}")) diff --git a/new-luxc/source/luxc/lang/host/python.lux b/new-luxc/source/luxc/lang/host/python.lux index 335d418a3..8e42ff0a5 100644 --- a/new-luxc/source/luxc/lang/host/python.lux +++ b/new-luxc/source/luxc/lang/host/python.lux @@ -1,5 +1,5 @@ (.module: - [lux #- not or and list if is] + [lux #- not or and list if] (lux (control pipe) (data [text] text/format @@ -79,7 +79,7 @@ (def: (composite-literal left-delimiter right-delimiter entry-serializer) (All [a] (-> Text Text (-> a Text) (-> (List a) Expression))) - (function [entries] + (function (_ entries) (@abstraction (format "(" left-delimiter (|> entries (list/map entry-serializer) (text.join-with ",")) right-delimiter ")")))) @@ -107,7 +107,7 @@ (def: #export dict (-> (List [Expression Expression]) Expression) - (composite-literal "{" "}" (.function [[k v]] (format (@representation k) " : " (@representation v))))) + (composite-literal "{" "}" (.function (_ [k v]) (format (@representation k) " : " (@representation v))))) (def: #export (apply args func) (-> (List Expression) Expression Expression) @@ -129,7 +129,7 @@ (-> (List Expression) Expression Expression Expression) (@abstraction (format "(" (@representation func) (format "(" (|> args - (list/map (function [arg] (format (@representation arg) ", "))) + (list/map (function (_ arg) (format (@representation arg) ", "))) (text.join-with "")) (<splat> extra) ")") ")")))] @@ -266,7 +266,7 @@ (def: #export (cond! clauses else!) (-> (List [Expression Statement]) Statement Statement) - (list/fold (.function [[test then!] next!] + (list/fold (.function (_ [test then!] next!) (if! test then! next!)) else! (list.reverse clauses))) @@ -310,7 +310,7 @@ (format "try:" (nest body!) (|> excepts - (list/map (function [[classes exception catch!]] + (list/map (function (_ [classes exception catch!]) (format "\n" "except (" (text.join-with "," classes) ") as " (..name exception) ":" (nest catch!)))) diff --git a/new-luxc/source/luxc/lang/host/ruby.lux b/new-luxc/source/luxc/lang/host/ruby.lux index 3f179105d..c2bc6e95f 100644 --- a/new-luxc/source/luxc/lang/host/ruby.lux +++ b/new-luxc/source/luxc/lang/host/ruby.lux @@ -46,7 +46,7 @@ (-> (List [Expression Expression]) Expression) (format "({" (|> kvs - (list/map (.function [[k v]] + (list/map (.function (_ [k v]) (format k " => " v))) (text.join-with ", ")) "})")) @@ -111,7 +111,7 @@ (def: #export (cond! clauses else!) (-> (List [Expression Statement]) Statement Statement) - (list/fold (.function [[test then!] next!] + (list/fold (.function (_ [test then!] next!) (if! test then! next!)) else! (list.reverse clauses))) @@ -141,7 +141,7 @@ (format "begin" "\n" body "\n" (|> rescues - (list/map (function [[ex-classes ex-value ex-handler]] + (list/map (function (_ [ex-classes ex-value ex-handler]) (format "rescue " (text.join-with ", " ex-classes) (case ex-value "" "" diff --git a/new-luxc/source/luxc/lang/macro.lux b/new-luxc/source/luxc/lang/macro.lux index deebba0bf..cde3209fc 100644 --- a/new-luxc/source/luxc/lang/macro.lux +++ b/new-luxc/source/luxc/lang/macro.lux @@ -22,7 +22,7 @@ (-> Macro (List Code) (Meta (List Code))) (do macro.Monad<Meta> [class (commonT.load-class hostL.function-class)] - (function [compiler] + (function (_ compiler) (do e.Monad<Error> [apply-method (Class::getMethod ["apply" _apply-args] class) output (Method::invoke [(:! Object macro) diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux index ebc0ee7b0..f60a6f462 100644 --- a/new-luxc/source/luxc/lang/module.lux +++ b/new-luxc/source/luxc/lang/module.lux @@ -12,14 +12,19 @@ (luxc ["&" lang] (lang ["&." scope]))) -(exception: #export Unknown-Module) -(exception: #export Cannot-Declare-Tag-Twice) -(exception: #export Cannot-Declare-Tags-For-Unnamed-Type) -(exception: #export Cannot-Declare-Tags-For-Foreign-Type) -(exception: #export Cannot-Define-More-Than-Once) -(exception: #export Cannot-Define-In-Unknown-Module) -(exception: #export Can-Only-Change-State-Of-Active-Module) -(exception: #export Cannot-Set-Module-Annotations-More-Than-Once) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Unknown-Module] + [Cannot-Declare-Tag-Twice] + [Cannot-Declare-Tags-For-Unnamed-Type] + [Cannot-Declare-Tags-For-Foreign-Type] + [Cannot-Define-More-Than-Once] + [Cannot-Define-In-Unknown-Module] + [Can-Only-Change-State-Of-Active-Module] + [Cannot-Set-Module-Annotations-More-Than-Once] + ) (def: (new-module hash) (-> Nat Module) @@ -39,23 +44,23 @@ self macro.current-module] (case (get@ #.module-annotations self) #.None - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.modules (&.pl-put self-name (set@ #.module-annotations (#.Some annotations) self)) compiler) []])) (#.Some old) - (macro.fail (Cannot-Set-Module-Annotations-More-Than-Once - (format " Module: " self-name "\n" - "Old annotations: " (%code old) "\n" - "New annotations: " (%code annotations) "\n")))))) + (&.throw Cannot-Set-Module-Annotations-More-Than-Once + (format " Module: " self-name "\n" + "Old annotations: " (%code old) "\n" + "New annotations: " (%code annotations) "\n"))))) (def: #export (import module) (-> Text (Meta Unit)) (do macro.Monad<Meta> [self macro.current-module-name] - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.modules (&.pl-update self (update@ #.imports (|>> (#.Cons module)))) compiler) @@ -65,7 +70,7 @@ (-> Text Text (Meta Unit)) (do macro.Monad<Meta> [self macro.current-module-name] - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.modules (&.pl-update self (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) (|>> (#.Cons [alias module]))))) @@ -74,7 +79,7 @@ (def: #export (exists? module) (-> Text (Meta Bool)) - (function [compiler] + (function (_ compiler) (|> (get@ #.modules compiler) (&.pl-get module) (case> (#.Some _) true #.None false) @@ -83,7 +88,7 @@ (def: #export (define (^@ full-name [module-name def-name]) definition) (-> Ident Definition (Meta Unit)) - (function [compiler] + (function (_ compiler) (case (&.pl-get module-name (get@ #.modules compiler)) (#.Some module) (case (&.pl-get def-name (get@ #.definitions module)) @@ -105,7 +110,7 @@ (def: #export (create hash name) (-> Nat Text (Meta Module)) - (function [compiler] + (function (_ compiler) (let [module (new-module hash)] (#e.Success [(update@ #.modules (&.pl-put name module) @@ -124,7 +129,7 @@ (do-template [<flagger> <asker> <tag> <description>] [(def: #export (<flagger> module-name) (-> Text (Meta Unit)) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.modules) (&.pl-get module-name)) (#.Some module) (let [active? (case (get@ #.module-state module) @@ -144,7 +149,7 @@ ((&.throw Unknown-Module module-name) compiler)))) (def: #export (<asker> module-name) (-> Text (Meta Bool)) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.modules) (&.pl-get module-name)) (#.Some module) (#e.Success [compiler @@ -164,7 +169,7 @@ (do-template [<name> <tag> <type>] [(def: (<name> module-name) (-> Text (Meta <type>)) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.modules) (&.pl-get module-name)) (#.Some module) (#e.Success [compiler (get@ <tag> module)]) @@ -183,7 +188,7 @@ (do macro.Monad<Meta> [bindings (tags-by-module module-name) _ (monad.map @ - (function [tag] + (function (_ tag) (case (&.pl-get tag bindings) #.None (wrap []) @@ -211,14 +216,14 @@ (format "Tags: " (|> tags (list/map code.text) code.tuple %code) "\n" "Type: " (%type type)) (text/= current-module type-module))] - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.modules) (&.pl-get current-module)) (#.Some module) (let [namespaced-tags (list/map (|>> [current-module]) tags)] (#e.Success [(update@ #.modules (&.pl-update current-module - (|>> (update@ #.tags (function [tag-bindings] - (list/fold (function [[idx tag] table] + (|>> (update@ #.tags (function (_ tag-bindings) + (list/fold (function (_ [idx tag] table) (&.pl-put tag [idx namespaced-tags exported? type] table)) tag-bindings (list.enumerate tags)))) diff --git a/new-luxc/source/luxc/lang/scope.lux b/new-luxc/source/luxc/lang/scope.lux index 8dcdce6af..82d7803e2 100644 --- a/new-luxc/source/luxc/lang/scope.lux +++ b/new-luxc/source/luxc/lang/scope.lux @@ -25,7 +25,7 @@ (|> scope (get@ [#.locals #.mappings]) (&.pl-get name) - (maybe/map (function [[type value]] + (maybe/map (function (_ [type value]) [type (#.Local value)])))) (def: (is-captured? name scope) @@ -63,7 +63,7 @@ (def: #export (find name) (-> Text (Meta (Maybe [Type Ref]))) - (function [compiler] + (function (_ compiler) (let [[inner outer] (|> compiler (get@ #.scopes) (list.split-with (|>> (is-ref? name) not)))] @@ -75,7 +75,7 @@ (let [[ref-type init-ref] (maybe.default (undefined) (get-ref name top-outer)) [ref inner'] (list/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)]) - (function [scope ref+inner] + (function (_ scope ref+inner) [(#.Captured (get@ [#.captured #.counter] scope)) (#.Cons (update@ #.captured (: (-> Captured Captured) @@ -92,7 +92,7 @@ (def: #export (with-local [name type] action) (All [a] (-> [Text Type] (Meta a) (Meta a))) - (function [compiler] + (function (_ compiler) (case (get@ #.scopes compiler) (#.Cons head tail) (let [old-mappings (get@ [#.locals #.mappings] head) @@ -141,7 +141,7 @@ (def: #export (with-scope name action) (All [a] (-> Text (Meta a) (Meta a))) - (function [compiler] + (function (_ compiler) (let [parent-name (case (get@ #.scopes compiler) #.Nil (list) @@ -164,7 +164,7 @@ (def: #export next-local (Meta Nat) - (function [compiler] + (function (_ compiler) (case (get@ #.scopes compiler) #.Nil (#e.Error "Cannot get next reference when there is no scope.") diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux index 3e57de337..968c35561 100644 --- a/new-luxc/source/luxc/lang/synthesis/case.lux +++ b/new-luxc/source/luxc/lang/synthesis/case.lux @@ -28,7 +28,7 @@ (#.Cons _) (let [last-idx (n/dec (list.size membersP)) [_ output] (list/fold (: (-> la.Pattern [Nat [Nat (List ls.Path)]] [Nat [Nat (List ls.Path)]]) - (function [current-pattern [current-idx num-locals' next]] + (function (_ current-pattern [current-idx num-locals' next]) (let [[num-locals'' current-path] (path' arity num-locals' current-pattern)] [(n/dec current-idx) num-locals'' @@ -64,7 +64,7 @@ (-> (List ls.Path) (List ls.Path)) (case paths (#.Cons path paths') - (if (is popPS path) + (if (is? popPS path) (clean-unnecessary-pops paths') paths) @@ -76,7 +76,7 @@ (let [[num-locals' pieces] (path' arity num-locals pattern)] (|> pieces clean-unnecessary-pops - (list/fold (function [pre post] + (list/fold (function (_ pre post) (` ("lux case seq" (~ pre) (~ post)))) (` ("lux case exec" (~ (synthesize num-locals' bodyA)))))))) diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux index b17af14d2..c05f1daf9 100644 --- a/new-luxc/source/luxc/lang/synthesis/expression.lux +++ b/new-luxc/source/luxc/lang/synthesis/expression.lux @@ -149,7 +149,7 @@ (let [function-arity (if direct? (n/inc arity) +1) - env (list/map (function [closure] + env (list/map (function (_ closure) (case (dict.get closure resolver) (#.Some resolved) (if (and (variableL.local? resolved) @@ -170,11 +170,11 @@ _ (|> (list.size raw-env) n/dec (list.n/range +0) (list/map variableL.captured)))) resolver' (if (and (functionS.nested? function-arity) direct?) - (list/fold (function [[from to] resolver'] + (list/fold (function (_ [from to] resolver') (dict.put from to resolver')) init-resolver (list.zip2 env-vars env)) - (list/fold (function [var resolver'] + (list/fold (function (_ var resolver') (dict.put var var resolver')) init-resolver env-vars))] diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux index 762032a59..c00d5626b 100644 --- a/new-luxc/source/luxc/lang/synthesis/loop.lux +++ b/new-luxc/source/luxc/lang/synthesis/loop.lux @@ -37,7 +37,7 @@ false))) (^ [_ (#.Form (list [_ (#.Text "lux function")] arity [_ (#.Tuple environment)] bodyS))]) - (list.any? (function [captured] + (list.any? (function (_ captured) (case captured (^ [_ (#.Form (list [_ (#.Int var)]))]) (variableL.self? var) @@ -111,7 +111,7 @@ (def: #export (adjust env offset exprS) (-> (List Variable) Register ls.Synthesis ls.Synthesis) (let [resolve-captured (: (-> Variable Variable) - (function [var] + (function (_ var) (let [idx (|> var (i/* -1) int-to-nat n/dec)] (|> env (list.nth idx) maybe.assume))))] (loop [exprS exprS] @@ -144,7 +144,7 @@ (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS))) (` ("lux function" (~ arity) - [(~+ (list/map (function [_var] + [(~+ (list/map (function (_ _var) (case _var (^ [_ (#.Form (list [_ (#.Int var)]))]) (` ((~ (code.int (resolve-captured var))))) diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 8c42c2a71..8857a83d1 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -44,9 +44,14 @@ (&.Analyser) (expressionA.analyser &eval.eval)) -(exception: #export Macro-Expansion-Failed) -(exception: #export Unrecognized-Statement) -(exception: #export Invalid-Macro) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Macro-Expansion-Failed] + [Unrecognized-Statement] + [Invalid-Macro] + ) (def: (process-annotations annsC) (-> Code (Meta [## js.Expression @@ -63,7 +68,7 @@ (def: (switch-compiler new-compiler) (-> Compiler (Meta Aliases)) - (function [old-compiler] + (function (_ old-compiler) ((do macro.Monad<Meta> [this macro.current-module] (wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases)))) @@ -102,7 +107,7 @@ _ (&.throw Invalid-Macro (%code code))) expansion (: (Meta (List Code)) - (function [compiler] + (function (_ compiler) (case (macroL.expand (:! Macro _macroV) argsC+ compiler) (#e.Error error) ((&.throw Macro-Expansion-Failed error) compiler) @@ -127,7 +132,7 @@ (def: (forgive-eof action) (-> (Meta Unit) (Meta Unit)) - (function [compiler] + (function (_ compiler) (case (action compiler) (#e.Error error) (if (ex.match? syntax.End-Of-File error) @@ -149,7 +154,7 @@ (def: (read current-module aliases) (-> Text Aliases (Meta Code)) - (function [compiler] + (function (_ compiler) (case (syntax.read current-module aliases (get@ #.source compiler)) (#e.Error error) (#e.Error error) diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux index c0cf2d0dd..db76a2868 100644 --- a/new-luxc/source/luxc/lang/translation/js.lux +++ b/new-luxc/source/luxc/lang/translation/js.lux @@ -18,6 +18,18 @@ (host [js #+ JS Expression Statement])) [".C" io])) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [No-Active-Module-Buffer] + [Cannot-Execute] + + [No-Anchor] + + [Unknown-Member] + ) + (host.import java/lang/Object (toString [] String)) @@ -79,7 +91,7 @@ (def: #export init-module-buffer (Meta Unit) - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.host (|>> (:! Host) (set@ #module-buffer (#.Some (StringBuilder::new []))) @@ -87,12 +99,9 @@ compiler) []]))) -(exception: #export No-Active-Module-Buffer) -(exception: #export Cannot-Execute) - (def: #export (with-sub-context expr) (All [a] (-> (Meta a) (Meta [Text a]))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) new-name (format old-name "$" (%i (nat-to-int old-sub)))] @@ -112,7 +121,7 @@ (def: #export context (Meta Text) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> (get@ #.host compiler) (:! Host) @@ -122,7 +131,7 @@ (def: #export (with-anchor anchor expr) (All [a] (-> Anchor (Meta a) (Meta a))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler))] (case (expr (set@ #.host (:! Void (set@ #anchor (#.Some anchor) old)) @@ -138,11 +147,9 @@ (#e.Error error) (#e.Error error))))) -(exception: #export No-Anchor) - (def: #export anchor (Meta Anchor) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor)) (#.Some anchor) (#e.Success [compiler anchor]) @@ -152,29 +159,29 @@ (def: #export module-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer)) #.None - ((lang.fail (No-Active-Module-Buffer "")) compiler) + ((lang.throw No-Active-Module-Buffer "") compiler) (#.Some module-buffer) (#e.Success [compiler module-buffer])))) (def: #export program-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))]))) (def: (execute code) (-> Expression (Meta Unit)) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #interpreter) (ScriptEngine::eval [code])) (#e.Error error) - ((lang.fail (Cannot-Execute error)) compiler) + ((lang.throw Cannot-Execute error) compiler) (#e.Success _) (#e.Success [compiler []])))) @@ -202,8 +209,6 @@ (nat-to-int (array.size value))])))) )) -(exception: #export Unknown-Member) - (def: #export int-high-field Text "H") (def: #export int-low-field Text "L") @@ -242,8 +247,9 @@ (|> value int-to-nat low jvm-int) ## else - (error! (Unknown-Member (format " member = " member "\n" - "object(int) = " (%i value) "\n"))))))) + (error! (ex.construct Unknown-Member + (format " member = " member "\n" + "object(int) = " (%i value) "\n"))))))) (interface: StructureValue (getValue [] (Array Object))) @@ -281,8 +287,8 @@ (::slice js-object value))) ## else - (error! (Unknown-Member (format " member = " (:! Text member) "\n" - "object(structure) = " (Object::toString [] (:! Object value)) "\n"))))) + (error! (ex.construct Unknown-Member (format " member = " (:! Text member) "\n" + "object(structure) = " (Object::toString [] (:! Object value)) "\n"))))) (AbstractJSObject (getSlot [idx int]) Object (|> value (array.read (|> idx (Integer::longValue []) (:! Nat))) diff --git a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux index 7c624c102..45b6ec10e 100644 --- a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux @@ -29,7 +29,7 @@ (Meta Expression)) (do macro.Monad<Meta> [valueJS (translate valueS)] - (wrap (list/fold (function [[idx tail?] source] + (wrap (list/fold (function (_ [idx tail?] source) (let [method (if tail? runtimeT.product//right runtimeT.product//left)] (format method "(" source "," (|> idx nat-to-int %i) ")"))) (format "(" valueJS ")") @@ -76,7 +76,8 @@ Statement (format "throw " pm-error ";")) -(exception: #export Unrecognized-Path) +(exception: #export (Unrecognized-Path {message Text}) + message) (def: (translate-pattern-matching' translate path) (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux index d4546ca4c..3d4dbc782 100644 --- a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux @@ -11,6 +11,16 @@ (lang (host [js #+ JS Expression Statement]))) [//]) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Unknown-Kind-Of-JS-Object] + [Null-Has-No-Lux-Representation] + + [Cannot-Evaluate] + ) + (host.import java/lang/Object (toString [] String)) @@ -101,9 +111,6 @@ (#.Some output)))) #.None)) -(exception: #export Unknown-Kind-Of-JS-Object) -(exception: #export Null-Has-No-Lux-Representation) - (def: (lux-object js-object) (-> Object (Error Top)) (`` (cond (host.null? js-object) @@ -152,11 +159,9 @@ ## else (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object)))))) -(exception: #export Cannot-Evaluate) - (def: #export (eval code) (-> Expression (Meta Top)) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! //.Host) diff --git a/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux index 9fbaca3d2..ba6c63e8f 100644 --- a/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux @@ -22,8 +22,13 @@ [".T" case] [".T" procedure])) -(exception: #export Invalid-Function-Syntax) -(exception: #export Unrecognized-Synthesis) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Function-Syntax] + [Unrecognized-Synthesis] + ) (def: #export (translate synthesis) (-> ls.Synthesis (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux index 725aff705..64f10dabc 100644 --- a/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux @@ -14,9 +14,14 @@ (luxc [lang] (lang [".L" module]))) -(exception: #export Invalid-Imports) -(exception: #export Module-Cannot-Import-Itself) -(exception: #export Circular-Dependency) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Imports] + [Module-Cannot-Import-Itself] + [Circular-Dependency] + ) (type: Import {#module Text @@ -39,7 +44,7 @@ (#e.Error error) (lang.throw Invalid-Imports (%code (code.tuple imports))))) - _ (monad.map @ (function [[dependency alias]] + _ (monad.map @ (function (_ [dependency alias]) (do @ [_ (lang.assert Module-Cannot-Import-Itself current-module (not (text/= current-module dependency))) @@ -58,7 +63,7 @@ imports) compiler macro.get-compiler] (wrap (monad.fold io.Monad<Process> - (function [import] + (function (_ import) (translate-module (get@ #module import))) compiler imports)))) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux index afedc42e0..f67c1e523 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux @@ -12,7 +12,8 @@ (/ ["/." common] ["/." host])) -(exception: #export Unknown-Procedure) +(exception: #export (Unknown-Procedure {message Text}) + message) (def: procedures /common.Bundle diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index 8b45557cd..365f730e3 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -51,7 +51,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: (wrong-arity proc expected actual) @@ -61,19 +61,19 @@ " Actual: " (|> actual nat-to-int %i))) (syntax: (arity: [name s.local-symbol] [arity s.nat]) - (with-gensyms [g!proc g!name g!translate g!inputs] + (with-gensyms [g!_ g!proc g!name g!translate g!inputs] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) (-> Text ..Proc)) - (function [(~ g!name)] - (function [(~ g!translate) (~ g!inputs)] + (function ((~ g!_) (~ g!name)) + (function ((~ g!_) (~ g!translate) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do macro.Monad<Meta> [(~+ (|> g!input+ - (list/map (function [g!input] + (list/map (function (_ g!input) (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) @@ -88,8 +88,8 @@ (def: #export (variadic proc) (-> Variadic (-> Text Proc)) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (do macro.Monad<Meta> [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) @@ -120,7 +120,9 @@ Unary valueJS) -(exception: #export Wrong-Syntax) +(exception: #export (Wrong-Syntax {message Text}) + message) + (def: #export (wrong-syntax procedure args) (-> Text (List ls.Synthesis) Text) (format "Procedure: " procedure "\n" @@ -128,8 +130,8 @@ (def: lux//loop (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) (#e.Success [offset initsS+ bodyS]) (loopT.translate-loop translate offset initsS+ bodyS) @@ -140,8 +142,8 @@ (def: lux//recur (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (loopT.translate-recur translate inputsS)))) ## [[Bits]] diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux index 2104dbf81..ea1b82e98 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -63,7 +63,7 @@ (`` (def: ((~' ~~) (runtime-implementation-name <lux-name>)) Runtime (feature <lux-name> - (function [(~' @)] + (function ((~' _) (~' @)) <js-definition>))))) (def: #export (int value) @@ -475,13 +475,13 @@ (runtime: int/// "divI64" (let [negate (|>> (list) (js.apply int//negate)) - negative? (function [value] + negative? (function (_ value) (js.apply int//< (list value int//zero))) valid-division-check [(=I int//zero "parameter") (js.throw! (js.string "Cannot divide by zero!"))] short-circuit-check [(=I int//zero "subject") (js.return! int//zero)] - recur (function [subject parameter] + recur (function (_ subject parameter) (js.apply @ (list subject parameter)))] (js.function @ (list "subject" "parameter") (list (js.cond! (list valid-division-check @@ -585,9 +585,9 @@ __int//%)) (runtime: nat//< "ltN64" - (let [high (function [i64] (format "(" i64 "." //.int-high-field ")")) - low (function [i64] (format "(" i64 "." //.int-low-field ")")) - i32 (function [word] (format "(" word " >>> 0)"))] + (let [high (function (_ i64) (format "(" i64 "." //.int-high-field ")")) + low (function (_ i64) (format "(" i64 "." //.int-low-field ")")) + i32 (function (_ word) (format "(" word " >>> 0)"))] (js.function @ (list "subject" "parameter") (list (js.return! (js.or (js.> (i32 (high "subject")) (i32 (high "parameter"))) @@ -615,7 +615,7 @@ (js.apply int//= (list subject param)))) (runtime: nat/// "divN64" - (let [negative? (function [value] + (let [negative? (function (_ value) (js.apply int//< (list value int//zero))) valid-division-check [(=I int//zero "parameter") (js.throw! (js.string "Cannot divide by zero!"))] diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux index b693f50b8..782639b25 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -52,7 +52,8 @@ (list)) false))) -(exception: #export Unrecognized-Path) +(exception: #export (Unrecognized-Path {message Text}) + message) (def: (translate-path' translate stack-depth @else @end path) (-> (-> ls.Synthesis (Meta $.Inst)) @@ -133,8 +134,8 @@ (^template [<special> <flag>] (^ [_ (#.Form (list [_ (#.Text <special>)] [_ (#.Nat idx)]))]) - (macro/wrap (<| $i.with-label (function [@success]) - $i.with-label (function [@fail]) + (macro/wrap (<| $i.with-label (function (_ @success)) + $i.with-label (function (_ @fail)) (|>> peekI ($i.CHECKCAST ($t.descriptor //runtime.$Variant)) ($i.int (nat-to-int idx)) @@ -194,8 +195,8 @@ (def: #export (translate-if testI thenI elseI) (-> $.Inst $.Inst $.Inst $.Inst) - (<| $i.with-label (function [@else]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @else)) + $i.with-label (function (_ @end)) (|>> testI ($i.unwrap #$.Boolean) ($i.IFEQ @else) diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux index c78b0baeb..579eb565c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -48,16 +48,21 @@ #store Class-Store #artifacts Artifacts}) -(exception: #export Unknown-Class) -(exception: #export Class-Already-Stored) -(exception: #export No-Function-Being-Compiled) -(exception: #export Cannot-Overwrite-Artifact) -(exception: #export Cannot-Load-Definition) -(exception: #export Invalid-Definition-Value) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Unknown-Class] + [Class-Already-Stored] + [No-Function-Being-Compiled] + [Cannot-Overwrite-Artifact] + [Cannot-Load-Definition] + [Invalid-Definition-Value] + ) (def: #export (with-artifacts action) (All [a] (-> (Meta a) (Meta [Artifacts a]))) - (function [compiler] + (function (_ compiler) (case (action (update@ #.host (|>> (:! Host) (set@ #artifacts (dict.new text.Hash<Text>)) @@ -77,7 +82,7 @@ (def: #export (record-artifact name content) (-> Text Blob (Meta Unit)) - (function [compiler] + (function (_ compiler) (if (|> compiler (get@ #.host) (:! Host) (get@ #artifacts) (dict.contains? name)) (ex.throw Cannot-Overwrite-Artifact name) (#e.Success [(update@ #.host @@ -89,18 +94,18 @@ (def: #export (store-class name byte-code) (-> Text Bytecode (Meta Unit)) - (function [compiler] + (function (_ compiler) (let [store (|> (get@ #.host compiler) (:! Host) (get@ #store))] (if (dict.contains? name (|> store atom.read io.run)) (ex.throw Class-Already-Stored name) - (#e.Success [compiler (io.run (atom.update (dict.put name byte-code) store))]) - )))) + (exec (io.run (atom.update (dict.put name byte-code) store)) + (#e.Success [compiler []])))))) (def: #export (load-class name) (-> Text (Meta (Class Object))) - (function [compiler] + (function (_ compiler) (let [host (:! Host (get@ #.host compiler)) store (|> host (get@ #store) atom.read io.run)] (if (dict.contains? name store) @@ -113,7 +118,7 @@ (def: #export (load-definition compiler) (-> Compiler (-> Ident Blob (Error Top))) - (function [(^@ def-ident [def-module def-name]) def-bytecode] + (function (_ (^@ def-ident [def-module def-name]) def-bytecode) (let [normal-name (format (lang.normalize-name def-name) (%n (text/hash def-name))) class-name (format (text.replace-all "/" "." def-module) "." normal-name)] (<| (macro.run compiler) diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux index 67a6935ba..42b4f3358 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux @@ -21,8 +21,13 @@ [".T" case] [".T" procedure])) -(exception: #export Invalid-Function-Syntax) -(exception: #export Unrecognized-Synthesis) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Function-Syntax] + [Unrecognized-Synthesis] + ) (def: #export (translate synthesis) (-> ls.Synthesis (Meta $.Inst)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux index 6fb446bc4..f5799e572 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -88,7 +88,7 @@ (def: (with-captured env) (-> (List Variable) $.Def) (|> (list.enumerate env) - (list/map (function [[env-idx env-source]] + (list/map (function (_ [env-idx env-source]) ($d.field #$.Private $.finalF (referenceT.captured env-idx) $Object))) $d.fuse)) @@ -96,7 +96,7 @@ (-> ls.Arity $.Def) (if (poly-arg? arity) (|> (list.n/range +0 (n/- +2 arity)) - (list/map (function [idx] + (list/map (function (_ idx) ($d.field #$.Private $.finalF (referenceT.partial idx) $Object))) $d.fuse) id)) @@ -124,7 +124,7 @@ captureI (|> (case env-size +0 (list) _ (list.n/range +0 (n/dec env-size))) - (list/map (function [source] + (list/map (function (_ source) (|>> ($i.ALOAD +0) ($i.GETFIELD class (referenceT.captured source) $Object)))) $i.fuse) @@ -167,14 +167,14 @@ store-capturedI (|> (case env-size +0 (list) _ (list.n/range +0 (n/dec env-size))) - (list/map (function [register] + (list/map (function (_ register) (|>> ($i.ALOAD +0) ($i.ALOAD (n/inc register)) ($i.PUTFIELD class (referenceT.captured register) $Object)))) $i.fuse) store-partialI (if (poly-arg? arity) (|> (list.n/range +0 (n/- +2 arity)) - (list/map (function [idx] + (list/map (function (_ idx) (let [register (offset-partial idx)] (|>> ($i.ALOAD +0) ($i.ALOAD (n/inc register)) @@ -197,7 +197,7 @@ arity-over-extent (|> (nat-to-int function-arity) (i/- (nat-to-int apply-arity))) casesI (|> (list/compose @labels (list @default)) (list.zip2 (list.n/range +0 num-partials)) - (list/map (function [[stage @label]] + (list/map (function (_ [stage @label]) (let [load-partialsI (if (n/> +0 stage) (|> (list.n/range +0 (n/dec stage)) (list/map (|>> referenceT.partial (load-fieldI class))) @@ -316,7 +316,7 @@ [functionI (translate functionS) argsI (monad.map @ translate argsS) #let [applyI (|> (segment runtimeT.num-apply-variants argsI) - (list/map (function [chunkI+] + (list/map (function (_ chunkI+) (|>> ($i.CHECKCAST hostL.function-class) ($i.fuse chunkI+) ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature (list.size chunkI+)) false)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux index 892dd869f..44314fcf2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux @@ -21,9 +21,14 @@ (luxc ["&" lang] (lang [".L" module]))) -(exception: #export Invalid-Imports) -(exception: #export Module-Cannot-Import-Itself) -(exception: #export Circular-Dependency) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Imports] + [Module-Cannot-Import-Itself] + [Circular-Dependency] + ) (host.import (java/util/concurrent/Future a) (get [] #io a)) @@ -47,7 +52,7 @@ (All [a] (-> (Promise a) (Future a))) (let [future (CompletableFuture::new [])] (exec (:: promise.Functor<Promise> map - (function [value] (CompletableFuture::complete [value] future)) + (function (_ value) (CompletableFuture::complete [value] future)) promise) future))) @@ -95,7 +100,7 @@ (-> Text (List [Text Module]) (List [Text Module]) (List [Text Module])) (|> from-dependency (list.filter (|>> product.right compiled?)) - (list/fold (function [[dep-name dep-module] total] (&.pl-put dep-name dep-module total)) + (list/fold (function (_ [dep-name dep-module] total) (&.pl-put dep-name dep-module total)) from-current))) (def: (merge-compilers current-module dependency total) @@ -120,7 +125,7 @@ (#e.Error error) (&.throw Invalid-Imports (%code (code.tuple imports))))) dependencies (monad.map @ (: (-> [Text Text] (Meta (IO (Future (Error Compiler))))) - (function [[dependency alias]] + (function (_ [dependency alias]) (do @ [_ (&.assert Module-Cannot-Import-Itself current-module (not (text/= current-module dependency))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux index 2e585fb11..fab4a7efe 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -45,13 +45,13 @@ ## and stores separately, then by the time Y is evaluated, it ## will refer to the new value of X, instead of the old value, as ## must be the case. - valuesI+ (monad.map @ (function [[register argS]] + valuesI+ (monad.map @ (function (_ [register argS]) (: (Meta $.Inst) (if (constant? register argS) (wrap id) (translate argS)))) pairs) - #let [storesI+ (list/map (function [[register argS]] + #let [storesI+ (list/map (function (_ [register argS]) (: $.Inst (if (constant? register argS) id @@ -71,7 +71,7 @@ bodyI (hostL.with-anchor [@begin offset] (translate bodyS)) #let [initializationI (|> (list.enumerate initsI+) - (list/map (function [[register initI]] + (list/map (function (_ [register initI]) (|>> initI ($i.ASTORE (n/+ offset register))))) $i.fuse)]] diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux index e4f8b9908..3f852d832 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux @@ -11,7 +11,8 @@ (/ ["/." common] ["/." host])) -(exception: #export Unknown-Procedure) +(exception: #export (Unknown-Procedure {message Text}) + message) (def: procedures /common.Bundle diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index abd2d49c8..158d4c788 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -72,7 +72,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: (wrong-arity proc expected actual) @@ -82,19 +82,19 @@ " Actual: " (|> actual nat-to-int %i))) (syntax: (arity: [name s.local-symbol] [arity s.nat]) - (with-gensyms [g!proc g!name g!translate g!inputs] + (with-gensyms [g!_ g!proc g!name g!translate g!inputs] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst) (-> Text ..Proc)) - (function [(~ g!name)] - (function [(~ g!translate) (~ g!inputs)] + (function ((~ g!_) (~ g!name)) + (function ((~ g!_) (~ g!translate) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do macro.Monad<Meta> [(~+ (|> g!input+ - (list/map (function [g!input] + (list/map (function (_ g!input) (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) @@ -109,8 +109,8 @@ (def: #export (variadic proc) (-> Variadic (-> Text Proc)) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (do macro.Monad<Meta> [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) @@ -131,8 +131,8 @@ (def: (predicateI tester) (-> (-> $.Label $.Inst) $.Inst) - (<| $i.with-label (function [@then]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @then)) + $i.with-label (function (_ @end)) (|>> (tester @then) ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) ($i.GOTO @end) @@ -167,7 +167,9 @@ Unary valueI) -(exception: #export Wrong-Syntax) +(exception: #export (Wrong-Syntax {message Text}) + message) + (def: #export (wrong-syntax procedure args) (-> Text (List ls.Synthesis) Text) (format "Procedure: " procedure "\n" @@ -175,8 +177,8 @@ (def: lux//loop (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) (#e.Success [offset initsS+ bodyS]) (loopT.translate-loop translate offset initsS+ bodyS) @@ -187,8 +189,8 @@ (def: lux//recur (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (loopT.translate-recur translate inputsS)))) ## [[Bits]] @@ -230,8 +232,8 @@ (def: (array//get [arrayI idxI]) Binary - (<| $i.with-label (function [@is-null]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @is-null)) + $i.with-label (function (_ @end)) (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) idxI jvm-intI $i.AALOAD @@ -435,8 +437,8 @@ (def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list))) (def: (text//index [textI partI startI]) Trinary - (<| $i.with-label (function [@not-found]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @not-found)) + $i.with-label (function (_ @end)) (|>> textI ($i.CHECKCAST "java.lang.String") partI ($i.CHECKCAST "java.lang.String") startI jvm-intI diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux index 609a0833c..f8461be45 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux @@ -25,8 +25,13 @@ ["ls" synthesis])) (// ["@" common])) -(exception: #export Invalid-Syntax-For-JVM-Type) -(exception: #export Invalid-Syntax-For-Argument-Generation) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Syntax-For-JVM-Type] + [Invalid-Syntax-For-Argument-Generation] + ) (do-template [<name> <inst>] [(def: <name> @@ -41,7 +46,7 @@ (do-template [<name> <unwrap> <conversion> <wrap>] [(def: (<name> inputI) @.Unary - (if (is $i.NOP <conversion>) + (if (is? $i.NOP <conversion>) (|>> inputI ($i.unwrap <unwrap>) ($i.wrap <wrap>)) @@ -153,8 +158,8 @@ (do-template [<name> <op> <unwrapX> <unwrapY> <wrap>] [(def: (<name> [xI yI]) @.Binary - (<| $i.with-label (function [@then]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @then)) + $i.with-label (function (_ @end)) (|>> xI ($i.unwrap <unwrapX>) yI ($i.unwrap <unwrapY>) (<op> @then) @@ -174,8 +179,8 @@ (do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>] [(def: (<name> [xI yI]) @.Binary - (<| $i.with-label (function [@then]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @then)) + $i.with-label (function (_ @end)) (|>> xI ($i.unwrap <unwrapX>) yI ($i.unwrap <unwrapY>) <op> @@ -371,8 +376,8 @@ (def: (object//null? objectI) @.Unary - (<| $i.with-label (function [@then]) - $i.with-label (function [@end]) + (<| $i.with-label (function (_ @then)) + $i.with-label (function (_ @end)) (|>> objectI ($i.IFNULL @then) ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) @@ -616,7 +621,7 @@ (p.after (l.this "float") (parser/wrap $t.float)) (p.after (l.this "double") (parser/wrap $t.double)) (p.after (l.this "char") (parser/wrap $t.char)) - (parser/map (function [name] + (parser/map (function (_ name) ($t.class name (list))) (l.many (l.none-of "["))) )) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 2cd1c75a9..b394a7f53 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -32,7 +32,7 @@ (def: #export logI $.Inst (let [outI ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) - printI (function [method] ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) false))] + printI (function (_ method) ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) false))] (|>> outI ($i.string "LOG: ") (printI "print") outI $i.SWAP (printI "println")))) @@ -71,9 +71,9 @@ (def: (try-methodI unsafeI) (-> $.Inst $.Inst) - (<| $i.with-label (function [@from]) - $i.with-label (function [@to]) - $i.with-label (function [@handler]) + (<| $i.with-label (function (_ @from)) + $i.with-label (function (_ @to)) + $i.with-label (function (_ @handler)) (|>> ($i.try @from @to @handler "java.lang.Exception") ($i.label @from) unsafeI @@ -103,13 +103,13 @@ store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE) force-textMT ($t.method (list $Object) (#.Some $String) (list))] (|>> ($d.method #$.Public $.staticM "force_text" force-textMT - (<| $i.with-label (function [@is-null]) - $i.with-label (function [@normal-object]) - $i.with-label (function [@array-loop]) - $i.with-label (function [@within-bounds]) - $i.with-label (function [@is-first]) - $i.with-label (function [@elem-end]) - $i.with-label (function [@fold-end]) + (<| $i.with-label (function (_ @is-null)) + $i.with-label (function (_ @normal-object)) + $i.with-label (function (_ @array-loop)) + $i.with-label (function (_ @within-bounds)) + $i.with-label (function (_ @is-first)) + $i.with-label (function (_ @elem-end)) + $i.with-label (function (_ @fold-end)) (let [on-normal-objectI (|>> ($i.ALOAD +0) ($i.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) false)) on-null-objectI ($i.string "NULL") @@ -170,7 +170,7 @@ (def: nat-methods $.Def (let [compare-nat-method ($t.method (list $t.long $t.long) (#.Some $t.int) (list)) - less-thanI (function [@where] (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where))) + less-thanI (function (_ @where) (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where))) $BigInteger ($t.class "java.math.BigInteger" (list)) upcast-method ($t.method (list $t.long) (#.Some $BigInteger) (list)) div-method ($t.method (list $t.long $t.long) (#.Some $t.long) (list)) @@ -178,14 +178,14 @@ downcastI ($i.INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t.method (list) (#.Some $t.long) (list)) false)] (|>> ($d.method #$.Public $.staticM "_toUnsignedBigInteger" upcast-method (let [upcastI ($i.INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false) - discernI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where))) + discernI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where))) prepare-upperI (|>> ($i.LLOAD +0) ($i.int 32) $i.LUSHR upcastI ($i.int 32) ($i.INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t.method (list $t.int) (#.Some $BigInteger) (list)) false)) prepare-lowerI (|>> ($i.LLOAD +0) ($i.int 32) $i.LSHL ($i.int 32) $i.LUSHR upcastI)] - (<| $i.with-label (function [@simple]) + (<| $i.with-label (function (_ @simple)) (|>> (discernI @simple) ## else prepare-upperI @@ -204,13 +204,13 @@ $i.LCMP $i.IRETURN))) ($d.method #$.Public $.staticM "div_nat" div-method - (let [is-param-largeI (function [@where] (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where))) - is-subject-smallI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where))) + (let [is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where))) + is-subject-smallI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where))) small-division (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LDIV $i.LRETURN) big-divisionI ($i.INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)] - (<| $i.with-label (function [@is-zero]) - $i.with-label (function [@param-is-large]) - $i.with-label (function [@subject-is-small]) + (<| $i.with-label (function (_ @is-zero)) + $i.with-label (function (_ @param-is-large)) + $i.with-label (function (_ @subject-is-small)) (|>> (is-param-largeI @param-is-large) ## Param is not too large (is-subject-smallI @subject-is-small) @@ -233,12 +233,12 @@ ($i.label @is-zero) ($i.long 0) $i.LRETURN)))) ($d.method #$.Public $.staticM "rem_nat" div-method - (let [is-subject-largeI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where))) - is-param-largeI (function [@where] (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where))) + (let [is-subject-largeI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where))) + is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where))) small-remainderI (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LREM $i.LRETURN) big-remainderI ($i.INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)] - (<| $i.with-label (function [@large-number]) - $i.with-label (function [@subject-is-smaller-than-param]) + (<| $i.with-label (function (_ @large-number)) + $i.with-label (function (_ @subject-is-smaller-than-param)) (|>> (is-subject-largeI @large-number) (is-param-largeI @large-number) small-remainderI @@ -315,11 +315,11 @@ topI $i.LADD $i.LRETURN))) ($d.method #$.Public $.staticM "count_leading_zeros" clz-method - (let [when-zeroI (function [@where] (|>> ($i.long 0) $i.LCMP ($i.IFEQ @where))) - shift-rightI (function [amount] (|>> ($i.int amount) $i.LUSHR)) + (let [when-zeroI (function (_ @where) (|>> ($i.long 0) $i.LCMP ($i.IFEQ @where))) + shift-rightI (function (_ amount) (|>> ($i.int amount) $i.LUSHR)) decI (|>> ($i.int 1) $i.ISUB)] - (<| $i.with-label (function [@start]) - $i.with-label (function [@done]) + (<| $i.with-label (function (_ @start)) + $i.with-label (function (_ @done)) (|>> ($i.int 64) ($i.label @start) ($i.LLOAD +0) (when-zeroI @done) @@ -329,10 +329,10 @@ ($i.label @done) $i.IRETURN)))) ($d.method #$.Public $.staticM "div_deg" deg-method - (<| $i.with-label (function [@same]) + (<| $i.with-label (function (_ @same)) (let [subjectI ($i.LLOAD +0) paramI ($i.LLOAD +2) - equal?I (function [@where] (|>> $i.LCMP ($i.IFEQ @where))) + equal?I (function (_ @where) (|>> $i.LCMP ($i.IFEQ @where))) count-leading-zerosI ($i.INVOKESTATIC hostL.runtime-class "count_leading_zeros" clz-method false) calc-max-shiftI (|>> subjectI count-leading-zerosI paramI count-leading-zerosI @@ -424,14 +424,14 @@ $i.AALOAD $i.ARETURN)) ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list)) - (<| $i.with-label (function [@begin]) - $i.with-label (function [@just-return]) - $i.with-label (function [@then]) - $i.with-label (function [@further]) - $i.with-label (function [@shorten]) - $i.with-label (function [@wrong]) + (<| $i.with-label (function (_ @begin)) + $i.with-label (function (_ @just-return)) + $i.with-label (function (_ @then)) + $i.with-label (function (_ @further)) + $i.with-label (function (_ @shorten)) + $i.with-label (function (_ @wrong)) (let [variant-partI (: (-> Nat $.Inst) - (function [idx] + (function (_ idx) (|>> ($i.int (nat-to-int idx)) $i.AALOAD))) tagI (: $.Inst (|>> (variant-partI +0) ($i.unwrap #$.Int))) @@ -476,8 +476,8 @@ ## $i.POP2 failureI))) ($d.method #$.Public $.staticM "pm_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) - (<| $i.with-label (function [@begin]) - $i.with-label (function [@not-recursive]) + (<| $i.with-label (function (_ @begin)) + $i.with-label (function (_ @not-recursive)) (let [updated-idxI (|>> $i.SWAP $i.ISUB)]) (|>> ($i.label @begin) tuple-sizeI @@ -492,9 +492,9 @@ tuple-elemI $i.ARETURN))) ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) - (<| $i.with-label (function [@begin]) - $i.with-label (function [@tail]) - $i.with-label (function [@slice]) + (<| $i.with-label (function (_ @begin)) + $i.with-label (function (_ @tail)) + $i.with-label (function (_ @slice)) (let [updated-idxI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD tuple-sizeI $i.ISUB) sliceI (|>> ($i.ALOAD +0) ($i.ILOAD +1) tuple-sizeI ($i.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) false))]) @@ -530,9 +530,9 @@ ($i.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) false) )] (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list)) - (<| $i.with-label (function [@from]) - $i.with-label (function [@to]) - $i.with-label (function [@handler]) + (<| $i.with-label (function (_ @from)) + $i.with-label (function (_ @to)) + $i.with-label (function (_ @handler)) (|>> ($i.try @from @to @handler "java.lang.Throwable") ($i.label @from) ($i.ALOAD +0) @@ -559,13 +559,13 @@ endI (|>> ($i.string hostL.unit) $i.ARETURN) runnableI (: (-> $.Inst $.Inst) - (function [functionI] + (function (_ functionI) (|>> ($i.NEW hostL.runnable-class) $i.DUP functionI ($i.INVOKESPECIAL hostL.runnable-class "<init>" ($t.method (list $Function) #.None (list)) false)))) threadI (: (-> $.Inst $.Inst) - (function [runnableI] + (function (_ runnableI) (|>> ($i.NEW "java.lang.Thread") $i.DUP runnableI @@ -604,7 +604,7 @@ schedule-immediatelyI (|>> executorI (runnableI ($i.ALOAD +2)) ($i.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) false))] - (<| $i.with-label (function [@immediately]) + (<| $i.with-label (function (_ @immediately)) (|>> immediacy-checkI ($i.IFEQ @immediately) schedule-laterI @@ -635,7 +635,7 @@ (do macro.Monad<Meta> [_ (wrap []) #let [applyI (|> (list.n/range +2 num-apply-variants) - (list/map (function [arity] + (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) (let [preI (|> (list.n/range +0 (n/dec arity)) (list/map $i.ALOAD) diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux index 5edd62aec..26aaaa8e9 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -22,8 +22,13 @@ [".T" common] [".T" runtime])) -(exception: #export Invalid-Definition-Value) -(exception: #export Cannot-Evaluate-Definition) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Definition-Value] + [Cannot-Evaluate-Definition] + ) (host.import java/lang/reflect/Field (get [#? Object] #try #? Object)) @@ -116,8 +121,8 @@ $i.DUP2_X1 $i.POP2 runtimeT.variantI) - prepare-input-listI (<| $i.with-label (function [@loop]) - $i.with-label (function [@end]) + prepare-input-listI (<| $i.with-label (function (_ @loop)) + $i.with-label (function (_ @end)) (|>> nilI num-inputsI ($i.label @loop) diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux index ddb6541cf..4a98d346d 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -16,7 +16,8 @@ ["ls" synthesis])) (// [".T" common])) -(exception: #export Not-A-Tuple) +(exception: #export (Not-A-Tuple {message Text}) + message) (def: $Object $.Type ($t.class "java.lang.Object" (list))) @@ -28,7 +29,7 @@ (n/>= +2 size)) membersI (|> members list.enumerate - (monad.map @ (function [[idx member]] + (monad.map @ (function (_ [idx member]) (do @ [memberI (translate member)] (wrap (|>> $i.DUP diff --git a/new-luxc/source/luxc/lang/translation/lua.lux b/new-luxc/source/luxc/lang/translation/lua.lux index 115471cbe..fdd66af81 100644 --- a/new-luxc/source/luxc/lang/translation/lua.lux +++ b/new-luxc/source/luxc/lang/translation/lua.lux @@ -18,6 +18,16 @@ (host [lua #+ Lua Expression Statement])) [".C" io])) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [No-Active-Module-Buffer] + [Cannot-Execute] + + [No-Anchor] + ) + (host.import java/lang/Object) (host.import java/lang/String @@ -83,7 +93,7 @@ variable (Variable::new [table]) loader (CompilerChunkLoader::of ["_lux_definition"]) executor (DirectCallExecutor::newExecutor [])] - (function [code] + (function (_ code) (let [lua-function (ChunkLoader::loadTextChunk [variable "lux compilation" code] loader)] ("lux try" (io (DirectCallExecutor::call [state-context (:! Object lua-function) (array.new +0)] @@ -95,7 +105,7 @@ (def: #export init-module-buffer (Meta Unit) - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.host (|>> (:! Host) (set@ #module-buffer (#.Some (StringBuilder::new []))) @@ -103,12 +113,9 @@ compiler) []]))) -(exception: #export No-Active-Module-Buffer) -(exception: #export Cannot-Execute) - (def: #export (with-sub-context expr) (All [a] (-> (Meta a) (Meta [Text a]))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) new-name (format old-name "___" (%i (nat-to-int old-sub)))] @@ -128,7 +135,7 @@ (def: #export context (Meta Text) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> (get@ #.host compiler) (:! Host) @@ -138,7 +145,7 @@ (def: #export (with-anchor anchor expr) (All [a] (-> Anchor (Meta a) (Meta a))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler))] (case (expr (set@ #.host (:! Void (set@ #anchor (#.Some anchor) old)) @@ -154,11 +161,9 @@ (#e.Error error) (#e.Error error))))) -(exception: #export No-Anchor) - (def: #export anchor (Meta Anchor) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor)) (#.Some anchor) (#e.Success [compiler anchor]) @@ -168,32 +173,30 @@ (def: #export module-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer)) #.None - ((lang.fail (No-Active-Module-Buffer "")) compiler) + ((lang.throw No-Active-Module-Buffer "") compiler) (#.Some module-buffer) (#e.Success [compiler module-buffer])))) (def: #export program-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))]))) (def: (execute code) (-> Expression (Meta Unit)) - (function [compiler] + (function (_ compiler) (let [interpreter (|> compiler (get@ #.host) (:! Host) (get@ #interpreter))] (case (interpreter code) (#e.Error error) - ((lang.fail (Cannot-Execute error)) compiler) + ((lang.throw Cannot-Execute error) compiler) (#e.Success _) (#e.Success [compiler []]))))) -(exception: #export Unknown-Member) - (def: #export variant-tag-field "_lux_tag") (def: #export variant-flag-field "_lux_flag") (def: #export variant-value-field "_lux_value") diff --git a/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux index bce4d7bff..1853338b4 100644 --- a/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux @@ -34,7 +34,7 @@ (Meta Expression)) (do macro.Monad<Meta> [valueO (translate valueS)] - (wrap (list/fold (function [[idx tail?] source] + (wrap (list/fold (function (_ [idx tail?] source) (let [method (if tail? runtimeT.product//right runtimeT.product//left)] @@ -81,7 +81,8 @@ Expression (lua.string "PM-ERROR")) -(exception: #export Unrecognized-Path) +(exception: #export (Unrecognized-Path {message Text}) + message) (def: (translate-pattern-matching' translate path) (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux index c42ba0668..8be5667e9 100644 --- a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux @@ -11,6 +11,15 @@ (lang (host [lua #+ Lua Expression Statement]))) [//]) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Unknown-Kind-Of-Host-Object] + [Null-Has-No-Lux-Representation] + [Cannot-Evaluate] + ) + (host.import java/lang/Object (toString [] String) (getClass [] (Class Object))) @@ -64,9 +73,6 @@ (recur num-keys (n/inc idx) output)) (#.Some output))))) -(exception: #export Unknown-Kind-Of-Host-Object) -(exception: #export Null-Has-No-Lux-Representation) - (def: (lux-object host-object) (-> Object (Error Top)) (`` (cond (host.null? host-object) @@ -99,11 +105,9 @@ (ex.throw Unknown-Kind-Of-Host-Object (format "FIRST " (Object::toString [] (:! Object host-object)))) ))) -(exception: #export Cannot-Evaluate) - (def: #export (eval code) (-> Expression (Meta Top)) - (function [compiler] + (function (_ compiler) (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))] (case (interpreter (format "return " code ";")) (#e.Error error) diff --git a/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux index d3d336420..e2c626e83 100644 --- a/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux @@ -22,8 +22,13 @@ [".T" case] [".T" procedure])) -(exception: #export Invalid-Function-Syntax) -(exception: #export Unrecognized-Synthesis) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Function-Syntax] + [Unrecognized-Synthesis] + ) (def: #export (translate synthesis) (-> ls.Synthesis (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux index 1750cd3eb..042ddd824 100644 --- a/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux @@ -72,7 +72,7 @@ (let [unpack (|>> (list) (lua.apply "table.unpack")) recur (|>> (list) (lua.apply function-name))] (lua.if! (lua.> arityO "num_args") - (let [slice (function [from to] + (let [slice (function (_ from to) (runtimeT.array//sub "curried" from to)) arity-args (unpack (slice (lua.int 1) arityO)) output-func-args (unpack (slice (lua.+ (lua.int 1) arityO) "num_args"))] diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux index e25050ede..9b5cb6475 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux @@ -12,7 +12,8 @@ (/ ["/." common] ["/." host])) -(exception: #export Unknown-Procedure) +(exception: #export (Unknown-Procedure {message Text}) + message) (def: procedures /common.Bundle diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index 77e57a5db..9d0e22f78 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -51,7 +51,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: (wrong-arity proc expected actual) @@ -61,19 +61,19 @@ " Actual: " (|> actual nat-to-int %i))) (syntax: (arity: [name s.local-symbol] [arity s.nat]) - (with-gensyms [g!proc g!name g!translate g!inputs] + (with-gensyms [g_ g!proc g!name g!translate g!inputs] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) (-> Text ..Proc)) - (function [(~ g!name)] - (function [(~ g!translate) (~ g!inputs)] + (function ((~ g_ ) (~ g!name)) + (function ((~ g_ ) (~ g!translate) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do macro.Monad<Meta> [(~+ (|> g!input+ - (list/map (function [g!input] + (list/map (function (_ g!input) (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) @@ -88,8 +88,8 @@ (def: #export (variadic proc) (-> Variadic (-> Text Proc)) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (do macro.Monad<Meta> [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) @@ -112,7 +112,9 @@ Unary valueO) -(exception: #export Wrong-Syntax) +(exception: #export (Wrong-Syntax {message Text}) + message) + (def: #export (wrong-syntax procedure args) (-> Text (List ls.Synthesis) Text) (format "Procedure: " procedure "\n" @@ -120,8 +122,8 @@ (def: lux//loop (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) (#e.Success [offset initsS+ bodyS]) (loopT.translate-loop translate offset initsS+ bodyS) @@ -132,8 +134,8 @@ (def: lux//recur (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (loopT.translate-recur translate inputsS)))) ## [[Bits]] diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux index 50b8008dd..137e5d4ab 100644 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux @@ -77,7 +77,7 @@ _ (` (let [(~' @) (~ runtime) (~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function [[left right]] (list left right))) + (list/map (function (_ [left right]) (list left right))) list/join))] (lua.function! (~ runtime) (list (~+ argsLC+)) (~ definition)))))))))))) @@ -95,7 +95,7 @@ (lua.return! "temp")))) (runtime: (array//concat left right) - (let [copy! (function [input output] + (let [copy! (function (_ input output) (lua.for-step! "idx" (lua.int 1) (format input ".n") (lua.int 1) (lua.apply "table.insert" (list output (lua.nth "idx" input)))))] (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) diff --git a/new-luxc/source/luxc/lang/translation/python.lux b/new-luxc/source/luxc/lang/translation/python.lux index 7304ea560..77df53332 100644 --- a/new-luxc/source/luxc/lang/translation/python.lux +++ b/new-luxc/source/luxc/lang/translation/python.lux @@ -18,6 +18,16 @@ (host [python #+ Expression Statement])) [".C" io])) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [No-Active-Module-Buffer] + [Cannot-Execute] + + [No-Anchor] + ) + (host.import java/lang/Object) (host.import java/lang/String @@ -54,9 +64,9 @@ (io (let [interpreter (PythonInterpreter::new [])] {#context ["" +0] #anchor #.None - #loader (function [code] + #loader (function (_ code) ("lux try" (io (PythonInterpreter::exec [(python.statement code)] interpreter)))) - #interpreter (function [code] + #interpreter (function (_ code) ("lux try" (io (PythonInterpreter::eval [(python.expression code)] interpreter)))) #module-buffer #.None #program-buffer (StringBuilder::new [])}))) @@ -65,7 +75,7 @@ (def: #export init-module-buffer (Meta Unit) - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.host (|>> (:! Host) (set@ #module-buffer (#.Some (StringBuilder::new []))) @@ -73,12 +83,9 @@ compiler) []]))) -(exception: #export No-Active-Module-Buffer) -(exception: #export Cannot-Execute) - (def: #export (with-sub-context expr) (All [a] (-> (Meta a) (Meta [Text a]))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) new-name (format old-name "___" (%i (nat-to-int old-sub)))] @@ -98,7 +105,7 @@ (def: #export context (Meta Text) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> (get@ #.host compiler) (:! Host) @@ -108,7 +115,7 @@ (def: #export (with-anchor anchor expr) (All [a] (-> Anchor (Meta a) (Meta a))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler))] (case (expr (set@ #.host (:! Void (set@ #anchor (#.Some anchor) old)) @@ -124,11 +131,9 @@ (#e.Error error) (#e.Error error))))) -(exception: #export No-Anchor) - (def: #export anchor (Meta Anchor) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor)) (#.Some anchor) (#e.Success [compiler anchor]) @@ -138,27 +143,27 @@ (def: #export module-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer)) #.None - ((lang.fail (No-Active-Module-Buffer "")) compiler) + ((lang.throw No-Active-Module-Buffer "") compiler) (#.Some module-buffer) (#e.Success [compiler module-buffer])))) (def: #export program-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))]))) (do-template [<name> <field> <inputT> <outputT>] [(def: (<name> code) (-> <inputT> (Meta <outputT>)) - (function [compiler] + (function (_ compiler) (let [runner (|> compiler (get@ #.host) (:! Host) (get@ <field>))] (case (runner code) (#e.Error error) - ((lang.fail (Cannot-Execute error)) compiler) + ((lang.throw Cannot-Execute error) compiler) (#e.Success output) (#e.Success [compiler output])))))] @@ -167,8 +172,6 @@ [interpret #interpreter Expression PyObject] ) -(exception: #export Unknown-Member) - (def: #export variant-tag-field "_lux_tag") (def: #export variant-flag-field "_lux_flag") (def: #export variant-value-field "_lux_value") diff --git a/new-luxc/source/luxc/lang/translation/python/case.jvm.lux b/new-luxc/source/luxc/lang/translation/python/case.jvm.lux index 2218c1994..2668ae9f2 100644 --- a/new-luxc/source/luxc/lang/translation/python/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/case.jvm.lux @@ -34,7 +34,7 @@ (Meta Expression)) (do macro.Monad<Meta> [valueO (translate valueS)] - (wrap (list/fold (function [[idx tail?] source] + (wrap (list/fold (function (_ [idx tail?] source) (let [method (if tail? runtimeT.product//right runtimeT.product//left)] @@ -85,7 +85,8 @@ (def: $temp (python.var "temp")) -(exception: #export Unrecognized-Path) +(exception: #export (Unrecognized-Path {message Text}) + message) (def: $alt_error (python.var "alt_error")) diff --git a/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux index bc6e1a342..164d088df 100644 --- a/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux @@ -11,6 +11,16 @@ (lang (host [python #+ Expression Statement]))) [//]) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Not-A-Variant] + [Unknown-Kind-Of-Host-Object] + [Null-Has-No-Lux-Representation] + [Cannot-Evaluate] + ) + (host.import java/lang/Object (toString [] String) (getClass [] (Class Object))) @@ -57,8 +67,6 @@ (-> PyObject Text) (|>> (PyObject::getType []) (PyType::getName []) (:! Text))) -(exception: #export Not-A-Variant) - (def: tag-field (PyString::new [//.variant-tag-field])) (def: flag-field (PyString::new [//.variant-flag-field])) (def: value-field (PyString::new [//.variant-value-field])) @@ -89,9 +97,6 @@ _ (ex.throw Not-A-Variant (Object::toString [] host-object)))) -(exception: #export Unknown-Kind-Of-Host-Object) -(exception: #export Null-Has-No-Lux-Representation) - (def: (lux-object host-object) (-> PyObject (Error Top)) (case (python-type host-object) @@ -119,11 +124,9 @@ type (ex.throw Unknown-Kind-Of-Host-Object (format type " " (Object::toString [] host-object))))) -(exception: #export Cannot-Evaluate) - (def: #export (eval code) (-> Expression (Meta Top)) - (function [compiler] + (function (_ compiler) (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))] (case (interpreter code) (#e.Error error) @@ -136,7 +139,7 @@ (case (lux-object output) (#e.Success parsed-output) (exec ## (log! (format "eval #e.Success\n" - ## "<< " (python.expression code))) + ## "<< " (python.expression code))) (#e.Success [compiler parsed-output])) (#e.Error error) diff --git a/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux index 6a7497c22..d153d8953 100644 --- a/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux @@ -21,8 +21,13 @@ [".T" case] [".T" procedure])) -(exception: #export Invalid-Function-Syntax) -(exception: #export Unrecognized-Synthesis) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Function-Syntax] + [Unrecognized-Synthesis] + ) (def: #export (translate synthesis) (-> ls.Synthesis (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux index a46778503..699c0c000 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux @@ -12,7 +12,8 @@ (/ ["/." common] ["/." host])) -(exception: #export Unknown-Procedure) +(exception: #export (Unknown-Procedure {message Text}) + message) (def: procedures /common.Bundle diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index 6205d22a7..badca2d74 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -52,7 +52,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: (wrong-arity proc expected actual) @@ -62,19 +62,19 @@ " Actual: " (|> actual nat-to-int %i))) (syntax: (arity: [name s.local-symbol] [arity s.nat]) - (with-gensyms [g!proc g!name g!translate g!inputs] + (with-gensyms [g!_ g!proc g!name g!translate g!inputs] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) (-> Text ..Proc)) - (function [(~ g!name)] - (function [(~ g!translate) (~ g!inputs)] + (function ((~ g!_) (~ g!name)) + (function ((~ g!_) (~ g!translate) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do macro.Monad<Meta> [(~+ (|> g!input+ - (list/map (function [g!input] + (list/map (function (_ g!input) (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) @@ -89,8 +89,8 @@ (def: #export (variadic proc) (-> Variadic (-> Text Proc)) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (do macro.Monad<Meta> [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) @@ -113,7 +113,9 @@ Unary valueO) -(exception: #export Wrong-Syntax) +(exception: #export (Wrong-Syntax {message Text}) + message) + (def: #export (wrong-syntax procedure args) (-> Text (List ls.Synthesis) Text) (format "Procedure: " procedure "\n" @@ -121,8 +123,8 @@ (def: lux//loop (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) (#e.Success [offset initsS+ bodyS]) (loopT.translate-loop translate offset initsS+ bodyS) @@ -133,8 +135,8 @@ (def: lux//recur (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (loopT.translate-recur translate inputsS)))) (def: lux-procs @@ -328,12 +330,12 @@ (def: (apply1 func) (-> Expression (-> Expression Expression)) - (function [value] + (function (_ value) (python.apply (list value) func))) (def: (send0 method) (-> Text (-> Expression Expression)) - (function [object] + (function (_ object) (python.send (list) method object))) (do-template [<name> <divisor>] @@ -489,7 +491,7 @@ (install "log" (unary runtimeT.io//log!)) (install "error" (unary runtimeT.io//throw!)) (install "exit" (unary runtimeT.io//exit!)) - (install "current-time" (nullary (function [_] + (install "current-time" (nullary (function (_ _) (runtimeT.io//current-time! runtimeT.unit))))))) ## [[Atoms]] diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux index e8f564745..6319c2121 100644 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux @@ -81,7 +81,7 @@ _ (` (let [(~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function [[left right]] + (list/map (function (_ [left right]) (list left (` (@@ (~ right)))))) list/join))] (python.def! (~ $runtime) @@ -91,7 +91,7 @@ (syntax: (with-vars [vars (s.tuple (p.many s.local-symbol))] body) (wrap (list (` (let [(~+ (|> vars - (list/map (function [var] + (list/map (function (_ var) (list (code.local-symbol var) (` (python.var (~ (code.text (lang.normalize-name var)))))))) list/join))] diff --git a/new-luxc/source/luxc/lang/translation/ruby.lux b/new-luxc/source/luxc/lang/translation/ruby.lux index 8f00c0ecd..e405b2b4f 100644 --- a/new-luxc/source/luxc/lang/translation/ruby.lux +++ b/new-luxc/source/luxc/lang/translation/ruby.lux @@ -18,6 +18,16 @@ (host [ruby #+ Ruby Expression Statement])) [".C" io])) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [No-Active-Module-Buffer] + [Cannot-Execute] + + [No-Anchor] + ) + (host.import java/lang/Object) (host.import java/lang/String @@ -50,7 +60,7 @@ (io {#context ["" +0] #anchor #.None #interpreter (let [interpreter (ScriptingContainer::new [])] - (function [code] + (function (_ code) ("lux try" (io (: Top (maybe.default [] (ScriptingContainer::runScriptlet [code] interpreter))))))) #module-buffer #.None #program-buffer (StringBuilder::new [])})) @@ -59,7 +69,7 @@ (def: #export init-module-buffer (Meta Unit) - (function [compiler] + (function (_ compiler) (#e.Success [(update@ #.host (|>> (:! Host) (set@ #module-buffer (#.Some (StringBuilder::new []))) @@ -67,12 +77,9 @@ compiler) []]))) -(exception: #export No-Active-Module-Buffer) -(exception: #export Cannot-Execute) - (def: #export (with-sub-context expr) (All [a] (-> (Meta a) (Meta [Text a]))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) new-name (format old-name "___" (%i (nat-to-int old-sub)))] @@ -92,7 +99,7 @@ (def: #export context (Meta Text) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> (get@ #.host compiler) (:! Host) @@ -102,7 +109,7 @@ (def: #export (with-anchor anchor expr) (All [a] (-> Anchor (Meta a) (Meta a))) - (function [compiler] + (function (_ compiler) (let [old (:! Host (get@ #.host compiler))] (case (expr (set@ #.host (:! Void (set@ #anchor (#.Some anchor) old)) @@ -118,11 +125,9 @@ (#e.Error error) (#e.Error error))))) -(exception: #export No-Anchor) - (def: #export anchor (Meta Anchor) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor)) (#.Some anchor) (#e.Success [compiler anchor]) @@ -132,32 +137,30 @@ (def: #export module-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer)) #.None - ((lang.fail (No-Active-Module-Buffer "")) compiler) + ((lang.throw No-Active-Module-Buffer "") compiler) (#.Some module-buffer) (#e.Success [compiler module-buffer])))) (def: #export program-buffer (Meta StringBuilder) - (function [compiler] + (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))]))) (def: (execute code) (-> Expression (Meta Unit)) - (function [compiler] + (function (_ compiler) (let [interpreter (|> compiler (get@ #.host) (:! Host) (get@ #interpreter))] (case (interpreter code) (#e.Error error) - ((lang.fail (Cannot-Execute error)) compiler) + ((lang.throw Cannot-Execute error) compiler) (#e.Success _) (#e.Success [compiler []]))))) -(exception: #export Unknown-Member) - (def: #export variant-tag-field "_lux_tag") (def: #export variant-flag-field "_lux_flag") (def: #export variant-value-field "_lux_value") diff --git a/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux index 016038d03..7f951a9dc 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux @@ -34,7 +34,7 @@ (Meta Expression)) (do macro.Monad<Meta> [valueO (translate valueS)] - (wrap (list/fold (function [[idx tail?] source] + (wrap (list/fold (function (_ [idx tail?] source) (let [method (if tail? runtimeT.product//right runtimeT.product//left)] @@ -86,7 +86,8 @@ Expression (ruby.string "PM-ERROR")) -(exception: #export Unrecognized-Path) +(exception: #export (Unrecognized-Path {message Text}) + message) (def: (translate-pattern-matching' translate path) (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux index bce63ce9c..348e5bcf9 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux @@ -11,6 +11,16 @@ (lang (host [ruby #+ Ruby Expression Statement]))) [//]) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Not-A-Variant] + [Unknown-Kind-Of-Host-Object] + [Null-Has-No-Lux-Representation] + [Cannot-Evaluate] + ) + (host.import java/lang/Object (toString [] String) (getClass [] (Class Object))) @@ -44,8 +54,6 @@ (recur (n/inc idx) (array.write idx lux-value output)))) (#e.Success output))))) -(exception: #export Not-A-Variant) - (def: (variant lux-object host-object) (-> (-> Object (Error Top)) RubyHash (Error Top)) (case [(RubyHash::get [(:! Object //.variant-tag-field)] host-object) @@ -61,9 +69,6 @@ _ (ex.throw Not-A-Variant ""))) -(exception: #export Unknown-Kind-Of-Host-Object) -(exception: #export Null-Has-No-Lux-Representation) - (def: (lux-object host-object) (-> Object (Error Top)) (`` (cond (host.null? host-object) @@ -94,11 +99,9 @@ (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation))) ))) -(exception: #export Cannot-Evaluate) - (def: #export (eval code) (-> Expression (Meta Top)) - (function [compiler] + (function (_ compiler) (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))] (case (interpreter code) (#e.Error error) @@ -111,7 +114,7 @@ (case (lux-object (:! Object output)) (#e.Success parsed-output) (exec ## (log! (format "eval #e.Success\n" - ## "<< " code)) + ## "<< " code)) (#e.Success [compiler parsed-output])) (#e.Error error) diff --git a/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux index d0e42c22d..96728731d 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux @@ -21,8 +21,13 @@ [".T" case] [".T" procedure])) -(exception: #export Invalid-Function-Syntax) -(exception: #export Unrecognized-Synthesis) +(do-template [<name>] + [(exception: #export (<name> {message Text}) + message)] + + [Invalid-Function-Syntax] + [Unrecognized-Synthesis] + ) (def: #export (translate synthesis) (-> ls.Synthesis (Meta Expression)) diff --git a/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux index ba349dedd..f5d64459d 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux @@ -64,9 +64,9 @@ args-initsO+ (ruby.while! (ruby.bool true) (ruby.return! bodyO)))) - (ruby.return! (let [recur (function [args] (ruby.call (list args) function-name))] + (ruby.return! (let [recur (function (_ args) (ruby.call (list args) function-name))] (ruby.? (ruby.> arityO "num_args") - (let [slice (function [from to] + (let [slice (function (_ from to) (ruby.array-range from to "curried")) arity-args (ruby.splat (slice (ruby.int 0) limitO)) output-func-args (ruby.splat (slice arityO "num_args"))] diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux index e7121ac98..0bda70ad9 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux @@ -12,7 +12,8 @@ (/ ["/." common] ["/." host])) -(exception: #export Unknown-Procedure) +(exception: #export (Unknown-Procedure {message Text}) + message) (def: procedures /common.Bundle diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index 0fc0029eb..39c1f561d 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -51,7 +51,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: (wrong-arity proc expected actual) @@ -61,19 +61,19 @@ " Actual: " (|> actual nat-to-int %i))) (syntax: (arity: [name s.local-symbol] [arity s.nat]) - (with-gensyms [g!proc g!name g!translate g!inputs] + (with-gensyms [g!_ g!proc g!name g!translate g!inputs] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) (-> Text ..Proc)) - (function [(~ g!name)] - (function [(~ g!translate) (~ g!inputs)] + (function ((~ g!_) (~ g!name)) + (function ((~ g!_) (~ g!translate) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do macro.Monad<Meta> [(~+ (|> g!input+ - (list/map (function [g!input] + (list/map (function (_ g!input) (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) @@ -88,8 +88,8 @@ (def: #export (variadic proc) (-> Variadic (-> Text Proc)) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (do macro.Monad<Meta> [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) @@ -112,7 +112,9 @@ Unary valueO) -(exception: #export Wrong-Syntax) +(exception: #export (Wrong-Syntax {message Text}) + message) + (def: #export (wrong-syntax procedure args) (-> Text (List ls.Synthesis) Text) (format "Procedure: " procedure "\n" @@ -120,8 +122,8 @@ (def: lux//loop (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) (#e.Success [offset initsS+ bodyS]) (loopT.translate-loop translate offset initsS+ bodyS) @@ -132,8 +134,8 @@ (def: lux//recur (-> Text Proc) - (function [proc-name] - (function [translate inputsS] + (function (_ proc-name) + (function (_ translate inputsS) (loopT.translate-recur translate inputsS)))) (def: lux-procs diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux index 190b9cf6a..9e6383ce4 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux @@ -77,7 +77,7 @@ _ (` (let [(~' @) (~ runtime) (~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function [[left right]] (list left right))) + (list/map (function (_ [left right]) (list left right))) list/join))] (ruby.function! (~ runtime) (list (~+ argsLC+)) diff --git a/new-luxc/source/luxc/lang/variable.lux b/new-luxc/source/luxc/lang/variable.lux index 55f6ac877..b33574d19 100644 --- a/new-luxc/source/luxc/lang/variable.lux +++ b/new-luxc/source/luxc/lang/variable.lux @@ -44,4 +44,4 @@ (-> Scope (List Variable)) (|> scope (get@ [#.captured #.mappings]) - (list/map (function [[_ [_ ref]]] (from-ref ref))))) + (list/map (function (_ [_ [_ ref]]) (from-ref ref))))) |