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/translation/jvm | |
parent | 84d7e87817cd2c074653b34d028c8fa807febc7f (diff) |
- Adapted new-luxc's code to latest stdlib changes.
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm')
12 files changed, 149 insertions, 119 deletions
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 |