diff options
Diffstat (limited to '')
44 files changed, 429 insertions, 323 deletions
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+)) |