From b14102eaa2a80f51f160ba293ec01928dbe683c3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 22 Jul 2018 02:52:46 -0400 Subject: - Some fixes due to recent changes in stdlib. - Removed some (now) useless modules. --- new-luxc/source/luxc/lang/extension/statement.lux | 2 +- new-luxc/source/luxc/lang/host/jvm.lux | 24 +- new-luxc/source/luxc/lang/host/jvm/def.lux | 18 +- new-luxc/source/luxc/lang/host/jvm/inst.lux | 11 +- new-luxc/source/luxc/lang/host/jvm/type.lux | 4 +- new-luxc/source/luxc/lang/translation.lux | 8 +- .../source/luxc/lang/translation/common-lisp.lux | 2 +- .../lang/translation/common-lisp/procedure.jvm.lux | 29 -- .../lang/translation/common-lisp/reference.jvm.lux | 4 +- .../lang/translation/common-lisp/statement.jvm.lux | 12 +- new-luxc/source/luxc/lang/translation/js.lux | 4 +- .../luxc/lang/translation/js/imports.jvm.lux | 2 +- .../luxc/lang/translation/js/procedure.jvm.lux | 29 -- .../luxc/lang/translation/js/reference.jvm.lux | 4 +- .../luxc/lang/translation/js/statement.jvm.lux | 14 +- new-luxc/source/luxc/lang/translation/jvm.lux | 15 +- .../source/luxc/lang/translation/jvm/case.jvm.lux | 227 ++++----- .../luxc/lang/translation/jvm/common.jvm.lux | 47 +- .../source/luxc/lang/translation/jvm/eval.jvm.lux | 6 +- .../luxc/lang/translation/jvm/expression.jvm.lux | 13 +- .../luxc/lang/translation/jvm/function.jvm.lux | 31 +- .../luxc/lang/translation/jvm/imports.jvm.lux | 2 +- .../source/luxc/lang/translation/jvm/loop.jvm.lux | 25 +- .../luxc/lang/translation/jvm/primitive.jvm.lux | 21 +- .../luxc/lang/translation/jvm/procedure.jvm.lux | 28 -- .../lang/translation/jvm/procedure/common.jvm.lux | 282 +++++------ .../lang/translation/jvm/procedure/host.jvm.lux | 366 +++++++------- .../luxc/lang/translation/jvm/reference.jvm.lux | 35 +- .../luxc/lang/translation/jvm/runtime.jvm.lux | 555 +++++++++++---------- .../luxc/lang/translation/jvm/statement.jvm.lux | 14 +- .../luxc/lang/translation/jvm/structure.jvm.lux | 57 +-- new-luxc/source/luxc/lang/translation/lua.lux | 2 +- .../luxc/lang/translation/lua/procedure.jvm.lux | 29 -- .../luxc/lang/translation/lua/reference.jvm.lux | 4 +- .../luxc/lang/translation/lua/statement.jvm.lux | 12 +- new-luxc/source/luxc/lang/translation/php.lux | 2 +- .../luxc/lang/translation/php/procedure.jvm.lux | 30 -- .../luxc/lang/translation/php/reference.jvm.lux | 4 +- .../luxc/lang/translation/php/statement.jvm.lux | 12 +- new-luxc/source/luxc/lang/translation/python.lux | 2 +- .../luxc/lang/translation/python/procedure.jvm.lux | 29 -- .../luxc/lang/translation/python/reference.jvm.lux | 4 +- .../luxc/lang/translation/python/statement.jvm.lux | 12 +- new-luxc/source/luxc/lang/translation/r.lux | 2 +- .../luxc/lang/translation/r/procedure.jvm.lux | 29 -- .../luxc/lang/translation/r/reference.jvm.lux | 4 +- .../luxc/lang/translation/r/statement.jvm.lux | 12 +- new-luxc/source/luxc/lang/translation/ruby.lux | 2 +- .../luxc/lang/translation/ruby/procedure.jvm.lux | 29 -- .../luxc/lang/translation/ruby/reference.jvm.lux | 4 +- .../luxc/lang/translation/ruby/statement.jvm.lux | 12 +- new-luxc/source/luxc/lang/translation/scheme.lux | 2 +- .../luxc/lang/translation/scheme/statement.jvm.lux | 12 +- new-luxc/test/test/luxc/lang/analysis/host.jvm.lux | 34 +- .../test/test/luxc/lang/translation/primitive.lux | 9 +- .../test/test/luxc/lang/translation/reference.lux | 4 +- 56 files changed, 986 insertions(+), 1202 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/common-lisp/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux (limited to 'new-luxc') diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux index 7ee6b898d..ce1222fed 100644 --- a/new-luxc/source/luxc/lang/extension/statement.lux +++ b/new-luxc/source/luxc/lang/extension/statement.lux @@ -71,7 +71,7 @@ (do macro.Monad [syntheses //.all-syntheses [annotationsI annotationsV] (process-annotations syntheses annotationsC)] - (case (macro.get-identifier-ann (ident-for #.alias) annotationsV) + (case (macro.get-identifier-ann (name-of #.alias) annotationsV) (#.Some real-def) (do @ [_ (ensure-valid-alias def-name annotationsV valueC) diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index 7e5abd6d4..6f56f9e0e 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -5,17 +5,18 @@ ["p" parser]] [data [collection - [list ("list/" Functor)]]] + [list ("list/." Functor)]]] [macro - [code] + ["." code] ["s" syntax (#+ syntax:)]] [host (#+ import:)] [world - [blob (#+ Blob)]] - [language - [reference (#+ Register)] - [compiler - ["." translation]]]]) + [binary (#+ Binary)]] + [compiler + [default + [reference (#+ Register)] + [phase + ["." translation]]]]]) ## [Host] (import: org/objectweb/asm/MethodVisitor) @@ -86,7 +87,7 @@ #V1_7 #V1_8) -(type: #export ByteCode Blob) +(type: #export ByteCode Binary) (type: #export Definition [Text ByteCode]) @@ -101,8 +102,11 @@ (type: #export Operation (translation.Operation ..Anchor Inst Definition)) -(type: #export Compiler - (translation.Compiler ..Anchor Inst Definition)) +(type: #export Phase + (translation.Phase ..Anchor Inst Definition)) + +(type: #export Bundle + (translation.Bundle ..Anchor Inst Definition)) ## [Values] (syntax: (config: {type s.local-identifier} diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 3d3f8d80d..f70543ff7 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -6,16 +6,16 @@ ["." product] [collection ["a" array] - [list ("list/" Functor)]]] - [host (#+ do-to)] - [function]] + ["." list ("list/." Functor)]]] + ["." host (#+ import: do-to)] + ["." function]] ["$" // ["$t" type]]) -(host.import: #long java/lang/Object) -(host.import: #long java/lang/String) +(import: #long java/lang/Object) +(import: #long java/lang/String) -(host.import: org/objectweb/asm/Opcodes +(import: org/objectweb/asm/Opcodes (#static ACC_PUBLIC int) (#static ACC_PROTECTED int) (#static ACC_PRIVATE int) @@ -42,15 +42,15 @@ (#static V1_8 int) ) -(host.import: org/objectweb/asm/FieldVisitor +(import: org/objectweb/asm/FieldVisitor (visitEnd [] void)) -(host.import: org/objectweb/asm/MethodVisitor +(import: org/objectweb/asm/MethodVisitor (visitCode [] void) (visitMaxs [int int] void) (visitEnd [] void)) -(host.import: org/objectweb/asm/ClassWriter +(import: org/objectweb/asm/ClassWriter (#static COMPUTE_MAXS int) (#static COMPUTE_FRAMES int) (new [int]) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 463861798..d63ca3795 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -9,14 +9,15 @@ [text format] [collection - ["." list ("list/" Functor)]]] - [host (#+ import: do-to)] + ["." list ("list/." Functor)]]] + ["." host (#+ import: do-to)] [macro ["." code] ["s" syntax (#+ syntax:)]] - [function] - [language - [compiler (#+ Operation)]]] + ["." function] + [compiler + [default + [phase (#+ Operation)]]]] ["." // (#+ Primitive Inst) ["." type]]) diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux index f9a956b86..866ef1cef 100644 --- a/new-luxc/source/luxc/lang/host/jvm/type.lux +++ b/new-luxc/source/luxc/lang/host/jvm/type.lux @@ -4,8 +4,8 @@ ["." text format] [collection - [list ("list/" Functor)]]]] - [//]) + ["." list ("list/." Functor)]]]] + ["." //]) ## Types (do-template [ ] diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 158158c51..3348953bb 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -15,7 +15,7 @@ (type ["tc" check])) [host] [io #+ IO Process io] - (world [blob #+ Blob] + (world [binary #+ Binary] [file #+ File])) (luxc ["&" lang] ["&." io] @@ -165,8 +165,8 @@ (for {"JVM" (as-is (host.import: java/lang/String (getBytes [String] #try (Array byte))) - (def: text-to-blob - (-> Text Blob) + (def: text-to-binary + (-> Text Binary) (|>> (:coerce String) (String::getBytes ["UTF-8"]) e.assume)))}) @@ -178,7 +178,7 @@ ## (dict.entries artifacts))] ## (&io.write target-dir ## (format module-name "/" cache.descriptor-name) -## (text-to-blob (%code (cache/description.write file-name module)))))) +## (text-to-binary (%code (cache/description.write file-name module)))))) (def: no-aliases Aliases (dict.new text.Hash)) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp.lux b/new-luxc/source/luxc/lang/translation/common-lisp.lux index d407ae7ab..360a230f9 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp.lux @@ -183,7 +183,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure.jvm.lux deleted file mode 100644 index ed8220613..000000000 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host ["_" common-lisp #+ Expression]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux index 9fd2f42ea..6d2a491c6 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux @@ -34,9 +34,9 @@ (translate-local (.nat var)))) (def: #export global - (-> Ident SVar) + (-> Name SVar) (|>> //.definition-name _.var)) (def: #export (translate-definition name) - (-> Ident (Meta Expression)) + (-> Name (Meta Expression)) (:: macro.Monad wrap (@@ (global name)))) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux index 74bf3d118..48ec2a2fa 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (_.defparameter def-name expressionO)) expressionV (evalT.eval (@@ def-name)) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux index 9daf7330c..ddad4d389 100644 --- a/new-luxc/source/luxc/lang/translation/js.lux +++ b/new-luxc/source/luxc/lang/translation/js.lux @@ -313,7 +313,7 @@ (text.replace-all "-" "_"))) (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (format (module-name module) "$" (lang.normalize-name name))) (def: #export (save-js code) @@ -325,7 +325,7 @@ (execute code))) (def: #export (save-definition name code) - (-> Ident Expression (Meta Any)) + (-> Name Expression (Meta Any)) (save-js (format "var " (definition-name name) " = " code ";\n"))) (def: #export (save-module! target) 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 36500e737..575650457 100644 --- a/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/imports.jvm.lux @@ -36,7 +36,7 @@ (do macro.Monad [_ (moduleL.set-annotations annotations) current-module macro.current-module-name - imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations) + imports (let [imports (|> (macro.get-tuple-ann (name-of #.imports) annotations) (maybe.default (list)))] (case (s.run imports (p.some import)) (#e.Success 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 deleted file mode 100644 index cd5757663..000000000 --- a/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host [js #+ JS Expression Statement]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux index e4231ba6b..69a0075b1 100644 --- a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux @@ -28,9 +28,9 @@ (translate-local (.nat var)))) (def: #export global - (-> Ident Expression) + (-> Name Expression) //.definition-name) (def: #export (translate-definition name) - (-> Ident (Meta Expression)) + (-> Name (Meta Expression)) (:: macro.Monad wrap (global name))) diff --git a/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux index fddc8e045..21e52fe28 100644 --- a/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux @@ -14,19 +14,19 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [_ (//.save-definition def-ident expressionJS) - expressionV (evalT.eval (referenceT.global def-ident)) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + [_ (//.save-definition def-name expressionJS) + expressionV (evalT.eval (referenceT.global def-name)) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -35,7 +35,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index 152def2f5..3e239798b 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -13,14 +13,15 @@ [collection ["." array] ["." dictionary (#+ Dictionary)]]] - [host (#+ import: do-to object)] + ["." host (#+ import: do-to object)] ["." io (#+ IO io)] [world - [blob (#+ Blob)]] - [language - ["." name] - [compiler - ["." translation]]]] + [binary (#+ Binary)]] + [compiler + [default + ["." name] + [phase + ["." translation]]]]] [/// [host ["." jvm (#+ Inst Definition Host State) @@ -69,7 +70,7 @@ (#error.Error error) (error! error))) -(type: #export ByteCode Blob) +(type: #export ByteCode Binary) (def: (define-class class-name bytecode loader) (-> Text ByteCode ClassLoader (Error Object)) 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 2aa0586ab..016edf3d2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -6,55 +6,56 @@ [data [text format]] - [language - ["." compiler ("operation/" Monad) - ["." synthesis (#+ Path Synthesis)]]]] + [compiler + [default + ["." phase ("operation/." Monad) + ["." synthesis (#+ Path Synthesis)]]]]] [luxc [lang [host - ["$" jvm (#+ Label Inst Operation Compiler) + ["$" jvm (#+ Label Inst Operation Phase) ["$t" type] - ["$i" inst]]]]] + ["_" inst]]]]] ["." // (#+ $Object) - [runtime]]) + ["." runtime]]) (def: (pop-altI stack-depth) (-> Nat Inst) (.case stack-depth +0 id - +1 $i.POP - +2 $i.POP2 + +1 _.POP + +2 _.POP2 _ ## (n/> +2) - (|>> $i.POP2 + (|>> _.POP2 (pop-altI (n/- +2 stack-depth))))) (def: peekI Inst - (|>> $i.DUP - ($i.INVOKESTATIC //.runtime-class - "pm_peek" - ($t.method (list runtime.$Stack) - (#.Some $Object) - (list)) - #0))) + (|>> _.DUP + (_.INVOKESTATIC //.runtime-class + "pm_peek" + ($t.method (list runtime.$Stack) + (#.Some $Object) + (list)) + #0))) (def: popI Inst - (|>> ($i.INVOKESTATIC //.runtime-class - "pm_pop" - ($t.method (list runtime.$Stack) - (#.Some runtime.$Stack) - (list)) - #0))) + (|>> (_.INVOKESTATIC //.runtime-class + "pm_pop" + ($t.method (list runtime.$Stack) + (#.Some runtime.$Stack) + (list)) + #0))) (def: pushI Inst - (|>> ($i.INVOKESTATIC //.runtime-class - "pm_push" - ($t.method (list runtime.$Stack $Object) - (#.Some runtime.$Stack) - (list)) - #0))) + (|>> (_.INVOKESTATIC //.runtime-class + "pm_push" + ($t.method (list runtime.$Stack $Object) + (#.Some runtime.$Stack) + (list)) + #0))) (def: (path' translate stack-depth @else @end path) (-> (-> Synthesis (Operation Inst)) @@ -65,45 +66,45 @@ (#synthesis.Bind register) (operation/wrap (|>> peekI - ($i.ASTORE register))) + (_.ASTORE register))) (^ (synthesis.path/bit value)) - (operation/wrap (.let [jumpI (.if value $i.IFEQ $i.IFNE)] + (operation/wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] (|>> peekI - ($i.unwrap #$.Boolean) + (_.unwrap #$.Boolean) (jumpI @else)))) (^ (synthesis.path/i64 value)) (operation/wrap (|>> peekI - ($i.unwrap #$.Long) - ($i.long value) - $i.LCMP - ($i.IFNE @else))) + (_.unwrap #$.Long) + (_.long value) + _.LCMP + (_.IFNE @else))) (^ (synthesis.path/f64 value)) (operation/wrap (|>> peekI - ($i.unwrap #$.Double) - ($i.double value) - $i.DCMPL - ($i.IFNE @else))) + (_.unwrap #$.Double) + (_.double value) + _.DCMPL + (_.IFNE @else))) (^ (synthesis.path/text value)) (operation/wrap (|>> peekI - ($i.string value) - ($i.INVOKEVIRTUAL "java.lang.Object" - "equals" - ($t.method (list $Object) - (#.Some $t.boolean) - (list)) - #0) - ($i.IFEQ @else))) + (_.string value) + (_.INVOKEVIRTUAL "java.lang.Object" + "equals" + ($t.method (list $Object) + (#.Some $t.boolean) + (list)) + #0) + (_.IFEQ @else))) (#synthesis.Then bodyS) - (do compiler.Monad + (do phase.Monad [bodyI (translate bodyS)] (wrap (|>> (pop-altI stack-depth) bodyI - ($i.GOTO @end)))) + (_.GOTO @end)))) (^template [ ] @@ -111,21 +112,21 @@ (operation/wrap (.case ( idx) +0 (|>> peekI - ($i.CHECKCAST ($t.descriptor runtime.$Tuple)) - ($i.int 0) - $i.AALOAD + (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.int 0) + _.AALOAD pushI) idx (|>> peekI - ($i.CHECKCAST ($t.descriptor runtime.$Tuple)) - ($i.int (.int idx)) - ($i.INVOKESTATIC //.runtime-class - - ($t.method (list runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - #0) + (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.int (.int idx)) + (_.INVOKESTATIC //.runtime-class + + ($t.method (list runtime.$Tuple $t.int) + (#.Some $Object) + (list)) + #0) pushI)))) ([synthesis.member/left "pm_left" .id] [synthesis.member/right "pm_right" .inc]) @@ -133,41 +134,41 @@ (^template [ ] (^ ( idx)) (.let [idx ( idx)] - (operation/wrap (<| $i.with-label (function (_ @success)) - $i.with-label (function (_ @fail)) + (operation/wrap (<| _.with-label (function (_ @success)) + _.with-label (function (_ @fail)) (|>> peekI - ($i.CHECKCAST ($t.descriptor runtime.$Variant)) - ($i.int (.int idx)) + (_.CHECKCAST ($t.descriptor runtime.$Variant)) + (_.int (.int idx)) - ($i.INVOKESTATIC //.runtime-class "pm_variant" - ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag) - (#.Some runtime.$Datum) - (list)) - #0) - $i.DUP - ($i.IFNULL @fail) - ($i.GOTO @success) - ($i.label @fail) - $i.POP - ($i.GOTO @else) - ($i.label @success) + (_.INVOKESTATIC //.runtime-class "pm_variant" + ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag) + (#.Some runtime.$Datum) + (list)) + #0) + _.DUP + (_.IFNULL @fail) + (_.GOTO @success) + (_.label @fail) + _.POP + (_.GOTO @else) + (_.label @success) pushI))))) - ([synthesis.side/left $i.NULL .id] - [synthesis.side/right ($i.string "") .inc]) + ([synthesis.side/left _.NULL .id] + [synthesis.side/right (_.string "") .inc]) (#synthesis.Alt leftP rightP) - (do compiler.Monad - [@alt-else $i.make-label + (do phase.Monad + [@alt-else _.make-label leftI (path' translate (inc stack-depth) @alt-else @end leftP) rightI (path' translate stack-depth @else @end rightP)] - (wrap (|>> $i.DUP + (wrap (|>> _.DUP leftI - ($i.label @alt-else) - $i.POP + (_.label @alt-else) + _.POP rightI))) (#synthesis.Seq leftP rightP) - (do compiler.Monad + (do phase.Monad [leftI (path' translate stack-depth @else @end leftP) rightI (path' translate stack-depth @else @end rightP)] (wrap (|>> leftI @@ -175,55 +176,55 @@ )) (def: (path translate path @end) - (-> Compiler Path Label (Operation Inst)) - (do compiler.Monad - [@else $i.make-label + (-> Phase Path Label (Operation Inst)) + (do phase.Monad + [@else _.make-label pathI (..path' translate +1 @else @end path)] (wrap (|>> pathI - ($i.label @else) - $i.POP - ($i.INVOKESTATIC //.runtime-class - "pm_fail" - ($t.method (list) #.None (list)) - #0) - $i.NULL - ($i.GOTO @end))))) + (_.label @else) + _.POP + (_.INVOKESTATIC //.runtime-class + "pm_fail" + ($t.method (list) #.None (list)) + #0) + _.NULL + (_.GOTO @end))))) (def: #export (if translate testS thenS elseS) - (-> Compiler Synthesis Synthesis Synthesis (Operation Inst)) - (do compiler.Monad + (-> Phase Synthesis Synthesis Synthesis (Operation Inst)) + (do phase.Monad [testI (translate testS) thenI (translate thenS) elseI (translate elseS)] - (wrap (<| $i.with-label (function (_ @else)) - $i.with-label (function (_ @end)) + (wrap (<| _.with-label (function (_ @else)) + _.with-label (function (_ @end)) (|>> testI - ($i.unwrap #$.Boolean) - ($i.IFEQ @else) + (_.unwrap #$.Boolean) + (_.IFEQ @else) thenI - ($i.GOTO @end) - ($i.label @else) + (_.GOTO @end) + (_.label @else) elseI - ($i.label @end)))))) + (_.label @end)))))) (def: #export (let translate inputS register exprS) - (-> Compiler Synthesis Nat Synthesis (Operation Inst)) - (do compiler.Monad + (-> Phase Synthesis Nat Synthesis (Operation Inst)) + (do phase.Monad [inputI (translate inputS) exprI (translate exprS)] (wrap (|>> inputI - ($i.ASTORE register) + (_.ASTORE register) exprI)))) (def: #export (case translate valueS path) - (-> Compiler Synthesis Path (Operation Inst)) - (do compiler.Monad - [@end $i.make-label + (-> Phase Synthesis Path (Operation Inst)) + (do phase.Monad + [@end _.make-label valueI (translate valueS) pathI (..path translate path @end)] (wrap (|>> valueI - $i.NULL - $i.SWAP + _.NULL + _.SWAP pushI pathI - ($i.label @end))))) + (_.label @end))))) 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 b01a68c3d..a138bd79a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -3,23 +3,24 @@ [control [monad (#+ do)] ["ex" exception (#+ exception:)]] - [io] + ["." io] [concurrency [atom (#+ Atom atom)]] [data - [error (#+ Error)] - [text ("text/" Hash) + ["." error (#+ Error)] + ["." text ("text/." Hash) format] [collection - [dictionary (#+ Dictionary)]]] - [macro] + ["." dictionary (#+ Dictionary)]]] + ["." macro] [host (#+ import:)] [world - [blob (#+ Blob)]] - [language - [name] - [reference (#+ Register)] - ["." compiler]]] + [binary (#+ Binary)]] + [compiler + [default + ["." name] + [reference (#+ Register)] + ["." phase]]]] ## [luxc ## [lang ## [host @@ -29,30 +30,30 @@ ## (def: #export (with-artifacts action) ## (All [a] (-> (Meta a) (Meta [Artifacts a]))) -## (function (_ compiler) +## (function (_ state) ## (case (action (update@ #.host ## (|>> (:coerce Host) ## (set@ #artifacts (dictionary.new text.Hash)) ## (:coerce Nothing)) -## compiler)) -## (#error.Success [compiler' output]) +## state)) +## (#error.Success [state' output]) ## (#error.Success [(update@ #.host ## (|>> (:coerce Host) -## (set@ #artifacts (|> (get@ #.host compiler) (:coerce Host) (get@ #artifacts))) +## (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts))) ## (:coerce Nothing)) -## compiler') -## [(|> compiler' (get@ #.host) (:coerce Host) (get@ #artifacts)) +## state') +## [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts)) ## output]]) ## (#error.Error error) ## (#error.Error error)))) -## (def: #export (load-definition compiler) -## (-> Lux (-> Ident Blob (Error Any))) -## (function (_ (^@ def-ident [def-module def-name]) def-bytecode) +## (def: #export (load-definition state) +## (-> Lux (-> Name Binary (Error Any))) +## (function (_ (^@ def-name [def-module def-name]) def-bytecode) ## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name))) ## class-name (format (text.replace-all "/" "." def-module) "." normal-name)] -## (<| (macro.run compiler) +## (<| (macro.run state) ## (do macro.Monad ## [_ (..store-class class-name def-bytecode) ## class (..load-class class-name)] @@ -63,10 +64,10 @@ ## (wrap def-value) ## (#error.Success #.None) -## (compiler.throw invalid-definition-value (%ident def-ident)) +## (phase.throw invalid-definition-value (%name def-name)) ## (#error.Error error) -## (compiler.throw cannot-load-definition -## (format "Definition: " (%ident def-ident) "\n" +## (phase.throw cannot-load-definition +## (format "Definition: " (%name def-name) "\n" ## "Error:\n" ## error)))))))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux index aed1abca3..49fbd0385 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux @@ -9,7 +9,7 @@ (lang (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])) + ["_" inst])) ["la" analysis] ["ls" synthesis])) (// [".T" common])) @@ -37,8 +37,8 @@ "" ($t.method (list) #.None (list)) (|>> valueI - ($i.PUTSTATIC store-name commonT.value-field commonT.$Object) - $i.RETURN))))] + (_.PUTSTATIC store-name commonT.value-field commonT.$Object) + _.RETURN))))] _ (commonT.store-class store-name bytecode) class (commonT.load-class store-name)] (wrap (|> class 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 df126628c..f250604b5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux @@ -1,13 +1,14 @@ (.module: [lux #* - [language - [compiler - ["." synthesis] - ["." extension]]]] + [compiler + [default + [phase + ["." synthesis] + ["." extension]]]]] [luxc [lang [host - [jvm (#+ Compiler)]]]] + [jvm (#+ Phase)]]]] [// ["." common] ["." primitive] @@ -18,7 +19,7 @@ ["." function]]) (def: #export (translate synthesis) - Compiler + Phase (case synthesis (^ (synthesis.bit value)) (primitive.bit value) 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 a8006a772..17585b63c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -1,22 +1,23 @@ (.module: [lux (#- function) [control - [monad (#+ do)]] + ["." monad (#+ do)]] [data ["." text format] [collection - [list ("list/" Functor Monoid)]]] - [language - ["_." reference (#+ Register Variable)] - ["." compiler - [analysis (#+ Arity)] - [synthesis (#+ Synthesis Abstraction Apply)] - ["." translation]]]] + ["." list ("list/." Functor Monoid)]]] + [compiler + [default + ["_." reference (#+ Register Variable)] + ["." phase + [analysis (#+ Arity)] + [synthesis (#+ Synthesis Abstraction Apply)] + ["." translation]]]]] [luxc [lang [host - ["$" jvm (#+ Label Inst Def Operation Compiler) + ["$" jvm (#+ Label Inst Def Operation Phase) ["." type] ["." def] ["_" inst]]]]] @@ -109,7 +110,7 @@ (def: (instance class arity env) (-> Text Arity (List Variable) (Operation Inst)) - (do compiler.Monad + (do phase.Monad [captureI+ (monad.map @ reference.variable env) #let [argsI (if (poly-arg? arity) (|> (nullsI (dec arity)) @@ -284,13 +285,13 @@ (with-reset class arity env) applyD ))] - (do compiler.Monad + (do phase.Monad [instanceI (instance class arity env)] (wrap [functionD instanceI])))) (def: #export (function translate [env arity bodyS]) - (-> Compiler Abstraction (Operation Inst)) - (do compiler.Monad + (-> Phase Abstraction (Operation Inst)) + (do phase.Monad [@begin _.make-label [function-class bodyI] (translation.with-context (translation.with-anchor [@begin +1] @@ -312,8 +313,8 @@ (list& pre (segment size post))))) (def: #export (call translate [functionS argsS]) - (-> Compiler Apply (Operation Inst)) - (do compiler.Monad + (-> Phase Apply (Operation Inst)) + (do phase.Monad [functionI (translate functionS) argsI (monad.map @ translate argsS) #let [applyI (|> (segment runtime.num-apply-variants argsI) 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 9c344e7e9..ec791019c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux @@ -116,7 +116,7 @@ (do macro.Monad [_ (moduleL.set-annotations annotations) current-module macro.current-module-name - imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations) + imports (let [imports (|> (macro.get-tuple-ann (name-of #.imports) annotations) (maybe.default (list)))] (case (s.run imports (p.some import)) (#e.Success imports) 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 ac356aebb..20be62066 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -1,21 +1,22 @@ (.module: [lux #* [control - [monad (#+ do)]] + ["." monad (#+ do)]] [data ["." text format] [collection - [list ("list/" Functor Monoid)]]] - [language - [reference (#+ Register)] - ["." compiler - ["." synthesis (#+ Synthesis)] - ["." translation]]]] + ["." list ("list/." Functor Monoid)]]] + [compiler + [default + [reference (#+ Register)] + ["." phase + ["." synthesis (#+ Synthesis)] + ["." translation]]]]] [luxc [lang [host - [jvm (#+ Inst Operation Compiler) + [jvm (#+ Inst Operation Phase) ["_" inst]]]]] ["." //]) @@ -29,8 +30,8 @@ #0)) (def: #export (recur translate argsS) - (-> Compiler (List Synthesis) (Operation Inst)) - (do compiler.Monad + (-> Phase (List Synthesis) (Operation Inst)) + (do phase.Monad [[@begin start] translation.anchor #let [end (|> argsS list.size dec (n/+ start)) pairs (list.zip2 (list.n/range start end) @@ -60,8 +61,8 @@ (_.GOTO @begin))))) (def: #export (scope translate [start initsS+ iterationS]) - (-> Compiler [Nat (List Synthesis) Synthesis] (Operation Inst)) - (do compiler.Monad + (-> Phase [Nat (List Synthesis) Synthesis] (Operation Inst)) + (do phase.Monad [@begin _.make-label initsI+ (monad.map @ translate initsS+) iterationI (translation.with-anchor [@begin start] diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux index f1d639b72..c32e80d56 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux @@ -5,27 +5,28 @@ [data [text format]] - [language - [compiler ("operation/" Monad)]]] + [compiler + [default + [phase ("operation/." Monad)]]]] [luxc [lang [host - [jvm (#+ Inst Operation) - ["$i" inst] + ["." jvm (#+ Inst Operation) + ["_" inst] ["$t" type]]]]]) (def: #export (bit value) (-> Bit (Operation Inst)) - (operation/wrap ($i.GETSTATIC "java.lang.Boolean" - (if value "TRUE" "FALSE") - ($t.class "java.lang.Boolean" (list))))) + (operation/wrap (_.GETSTATIC "java.lang.Boolean" + (if value "TRUE" "FALSE") + ($t.class "java.lang.Boolean" (list))))) (do-template [ ] [(def: #export ( value) (-> (Operation Inst)) (operation/wrap (|>> ( value) )))] - [i64 Int $i.long ($i.wrap #jvm.Long)] - [f64 Frac $i.double ($i.wrap #jvm.Double)] - [text Text $i.string (<|)] + [i64 Int _.long (_.wrap #jvm.Long)] + [f64 Frac _.double (_.wrap #jvm.Double)] + [text Text _.string (<|)] ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux deleted file mode 100644 index 49c91204a..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang (host ["$" jvm]) - ["ls" synthesis])) - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta $.Inst)) Text (List ls.Synthesis) - (Meta $.Inst)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) 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 6447ec20a..2334f9cc2 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 @@ -20,7 +20,7 @@ (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])))) + ["_" inst])))) (/// [".T" runtime] [".T" case] [".T" function] @@ -110,32 +110,32 @@ (wrap (proc inputsI)))))) ## [Instructions] -(def: lux-intI $.Inst (|>> $i.I2L ($i.wrap #$.Long))) -(def: jvm-intI $.Inst (|>> ($i.unwrap #$.Long) $i.L2I)) +(def: lux-intI $.Inst (|>> _.I2L (_.wrap #$.Long))) +(def: jvm-intI $.Inst (|>> (_.unwrap #$.Long) _.L2I)) (def: (array-writeI arrayI idxI elemI) (-> $.Inst $.Inst $.Inst $.Inst) - (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) - $i.DUP + (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) + _.DUP idxI jvm-intI elemI - $i.AASTORE)) + _.AASTORE)) (def: (predicateI tester) (-> (-> $.Label $.Inst) $.Inst) - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) (|>> (tester @then) - ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) - ($i.GOTO @end) - ($i.label @then) - ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list))) - ($i.label @end) + (_.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) + (_.GOTO @end) + (_.label @then) + (_.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list))) + (_.label @end) ))) -(def: unitI $.Inst ($i.string hostL.unit)) +(def: unitI $.Inst (_.string hostL.unit)) ## [Procedures] ## [[Lux]] @@ -143,7 +143,7 @@ Binary (|>> leftI rightI - (predicateI $i.IF_ACMPEQ))) + (predicateI _.IF_ACMPEQ))) (def: (lux//if [testI thenI elseI]) Trinary @@ -152,10 +152,10 @@ (def: (lux//try riskyI) Unary (|>> riskyI - ($i.CHECKCAST hostL.function-class) - ($i.INVOKESTATIC hostL.runtime-class "try" - ($t.method (list $Function) (#.Some $Object-Array) (list)) - #0))) + (_.CHECKCAST hostL.function-class) + (_.INVOKESTATIC hostL.runtime-class "try" + ($t.method (list $Function) (#.Some $Object-Array) (list)) + #0))) (exception: #export (Wrong-Syntax {message Text}) message) @@ -187,48 +187,48 @@ (do-template [ ] [(def: ( [inputI maskI]) Binary - (|>> inputI ($i.unwrap #$.Long) - maskI ($i.unwrap #$.Long) - ($i.wrap #$.Long)))] + (|>> inputI (_.unwrap #$.Long) + maskI (_.unwrap #$.Long) + (_.wrap #$.Long)))] - [bit//and $i.LAND] - [bit//or $i.LOR] - [bit//xor $i.LXOR] + [bit//and _.LAND] + [bit//or _.LOR] + [bit//xor _.LXOR] ) (do-template [ ] [(def: ( [inputI shiftI]) Binary - (|>> inputI ($i.unwrap #$.Long) + (|>> inputI (_.unwrap #$.Long) shiftI jvm-intI - ($i.wrap #$.Long)))] + (_.wrap #$.Long)))] - [bit//left-shift $i.LSHL] - [bit//arithmetic-right-shift $i.LSHR] - [bit//logical-right-shift $i.LUSHR] + [bit//left-shift _.LSHL] + [bit//arithmetic-right-shift _.LSHR] + [bit//logical-right-shift _.LUSHR] ) ## [[Arrays]] (def: (array//new lengthI) Unary - (|>> lengthI jvm-intI ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) + (|>> lengthI jvm-intI (_.ANEWARRAY ($t.binary-name "java.lang.Object")))) (def: (array//get [arrayI idxI]) Binary - (<| $i.with-label (function (_ @is-null)) - $i.with-label (function (_ @end)) - (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + (<| _.with-label (function (_ @is-null)) + _.with-label (function (_ @end)) + (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) idxI jvm-intI - $i.AALOAD - $i.DUP - ($i.IFNULL @is-null) + _.AALOAD + _.DUP + (_.IFNULL @is-null) runtimeT.someI - ($i.GOTO @end) - ($i.label @is-null) - $i.POP + (_.GOTO @end) + (_.label @is-null) + _.POP runtimeT.noneI - ($i.label @end)))) + (_.label @end)))) (def: (array//put [arrayI idxI elemI]) Trinary @@ -236,12 +236,12 @@ (def: (array//remove [arrayI idxI]) Binary - (array-writeI arrayI idxI $i.NULL)) + (array-writeI arrayI idxI _.NULL)) (def: (array//size arrayI) Unary - (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) - $i.ARRAYLENGTH + (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) + _.ARRAYLENGTH lux-intI)) ## [[Numbers]] @@ -252,32 +252,32 @@ (do-template [ ] [(def: ( _) Nullary - (|>> ($i.wrap )))] + (|>> (_.wrap )))] - [frac//smallest ($i.double Double::MIN_VALUE) #$.Double] - [frac//min ($i.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] - [frac//max ($i.double Double::MAX_VALUE) #$.Double] + [frac//smallest (_.double Double::MIN_VALUE) #$.Double] + [frac//min (_.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] + [frac//max (_.double Double::MAX_VALUE) #$.Double] ) (do-template [ ] [(def: ( [subjectI paramI]) Binary - (|>> subjectI ($i.unwrap ) - paramI ($i.unwrap ) + (|>> subjectI (_.unwrap ) + paramI (_.unwrap ) - ($i.wrap )))] + (_.wrap )))] - [int//add #$.Long $i.LADD] - [int//sub #$.Long $i.LSUB] - [int//mul #$.Long $i.LMUL] - [int//div #$.Long $i.LDIV] - [int//rem #$.Long $i.LREM] + [int//add #$.Long _.LADD] + [int//sub #$.Long _.LSUB] + [int//mul #$.Long _.LMUL] + [int//div #$.Long _.LDIV] + [int//rem #$.Long _.LREM] - [frac//add #$.Double $i.DADD] - [frac//sub #$.Double $i.DSUB] - [frac//mul #$.Double $i.DMUL] - [frac//div #$.Double $i.DDIV] - [frac//rem #$.Double $i.DREM] + [frac//add #$.Double _.DADD] + [frac//sub #$.Double _.DSUB] + [frac//mul #$.Double _.DMUL] + [frac//div #$.Double _.DDIV] + [frac//rem #$.Double _.DREM] ) (do-template [ ] @@ -287,13 +287,13 @@ (|>> subjectI paramI - ($i.int ) - (predicateI $i.IF_ICMPEQ)))] + (_.int ) + (predicateI _.IF_ICMPEQ)))] [ 0] [ -1])] - [int//eq int//lt ($i.unwrap #$.Long) $i.LCMP] - [frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG] + [int//eq int//lt (_.unwrap #$.Long) _.LCMP] + [frac//eq frac//lt (_.unwrap #$.Double) _.DCMPG] ) (do-template [ ] @@ -301,15 +301,15 @@ Unary (|>> inputI ))] - [int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)] - [int//char ($i.unwrap #$.Long) - ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) #0)))] + [int//to-frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] + [int//char (_.unwrap #$.Long) + ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) #0)))] - [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)] - [frac//encode ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) #0)] - [frac//decode ($i.CHECKCAST "java.lang.String") - ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) #0)] + [frac//to-int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] + [frac//encode (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) #0)] + [frac//decode (_.CHECKCAST "java.lang.String") + (_.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) #0)] ) ## [[Text]] @@ -317,8 +317,8 @@ [(def: ( inputI) Unary (|>> inputI - ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL ($t.method (list) (#.Some ) (list)) #0) + (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL ($t.method (list) (#.Some ) (list)) #0) ))] [text//size "java.lang.String" "length" lux-intI $t.int] @@ -332,16 +332,16 @@ ))] [text//eq id id - ($i.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) #0) - ($i.wrap #$.Boolean)] - [text//lt ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) #0) - (<| (predicateI $i.IF_ICMPEQ) ($i.int -1))] - [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) #0) + (_.wrap #$.Boolean)] + [text//lt (_.CHECKCAST "java.lang.String") (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) #0) + (<| (predicateI _.IF_ICMPEQ) (_.int -1))] + [text//concat (_.CHECKCAST "java.lang.String") (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0) id] - [text//char ($i.CHECKCAST "java.lang.String") jvm-intI - ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) #0) + [text//char (_.CHECKCAST "java.lang.String") jvm-intI + (_.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) #0) id] ) @@ -353,30 +353,30 @@ extraI ))] - [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI - ($i.INVOKESTATIC hostL.runtime-class "text_clip" - ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) #0)] + [text//clip (_.CHECKCAST "java.lang.String") jvm-intI jvm-intI + (_.INVOKESTATIC hostL.runtime-class "text_clip" + ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) #0)] ) (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)) - (|>> textI ($i.CHECKCAST "java.lang.String") - partI ($i.CHECKCAST "java.lang.String") + (<| _.with-label (function (_ @not-found)) + _.with-label (function (_ @end)) + (|>> textI (_.CHECKCAST "java.lang.String") + partI (_.CHECKCAST "java.lang.String") startI jvm-intI - ($i.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0) - $i.DUP - ($i.int -1) - ($i.IF_ICMPEQ @not-found) + (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0) + _.DUP + (_.int -1) + (_.IF_ICMPEQ @not-found) lux-intI runtimeT.someI - ($i.GOTO @end) - ($i.label @not-found) - $i.POP + (_.GOTO @end) + (_.label @not-found) + _.POP runtimeT.noneI - ($i.label @end)))) + (_.label @end)))) ## [[Math]] (def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list))) @@ -386,9 +386,9 @@ [(def: ( inputI) Unary (|>> inputI - ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Math" math-unary-method #0) - ($i.wrap #$.Double)))] + (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Math" math-unary-method #0) + (_.wrap #$.Double)))] [math//cos "cos"] [math//sin "sin"] @@ -408,10 +408,10 @@ (do-template [ ] [(def: ( [inputI paramI]) Binary - (|>> inputI ($i.unwrap #$.Double) - paramI ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Math" math-binary-method #0) - ($i.wrap #$.Double)))] + (|>> inputI (_.unwrap #$.Double) + paramI (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Math" math-binary-method #0) + (_.wrap #$.Double)))] [math//atan2 "atan2"] [math//pow "pow"] @@ -420,103 +420,103 @@ (def: (math//round inputI) Unary (|>> inputI - ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) #0) - $i.L2D - ($i.wrap #$.Double))) + (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) #0) + _.L2D + (_.wrap #$.Double))) ## [[IO]] (def: string-method $.Method ($t.method (list $String) #.None (list))) (def: (io//log messageI) Unary - (|>> ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + (|>> (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) messageI - ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0) + (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0) unitI)) (def: (io//error messageI) Unary - (|>> ($i.NEW "java.lang.Error") - $i.DUP + (|>> (_.NEW "java.lang.Error") + _.DUP messageI - ($i.CHECKCAST "java.lang.String") - ($i.INVOKESPECIAL "java.lang.Error" "" string-method #0) - $i.ATHROW)) + (_.CHECKCAST "java.lang.String") + (_.INVOKESPECIAL "java.lang.Error" "" string-method #0) + _.ATHROW)) (def: (io//exit codeI) Unary (|>> codeI jvm-intI - ($i.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) #0) - $i.NULL)) + (_.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) #0) + _.NULL)) (def: (io//current-time []) Nullary - (|>> ($i.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) #0) - ($i.wrap #$.Long))) + (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) #0) + (_.wrap #$.Long))) ## [[Atoms]] (def: atom-class Text "java.util.concurrent.atomic.AtomicReference") (def: (atom//new initI) Unary - (|>> ($i.NEW atom-class) - $i.DUP + (|>> (_.NEW atom-class) + _.DUP initI - ($i.INVOKESPECIAL atom-class "" ($t.method (list $Object) #.None (list)) #0))) + (_.INVOKESPECIAL atom-class "" ($t.method (list $Object) #.None (list)) #0))) (def: (atom//read atomI) Unary (|>> atomI - ($i.CHECKCAST atom-class) - ($i.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) #0))) + (_.CHECKCAST atom-class) + (_.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) #0))) (def: (atom//compare-and-swap [atomI oldI newI]) Trinary (|>> atomI - ($i.CHECKCAST atom-class) + (_.CHECKCAST atom-class) oldI newI - ($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) #0) - ($i.wrap #$.Boolean))) + (_.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) #0) + (_.wrap #$.Boolean))) ## [[Box]] (def: empty-boxI $.Inst - (|>> ($i.int 1) ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) + (|>> (_.int 1) (_.ANEWARRAY ($t.binary-name "java.lang.Object")))) (def: check-boxI $.Inst - ($i.CHECKCAST ($t.descriptor $Object-Array))) + (_.CHECKCAST ($t.descriptor $Object-Array))) (def: (box//new initI) Unary (|>> empty-boxI - $i.DUP ($i.int 0) initI $i.AASTORE)) + _.DUP (_.int 0) initI _.AASTORE)) (def: (box//read boxI) Unary (|>> boxI check-boxI - ($i.int 0) $i.AALOAD)) + (_.int 0) _.AALOAD)) (def: (box//write [valueI boxI]) Binary (|>> boxI check-boxI - ($i.int 0) valueI $i.AASTORE + (_.int 0) valueI _.AASTORE unitI)) ## [[Processes]] (def: (process//parallelism-level []) Nullary - (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) #0) - ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0) + (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0) lux-intI)) (def: (process//schedule [millisecondsI procedureI]) Binary - (|>> millisecondsI ($i.unwrap #$.Long) - procedureI ($i.CHECKCAST hostL.function-class) - ($i.INVOKESTATIC hostL.runtime-class "schedule" - ($t.method (list $t.long $Function) (#.Some $Object) (list)) #0))) + (|>> millisecondsI (_.unwrap #$.Long) + procedureI (_.CHECKCAST hostL.function-class) + (_.INVOKESTATIC hostL.runtime-class "schedule" + ($t.method (list $t.long $Function) (#.Some $Object) (list)) #0))) ## [Bundles] (def: lux-procs 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 ddf345a13..370f07f82 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 @@ -19,7 +19,7 @@ (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])) + ["_" inst])) ["la" analysis] (extension (analysis ["&." host])) ["ls" synthesis])) @@ -38,47 +38,47 @@ $.Inst )] - [L2S (|>> $i.L2I $i.I2S)] - [L2B (|>> $i.L2I $i.I2B)] - [L2C (|>> $i.L2I $i.I2C)] + [L2S (|>> _.L2I _.I2S)] + [L2B (|>> _.L2I _.I2B)] + [L2C (|>> _.L2I _.I2C)] ) (do-template [ ] [(def: ( inputI) @.Unary - (if (is? $i.NOP ) + (if (is? _.NOP ) (|>> inputI - ($i.unwrap ) - ($i.wrap )) + (_.unwrap ) + (_.wrap )) (|>> inputI - ($i.unwrap ) + (_.unwrap ) - ($i.wrap ))))] + (_.wrap ))))] - [convert//double-to-float #$.Double $i.D2F #$.Float] - [convert//double-to-int #$.Double $i.D2I #$.Int] - [convert//double-to-long #$.Double $i.D2L #$.Long] - [convert//float-to-double #$.Float $i.F2D #$.Double] - [convert//float-to-int #$.Float $i.F2I #$.Int] - [convert//float-to-long #$.Float $i.F2L #$.Long] - [convert//int-to-byte #$.Int $i.I2B #$.Byte] - [convert//int-to-char #$.Int $i.I2C #$.Char] - [convert//int-to-double #$.Int $i.I2D #$.Double] - [convert//int-to-float #$.Int $i.I2F #$.Float] - [convert//int-to-long #$.Int $i.I2L #$.Long] - [convert//int-to-short #$.Int $i.I2S #$.Short] - [convert//long-to-double #$.Long $i.L2D #$.Double] - [convert//long-to-float #$.Long $i.L2F #$.Float] - [convert//long-to-int #$.Long $i.L2I #$.Int] + [convert//double-to-float #$.Double _.D2F #$.Float] + [convert//double-to-int #$.Double _.D2I #$.Int] + [convert//double-to-long #$.Double _.D2L #$.Long] + [convert//float-to-double #$.Float _.F2D #$.Double] + [convert//float-to-int #$.Float _.F2I #$.Int] + [convert//float-to-long #$.Float _.F2L #$.Long] + [convert//int-to-byte #$.Int _.I2B #$.Byte] + [convert//int-to-char #$.Int _.I2C #$.Char] + [convert//int-to-double #$.Int _.I2D #$.Double] + [convert//int-to-float #$.Int _.I2F #$.Float] + [convert//int-to-long #$.Int _.I2L #$.Long] + [convert//int-to-short #$.Int _.I2S #$.Short] + [convert//long-to-double #$.Long _.L2D #$.Double] + [convert//long-to-float #$.Long _.L2F #$.Float] + [convert//long-to-int #$.Long _.L2I #$.Int] [convert//long-to-short #$.Long L2S #$.Short] [convert//long-to-byte #$.Long L2B #$.Byte] [convert//long-to-char #$.Long L2C #$.Char] - [convert//char-to-byte #$.Char $i.I2B #$.Byte] - [convert//char-to-short #$.Char $i.I2S #$.Short] - [convert//char-to-int #$.Char $i.NOP #$.Int] - [convert//char-to-long #$.Char $i.I2L #$.Long] - [convert//byte-to-long #$.Byte $i.I2L #$.Long] - [convert//short-to-long #$.Short $i.I2L #$.Long] + [convert//char-to-byte #$.Char _.I2B #$.Byte] + [convert//char-to-short #$.Char _.I2S #$.Short] + [convert//char-to-int #$.Char _.NOP #$.Int] + [convert//char-to-long #$.Char _.I2L #$.Long] + [convert//byte-to-long #$.Byte _.I2L #$.Long] + [convert//short-to-long #$.Short _.I2L #$.Long] ) (def: conversion-procs @@ -114,96 +114,96 @@ (do-template [ ] [(def: ( [xI yI]) @.Binary - (|>> xI ($i.unwrap ) - yI ($i.unwrap ) - ($i.wrap )))] - - [int//+ $i.IADD #$.Int #$.Int #$.Int] - [int//- $i.ISUB #$.Int #$.Int #$.Int] - [int//* $i.IMUL #$.Int #$.Int #$.Int] - [int/// $i.IDIV #$.Int #$.Int #$.Int] - [int//% $i.IREM #$.Int #$.Int #$.Int] - [int//and $i.IAND #$.Int #$.Int #$.Int] - [int//or $i.IOR #$.Int #$.Int #$.Int] - [int//xor $i.IXOR #$.Int #$.Int #$.Int] - [int//shl $i.ISHL #$.Int #$.Int #$.Int] - [int//shr $i.ISHR #$.Int #$.Int #$.Int] - [int//ushr $i.IUSHR #$.Int #$.Int #$.Int] + (|>> xI (_.unwrap ) + yI (_.unwrap ) + (_.wrap )))] + + [int//+ _.IADD #$.Int #$.Int #$.Int] + [int//- _.ISUB #$.Int #$.Int #$.Int] + [int//* _.IMUL #$.Int #$.Int #$.Int] + [int/// _.IDIV #$.Int #$.Int #$.Int] + [int//% _.IREM #$.Int #$.Int #$.Int] + [int//and _.IAND #$.Int #$.Int #$.Int] + [int//or _.IOR #$.Int #$.Int #$.Int] + [int//xor _.IXOR #$.Int #$.Int #$.Int] + [int//shl _.ISHL #$.Int #$.Int #$.Int] + [int//shr _.ISHR #$.Int #$.Int #$.Int] + [int//ushr _.IUSHR #$.Int #$.Int #$.Int] - [long//+ $i.LADD #$.Long #$.Long #$.Long] - [long//- $i.LSUB #$.Long #$.Long #$.Long] - [long//* $i.LMUL #$.Long #$.Long #$.Long] - [long/// $i.LDIV #$.Long #$.Long #$.Long] - [long//% $i.LREM #$.Long #$.Long #$.Long] - [long//and $i.LAND #$.Long #$.Long #$.Long] - [long//or $i.LOR #$.Long #$.Long #$.Long] - [long//xor $i.LXOR #$.Long #$.Long #$.Long] - [long//shl $i.LSHL #$.Long #$.Int #$.Long] - [long//shr $i.LSHR #$.Long #$.Int #$.Long] - [long//ushr $i.LUSHR #$.Long #$.Int #$.Long] - - [float//+ $i.FADD #$.Float #$.Float #$.Float] - [float//- $i.FSUB #$.Float #$.Float #$.Float] - [float//* $i.FMUL #$.Float #$.Float #$.Float] - [float/// $i.FDIV #$.Float #$.Float #$.Float] - [float//% $i.FREM #$.Float #$.Float #$.Float] + [long//+ _.LADD #$.Long #$.Long #$.Long] + [long//- _.LSUB #$.Long #$.Long #$.Long] + [long//* _.LMUL #$.Long #$.Long #$.Long] + [long/// _.LDIV #$.Long #$.Long #$.Long] + [long//% _.LREM #$.Long #$.Long #$.Long] + [long//and _.LAND #$.Long #$.Long #$.Long] + [long//or _.LOR #$.Long #$.Long #$.Long] + [long//xor _.LXOR #$.Long #$.Long #$.Long] + [long//shl _.LSHL #$.Long #$.Int #$.Long] + [long//shr _.LSHR #$.Long #$.Int #$.Long] + [long//ushr _.LUSHR #$.Long #$.Int #$.Long] + + [float//+ _.FADD #$.Float #$.Float #$.Float] + [float//- _.FSUB #$.Float #$.Float #$.Float] + [float//* _.FMUL #$.Float #$.Float #$.Float] + [float/// _.FDIV #$.Float #$.Float #$.Float] + [float//% _.FREM #$.Float #$.Float #$.Float] - [double//+ $i.DADD #$.Double #$.Double #$.Double] - [double//- $i.DSUB #$.Double #$.Double #$.Double] - [double//* $i.DMUL #$.Double #$.Double #$.Double] - [double/// $i.DDIV #$.Double #$.Double #$.Double] - [double//% $i.DREM #$.Double #$.Double #$.Double] + [double//+ _.DADD #$.Double #$.Double #$.Double] + [double//- _.DSUB #$.Double #$.Double #$.Double] + [double//* _.DMUL #$.Double #$.Double #$.Double] + [double/// _.DDIV #$.Double #$.Double #$.Double] + [double//% _.DREM #$.Double #$.Double #$.Double] ) (def: boolean-class ($t.class "java.lang.Boolean" (list))) -(def: falseI ($i.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class)) -(def: trueI ($i.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class)) +(def: falseI (_.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class)) +(def: trueI (_.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class)) (do-template [ ] [(def: ( [xI yI]) @.Binary - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) - (|>> xI ($i.unwrap ) - yI ($i.unwrap ) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> xI (_.unwrap ) + yI (_.unwrap ) ( @then) falseI - ($i.GOTO @end) - ($i.label @then) + (_.GOTO @end) + (_.label @then) trueI - ($i.label @end))))] + (_.label @end))))] - [int//= $i.IF_ICMPEQ #$.Int #$.Int #$.Boolean] - [int//< $i.IF_ICMPLT #$.Int #$.Int #$.Boolean] + [int//= _.IF_ICMPEQ #$.Int #$.Int #$.Boolean] + [int//< _.IF_ICMPLT #$.Int #$.Int #$.Boolean] - [char//= $i.IF_ICMPEQ #$.Char #$.Char #$.Boolean] - [char//< $i.IF_ICMPLT #$.Char #$.Char #$.Boolean] + [char//= _.IF_ICMPEQ #$.Char #$.Char #$.Boolean] + [char//< _.IF_ICMPLT #$.Char #$.Char #$.Boolean] ) (do-template [ ] [(def: ( [xI yI]) @.Binary - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) - (|>> xI ($i.unwrap ) - yI ($i.unwrap ) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> xI (_.unwrap ) + yI (_.unwrap ) - ($i.int ) - ($i.IF_ICMPEQ @then) + (_.int ) + (_.IF_ICMPEQ @then) falseI - ($i.GOTO @end) - ($i.label @then) + (_.GOTO @end) + (_.label @then) trueI - ($i.label @end))))] + (_.label @end))))] - [long//= $i.LCMP 0 #$.Long #$.Long #$.Boolean] - [long//< $i.LCMP -1 #$.Long #$.Long #$.Boolean] + [long//= _.LCMP 0 #$.Long #$.Long #$.Boolean] + [long//< _.LCMP -1 #$.Long #$.Long #$.Boolean] - [float//= $i.FCMPG 0 #$.Float #$.Float #$.Boolean] - [float//< $i.FCMPG -1 #$.Float #$.Float #$.Boolean] + [float//= _.FCMPG 0 #$.Float #$.Float #$.Boolean] + [float//< _.FCMPG -1 #$.Float #$.Float #$.Boolean] - [double//= $i.DCMPG 0 #$.Double #$.Double #$.Boolean] - [double//< $i.DCMPG -1 #$.Double #$.Double #$.Boolean] + [double//= _.DCMPG 0 #$.Double #$.Double #$.Boolean] + [double//< _.DCMPG -1 #$.Double #$.Double #$.Boolean] ) (def: int-procs @@ -281,9 +281,9 @@ (def: (array//length arrayI) @.Unary (|>> arrayI - $i.ARRAYLENGTH - $i.I2L - ($i.wrap #$.Long))) + _.ARRAYLENGTH + _.I2L + (_.wrap #$.Long))) (def: (array//new proc translate inputs) (-> Text @.Proc) @@ -302,9 +302,9 @@ "char" $t.char _ ($t.class class (list))))]] (wrap (|>> lengthI - ($i.unwrap #$.Long) - $i.L2I - ($i.array arrayJT)))) + (_.unwrap #$.Long) + _.L2I + (_.array arrayJT)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -317,19 +317,19 @@ [arrayI (translate arrayS) idxI (translate idxS) #let [loadI (case class - "boolean" (|>> $i.BALOAD ($i.wrap #$.Boolean)) - "byte" (|>> $i.BALOAD ($i.wrap #$.Byte)) - "short" (|>> $i.SALOAD ($i.wrap #$.Short)) - "int" (|>> $i.IALOAD ($i.wrap #$.Int)) - "long" (|>> $i.LALOAD ($i.wrap #$.Long)) - "float" (|>> $i.FALOAD ($i.wrap #$.Float)) - "double" (|>> $i.DALOAD ($i.wrap #$.Double)) - "char" (|>> $i.CALOAD ($i.wrap #$.Char)) - _ $i.AALOAD)]] + "boolean" (|>> _.BALOAD (_.wrap #$.Boolean)) + "byte" (|>> _.BALOAD (_.wrap #$.Byte)) + "short" (|>> _.SALOAD (_.wrap #$.Short)) + "int" (|>> _.IALOAD (_.wrap #$.Int)) + "long" (|>> _.LALOAD (_.wrap #$.Long)) + "float" (|>> _.FALOAD (_.wrap #$.Float)) + "double" (|>> _.DALOAD (_.wrap #$.Double)) + "char" (|>> _.CALOAD (_.wrap #$.Char)) + _ _.AALOAD)]] (wrap (|>> arrayI idxI - ($i.unwrap #$.Long) - $i.L2I + (_.unwrap #$.Long) + _.L2I loadI))) _ @@ -344,20 +344,20 @@ idxI (translate idxS) valueI (translate valueS) #let [storeI (case class - "boolean" (|>> ($i.unwrap #$.Boolean) $i.BASTORE) - "byte" (|>> ($i.unwrap #$.Byte) $i.BASTORE) - "short" (|>> ($i.unwrap #$.Short) $i.SASTORE) - "int" (|>> ($i.unwrap #$.Int) $i.IASTORE) - "long" (|>> ($i.unwrap #$.Long) $i.LASTORE) - "float" (|>> ($i.unwrap #$.Float) $i.FASTORE) - "double" (|>> ($i.unwrap #$.Double) $i.DASTORE) - "char" (|>> ($i.unwrap #$.Char) $i.CASTORE) - _ $i.AASTORE)]] + "boolean" (|>> (_.unwrap #$.Boolean) _.BASTORE) + "byte" (|>> (_.unwrap #$.Byte) _.BASTORE) + "short" (|>> (_.unwrap #$.Short) _.SASTORE) + "int" (|>> (_.unwrap #$.Int) _.IASTORE) + "long" (|>> (_.unwrap #$.Long) _.LASTORE) + "float" (|>> (_.unwrap #$.Float) _.FASTORE) + "double" (|>> (_.unwrap #$.Double) _.DASTORE) + "char" (|>> (_.unwrap #$.Char) _.CASTORE) + _ _.AASTORE)]] (wrap (|>> arrayI - $i.DUP + _.DUP idxI - ($i.unwrap #$.Long) - $i.L2I + (_.unwrap #$.Long) + _.L2I valueI storeI))) @@ -376,33 +376,33 @@ (def: (object//null _) @.Nullary - $i.NULL) + _.NULL) (def: (object//null? objectI) @.Unary - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) (|>> objectI - ($i.IFNULL @then) + (_.IFNULL @then) falseI - ($i.GOTO @end) - ($i.label @then) + (_.GOTO @end) + (_.label @then) trueI - ($i.label @end)))) + (_.label @end)))) (def: (object//synchronized [monitorI exprI]) @.Binary (|>> monitorI - $i.DUP - $i.MONITORENTER + _.DUP + _.MONITORENTER exprI - $i.SWAP - $i.MONITOREXIT)) + _.SWAP + _.MONITOREXIT)) (def: (object//throw exceptionI) @.Unary (|>> exceptionI - $i.ATHROW)) + _.ATHROW)) (def: (object//class proc translate inputs) (-> Text @.Proc) @@ -410,12 +410,12 @@ (^ (list [_ (#.Text class)])) (do macro.Monad [] - (wrap (|>> ($i.string class) - ($i.INVOKESTATIC "java.lang.Class" "forName" - ($t.method (list ($t.class "java.lang.String" (list))) - (#.Some ($t.class "java.lang.Class" (list))) - (list)) - #0)))) + (wrap (|>> (_.string class) + (_.INVOKESTATIC "java.lang.Class" "forName" + ($t.method (list ($t.class "java.lang.String" (list))) + (#.Some ($t.class "java.lang.Class" (list))) + (list)) + #0)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -427,8 +427,8 @@ (do macro.Monad [objectI (translate objectS)] (wrap (|>> objectI - ($i.INSTANCEOF class) - ($i.wrap #$.Boolean)))) + (_.INSTANCEOF class) + (_.wrap #$.Boolean)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -443,10 +443,10 @@ ## Wrap (^template [ ] [ ] - (wrap (|>> valueI ($i.wrap ))) + (wrap (|>> valueI (_.wrap ))) [ ] - (wrap (|>> valueI ($i.unwrap )))) + (wrap (|>> valueI (_.unwrap )))) (["boolean" "java.lang.Boolean" #$.Boolean] ["byte" "java.lang.Byte" #$.Byte] ["short" "java.lang.Short" #$.Short] @@ -505,11 +505,11 @@ "double" #$.Double "char" #$.Char _ (undefined))] - (wrap (|>> ($i.GETSTATIC class field (#$.Primitive primitive)) - ($i.wrap primitive)))) + (wrap (|>> (_.GETSTATIC class field (#$.Primitive primitive)) + (_.wrap primitive)))) #.None - (wrap ($i.GETSTATIC class field ($t.class unboxed (list)))))) + (wrap (_.GETSTATIC class field ($t.class unboxed (list)))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -533,15 +533,15 @@ "char" #$.Char _ (undefined))] (wrap (|>> valueI - ($i.unwrap primitive) - ($i.PUTSTATIC class field (#$.Primitive primitive)) - ($i.string hostL.unit)))) + (_.unwrap primitive) + (_.PUTSTATIC class field (#$.Primitive primitive)) + (_.string hostL.unit)))) #.None (wrap (|>> valueI - ($i.CHECKCAST class) - ($i.PUTSTATIC class field ($t.class class (list))) - ($i.string hostL.unit))))) + (_.CHECKCAST class) + (_.PUTSTATIC class field ($t.class class (list))) + (_.string hostL.unit))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -565,14 +565,14 @@ "char" #$.Char _ (undefined))] (wrap (|>> objectI - ($i.CHECKCAST class) - ($i.GETFIELD class field (#$.Primitive primitive)) - ($i.wrap primitive)))) + (_.CHECKCAST class) + (_.GETFIELD class field (#$.Primitive primitive)) + (_.wrap primitive)))) #.None (wrap (|>> objectI - ($i.CHECKCAST class) - ($i.GETFIELD class field ($t.class unboxed (list))))))) + (_.CHECKCAST class) + (_.GETFIELD class field ($t.class unboxed (list))))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -597,19 +597,19 @@ "char" #$.Char _ (undefined))] (wrap (|>> objectI - ($i.CHECKCAST class) - $i.DUP + (_.CHECKCAST class) + _.DUP valueI - ($i.unwrap primitive) - ($i.PUTFIELD class field (#$.Primitive primitive))))) + (_.unwrap primitive) + (_.PUTFIELD class field (#$.Primitive primitive))))) #.None (wrap (|>> objectI - ($i.CHECKCAST class) - $i.DUP + (_.CHECKCAST class) + _.DUP valueI - ($i.CHECKCAST unboxed) - ($i.PUTFIELD class field ($t.class unboxed (list))))))) + (_.CHECKCAST unboxed) + (_.PUTFIELD class field ($t.class unboxed (list))))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -676,10 +676,10 @@ (do macro.Monad [argsTI (monad.map @ (translate-arg translate) argsS) returnT (method-return-type unboxed)] - (wrap (|>> ($i.fuse (list/map product.right argsTI)) - ($i.INVOKESTATIC class method - ($t.method (list/map product.left argsTI) returnT (list)) - #0)))) + (wrap (|>> (_.fuse (list/map product.right argsTI)) + (_.INVOKESTATIC class method + ($t.method (list/map product.left argsTI) returnT (list)) + #0)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -695,8 +695,8 @@ argsTI (monad.map @ (translate-arg translate) argsS) returnT (method-return-type unboxed)] (wrap (|>> objectI - ($i.CHECKCAST class) - ($i.fuse (list/map product.right argsTI)) + (_.CHECKCAST class) + (_.fuse (list/map product.right argsTI)) ( class method ($t.method (list/map product.left argsTI) returnT (list)) )))) @@ -704,9 +704,9 @@ _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))] - [invoke//virtual $i.INVOKEVIRTUAL #0] - [invoke//special $i.INVOKESPECIAL #0] - [invoke//interface $i.INVOKEINTERFACE #1] + [invoke//virtual _.INVOKEVIRTUAL #0] + [invoke//special _.INVOKESPECIAL #0] + [invoke//interface _.INVOKEINTERFACE #1] ) (def: (invoke//constructor proc translate inputs) @@ -715,12 +715,12 @@ (^ (list& [_ (#.Text class)] argsS)) (do macro.Monad [argsTI (monad.map @ (translate-arg translate) argsS)] - (wrap (|>> ($i.NEW class) - $i.DUP - ($i.fuse (list/map product.right argsTI)) - ($i.INVOKESPECIAL class "" - ($t.method (list/map product.left argsTI) #.None (list)) - #0)))) + (wrap (|>> (_.NEW class) + _.DUP + (_.fuse (list/map product.right argsTI)) + (_.INVOKESPECIAL class "" + ($t.method (list/map product.left argsTI) #.None (list)) + #0)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux index 3686b9210..ba606a437 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -3,19 +3,20 @@ [control [monad (#+ do)]] [data - [text ("text/" Hash) + [text ("text/." Hash) format]] - [language - ["." name] - ["." reference (#+ Register Variable)] - ["." compiler ("operation/" Monad) - ["." translation]]]] + [compiler + [default + ["." name] + ["." reference (#+ Register Variable)] + ["." phase ("operation/." Monad) + ["." translation]]]]] [luxc [lang [host [jvm (#+ Inst Operation) ["$t" type] - ["$i" inst]]]]] + ["_" inst]]]]] ["." //]) (do-template [ ] @@ -29,16 +30,16 @@ (def: (foreign variable) (-> Register (Operation Inst)) - (do compiler.Monad + (do phase.Monad [function-class translation.context] - (wrap (|>> ($i.ALOAD +0) - ($i.GETFIELD function-class - (|> variable .nat foreign-name) - //.$Object))))) + (wrap (|>> (_.ALOAD +0) + (_.GETFIELD function-class + (|> variable .nat foreign-name) + //.$Object))))) (def: local (-> Register (Operation Inst)) - (|>> $i.ALOAD operation/wrap)) + (|>> _.ALOAD operation/wrap)) (def: #export (variable variable) (-> Variable (Operation Inst)) @@ -49,7 +50,7 @@ (#reference.Foreign variable) (foreign variable))) -(def: #export (constant [def-module def-name]) - (-> Ident (Operation Inst)) - (let [bytecode-name (format def-module "/" (name.normalize def-name) (%n (text/hash def-name)))] - (operation/wrap ($i.GETSTATIC bytecode-name //.value-field //.$Object)))) +(def: #export (constant [module short]) + (-> Name (Operation Inst)) + (let [bytecode-name (format module "/" (name.normalize short) (%n (text/hash short)))] + (operation/wrap (_.GETSTATIC bytecode-name //.value-field //.$Object)))) 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 86fe53d1e..86efad1ab 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -6,19 +6,20 @@ [text format] [collection - [list ("list/" Functor)]]] + ["." list ("list/." Functor)]]] ["." math] - [language - ["." compiler - [analysis (#+ Arity)] - ["." translation]]]] + [compiler + [default + ["." phase + [analysis (#+ Arity)] + ["." translation]]]]] [luxc [lang [host ["$" jvm (#+ Inst Method Def Operation) ["$t" type] ["$d" def] - ["$i" inst]]]]] + ["_" inst]]]]] ["." // (#+ ByteCode)]) (def: $Object $.Type ($t.class "java.lang.Object" (list))) @@ -37,10 +38,10 @@ (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)) #0))] - (|>> outI ($i.string "LOG: ") (printI "print") - outI $i.SWAP (printI "println")))) + (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))] + (|>> outI (_.string "LOG: ") (printI "print") + outI _.SWAP (printI "println")))) (def: variant-method Method @@ -48,51 +49,51 @@ (def: #export variantI Inst - ($i.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) + (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) (def: #export leftI Inst - (|>> ($i.int 0) - $i.NULL - $i.DUP2_X1 - $i.POP2 + (|>> (_.int 0) + _.NULL + _.DUP2_X1 + _.POP2 variantI)) (def: #export rightI Inst - (|>> ($i.int 1) - ($i.string "") - $i.DUP2_X1 - $i.POP2 + (|>> (_.int 1) + (_.string "") + _.DUP2_X1 + _.POP2 variantI)) (def: #export someI Inst rightI) (def: #export noneI Inst - (|>> ($i.int 0) - $i.NULL - ($i.string //.unit) + (|>> (_.int 0) + _.NULL + (_.string //.unit) variantI)) (def: (try-methodI unsafeI) (-> Inst Inst) - (<| $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) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler "java.lang.Exception") + (_.label @from) unsafeI someI - $i.ARETURN - ($i.label @to) - ($i.label @handler) + _.ARETURN + (_.label @to) + (_.label @handler) noneI - $i.ARETURN))) + _.ARETURN))) (def: #export string-concatI Inst - ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) + (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) (def: #export partials-field Text "partials") (def: #export apply-method Text "apply") @@ -104,84 +105,84 @@ (def: adt-methods Def - (let [store-tagI (|>> $i.DUP ($i.int 0) ($i.ILOAD +0) ($i.wrap #$.Int) $i.AASTORE) - store-flagI (|>> $i.DUP ($i.int 1) ($i.ALOAD +1) $i.AASTORE) - store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE) + (let [store-tagI (|>> _.DUP (_.int 0) (_.ILOAD +0) (_.wrap #$.Int) _.AASTORE) + store-flagI (|>> _.DUP (_.int 1) (_.ALOAD +1) _.AASTORE) + store-valueI (|>> _.DUP (_.int 2) (_.ALOAD +2) _.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)) - (let [on-normal-objectI (|>> ($i.ALOAD +0) - ($i.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0)) - on-null-objectI ($i.string "NULL") - arrayI (|>> ($i.ALOAD +0) - ($i.CHECKCAST ($t.descriptor $Object-Array))) - recurseI ($i.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) - force-elemI (|>> $i.DUP arrayI $i.SWAP $i.AALOAD recurseI) - swap2 (|>> $i.DUP2_X2 ## X,Y => Y,X,Y - $i.POP2 ## Y,X,Y => Y,X + (<| _.with-label (function (_ @is-null)) + _.with-label (function (_ @normal-object)) + _.with-label (function (_ @array-loop)) + _.with-label (function (_ @within-bounds)) + _.with-label (function (_ @is-first)) + _.with-label (function (_ @elem-end)) + _.with-label (function (_ @fold-end)) + (let [on-normal-objectI (|>> (_.ALOAD +0) + (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0)) + on-null-objectI (_.string "NULL") + arrayI (|>> (_.ALOAD +0) + (_.CHECKCAST ($t.descriptor $Object-Array))) + recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) + force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI) + swap2 (|>> _.DUP2_X2 ## X,Y => Y,X,Y + _.POP2 ## Y,X,Y => Y,X ) - add-spacingI (|>> ($i.string ", ") $i.SWAP string-concatI) - merge-with-totalI (|>> $i.DUP_X2 $i.POP ## TSIP => TPSI + add-spacingI (|>> (_.string ", ") _.SWAP string-concatI) + merge-with-totalI (|>> _.DUP_X2 _.POP ## TSIP => TPSI swap2 ## TPSI => SITP string-concatI ## SITP => SIT - $i.DUP_X2 $i.POP ## SIT => TSI + _.DUP_X2 _.POP ## SIT => TSI ) - foldI (|>> $i.DUP ## TSI => TSII - ($i.IFEQ @is-first) ## TSI - force-elemI add-spacingI merge-with-totalI ($i.GOTO @elem-end) - ($i.label @is-first) ## TSI + foldI (|>> _.DUP ## TSI => TSII + (_.IFEQ @is-first) ## TSI + force-elemI add-spacingI merge-with-totalI (_.GOTO @elem-end) + (_.label @is-first) ## TSI force-elemI merge-with-totalI - ($i.label @elem-end) ## TSI + (_.label @elem-end) ## TSI ) - inc-idxI (|>> ($i.int 1) $i.IADD) - on-array-objectI (|>> ($i.string "[") ## T - arrayI $i.ARRAYLENGTH ## TS - ($i.int 0) ## TSI - ($i.label @array-loop) ## TSI - $i.DUP2 - ($i.IF_ICMPGT @within-bounds) ## TSI - $i.POP2 ($i.string "]") string-concatI ($i.GOTO @fold-end) - ($i.label @within-bounds) - foldI inc-idxI ($i.GOTO @array-loop) - ($i.label @fold-end))]) - (|>> ($i.ALOAD +0) - ($i.IFNULL @is-null) - ($i.ALOAD +0) - ($i.INSTANCEOF ($t.descriptor $Object-Array)) - ($i.IFEQ @normal-object) - on-array-objectI $i.ARETURN - ($i.label @normal-object) on-normal-objectI $i.ARETURN - ($i.label @is-null) on-null-objectI $i.ARETURN))) + inc-idxI (|>> (_.int 1) _.IADD) + on-array-objectI (|>> (_.string "[") ## T + arrayI _.ARRAYLENGTH ## TS + (_.int 0) ## TSI + (_.label @array-loop) ## TSI + _.DUP2 + (_.IF_ICMPGT @within-bounds) ## TSI + _.POP2 (_.string "]") string-concatI (_.GOTO @fold-end) + (_.label @within-bounds) + foldI inc-idxI (_.GOTO @array-loop) + (_.label @fold-end))]) + (|>> (_.ALOAD +0) + (_.IFNULL @is-null) + (_.ALOAD +0) + (_.INSTANCEOF ($t.descriptor $Object-Array)) + (_.IFEQ @normal-object) + on-array-objectI _.ARETURN + (_.label @normal-object) on-normal-objectI _.ARETURN + (_.label @is-null) on-null-objectI _.ARETURN))) ($d.method #$.Public $.staticM "variant_make" ($t.method (list $t.int $Object $Object) (#.Some $Variant) (list)) - (|>> ($i.int 3) - ($i.array $Object) + (|>> (_.int 3) + (_.array $Object) store-tagI store-flagI store-valueI - $i.ARETURN))))) + _.ARETURN))))) (def: #export force-textI Inst - ($i.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) + (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) -(def: frac-shiftI Inst ($i.double (math.pow 32.0 2.0))) +(def: frac-shiftI Inst (_.double (math.pow 32.0 2.0))) (def: frac-methods Def (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) - ($i.wrap #$.Double)))) + (|>> (_.ALOAD +0) + (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) + (_.wrap #$.Double)))) )) (def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list))) @@ -190,186 +191,186 @@ Def (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.ILOAD +2) - ($i.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) + (|>> (_.ALOAD +0) + (_.ILOAD +1) + (_.ILOAD +2) + (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) - $i.I2L - ($i.wrap #$.Long)))) + (|>> (_.ALOAD +0) + (_.ILOAD +1) + (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) + _.I2L + (_.wrap #$.Long)))) )) (def: pm-methods Def - (let [tuple-sizeI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH) - tuple-elemI (|>> ($i.ALOAD +0) ($i.ILOAD +1) $i.AALOAD) - expected-last-sizeI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD) - tuple-tailI (|>> ($i.ALOAD +0) tuple-sizeI ($i.int 1) $i.ISUB $i.AALOAD ($i.CHECKCAST ($t.descriptor $Tuple)))] + (let [tuple-sizeI (|>> (_.ALOAD +0) _.ARRAYLENGTH) + tuple-elemI (|>> (_.ALOAD +0) (_.ILOAD +1) _.AALOAD) + expected-last-sizeI (|>> (_.ILOAD +1) (_.int 1) _.IADD) + tuple-tailI (|>> (_.ALOAD +0) tuple-sizeI (_.int 1) _.ISUB _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))] (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list)) - (|>> ($i.NEW "java.lang.IllegalStateException") - $i.DUP - ($i.string "Invalid expression for pattern-matching.") - ($i.INVOKESPECIAL "java.lang.IllegalStateException" "" ($t.method (list $String) #.None (list)) #0) - $i.ATHROW)) + (|>> (_.NEW "java.lang.IllegalStateException") + _.DUP + (_.string "Invalid expression for pattern-matching.") + (_.INVOKESPECIAL "java.lang.IllegalStateException" "" ($t.method (list $String) #.None (list)) #0) + _.ATHROW)) ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list)) - (|>> ($i.NEW "java.lang.IllegalStateException") - $i.DUP - ($i.string "Error while applying function.") - ($i.INVOKESPECIAL "java.lang.IllegalStateException" "" ($t.method (list $String) #.None (list)) #0) - $i.ATHROW)) + (|>> (_.NEW "java.lang.IllegalStateException") + _.DUP + (_.string "Error while applying function.") + (_.INVOKESPECIAL "java.lang.IllegalStateException" "" ($t.method (list $String) #.None (list)) #0) + _.ATHROW)) ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list)) - (|>> ($i.int 2) - ($i.ANEWARRAY "java.lang.Object") - $i.DUP - ($i.int 0) - ($i.ALOAD +0) - $i.AASTORE - $i.DUP - ($i.int 1) - ($i.ALOAD +1) - $i.AASTORE - $i.ARETURN)) + (|>> (_.int 2) + (_.ANEWARRAY "java.lang.Object") + _.DUP + (_.int 0) + (_.ALOAD +0) + _.AASTORE + _.DUP + (_.int 1) + (_.ALOAD +1) + _.AASTORE + _.ARETURN)) ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list)) - (|>> ($i.ALOAD +0) - ($i.int 0) - $i.AALOAD - ($i.CHECKCAST ($t.descriptor $Stack)) - $i.ARETURN)) + (|>> (_.ALOAD +0) + (_.int 0) + _.AALOAD + (_.CHECKCAST ($t.descriptor $Stack)) + _.ARETURN)) ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list)) - (|>> ($i.ALOAD +0) - ($i.int 1) - $i.AALOAD - $i.ARETURN)) + (|>> (_.ALOAD +0) + (_.int 1) + _.AALOAD + _.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)) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @just-return)) + _.with-label (function (_ @then)) + _.with-label (function (_ @further)) + _.with-label (function (_ @shorten)) + _.with-label (function (_ @wrong)) (let [variant-partI (: (-> Nat Inst) (function (_ idx) - (|>> ($i.int (.int idx)) $i.AALOAD))) + (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI +0) ($i.unwrap #$.Int))) + (|>> (variant-partI +0) (_.unwrap #$.Int))) flagI (variant-partI +1) datumI (variant-partI +2) - shortenI (|>> ($i.ALOAD +0) tagI ## Get tag - ($i.ILOAD +1) $i.ISUB ## Shorten tag - ($i.ALOAD +0) flagI ## Get flag - ($i.ALOAD +0) datumI ## Get value + shortenI (|>> (_.ALOAD +0) tagI ## Get tag + (_.ILOAD +1) _.ISUB ## Shorten tag + (_.ALOAD +0) flagI ## Get flag + (_.ALOAD +0) datumI ## Get value variantI ## Build sum - $i.ARETURN) - update-tagI (|>> $i.ISUB ($i.ISTORE +1)) - update-variantI (|>> ($i.ALOAD +0) datumI ($i.CHECKCAST ($t.descriptor $Variant)) ($i.ASTORE +0)) - failureI (|>> $i.NULL $i.ARETURN) - return-datumI (|>> ($i.ALOAD +0) datumI $i.ARETURN)]) - (|>> ($i.label @begin) - ($i.ILOAD +1) ## tag - ($i.ALOAD +0) tagI ## tag, sumT - $i.DUP2 ($i.IF_ICMPEQ @then) - $i.DUP2 ($i.IF_ICMPGT @further) - $i.DUP2 ($i.IF_ICMPLT @shorten) - ## $i.POP2 + _.ARETURN) + update-tagI (|>> _.ISUB (_.ISTORE +1)) + update-variantI (|>> (_.ALOAD +0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE +0)) + failureI (|>> _.NULL _.ARETURN) + return-datumI (|>> (_.ALOAD +0) datumI _.ARETURN)]) + (|>> (_.label @begin) + (_.ILOAD +1) ## tag + (_.ALOAD +0) tagI ## tag, sumT + _.DUP2 (_.IF_ICMPEQ @then) + _.DUP2 (_.IF_ICMPGT @further) + _.DUP2 (_.IF_ICMPLT @shorten) + ## _.POP2 failureI - ($i.label @then) ## tag, sumT - ($i.ALOAD +2) ## tag, sumT, wants-last? - ($i.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? - ($i.IF_ACMPEQ @just-return) ## tag, sumT - ($i.label @further) ## tag, sumT - ($i.ALOAD +0) flagI ## tag, sumT, last? - ($i.IFNULL @wrong) ## tag, sumT + (_.label @then) ## tag, sumT + (_.ALOAD +2) ## tag, sumT, wants-last? + (_.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? + (_.IF_ACMPEQ @just-return) ## tag, sumT + (_.label @further) ## tag, sumT + (_.ALOAD +0) flagI ## tag, sumT, last? + (_.IFNULL @wrong) ## tag, sumT update-tagI update-variantI - ($i.GOTO @begin) - ($i.label @just-return) ## tag, sumT - ## $i.POP2 + (_.GOTO @begin) + (_.label @just-return) ## tag, sumT + ## _.POP2 return-datumI - ($i.label @shorten) ## tag, sumT - ($i.ALOAD +2) ($i.IFNULL @wrong) - ## $i.POP2 + (_.label @shorten) ## tag, sumT + (_.ALOAD +2) (_.IFNULL @wrong) + ## _.POP2 shortenI - ($i.label @wrong) ## tag, sumT - ## $i.POP2 + (_.label @wrong) ## tag, sumT + ## _.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)) - (let [updated-idxI (|>> $i.SWAP $i.ISUB)]) - (|>> ($i.label @begin) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @not-recursive)) + (let [updated-idxI (|>> _.SWAP _.ISUB)]) + (|>> (_.label @begin) tuple-sizeI expected-last-sizeI - $i.DUP2 ($i.IF_ICMPGT @not-recursive) + _.DUP2 (_.IF_ICMPGT @not-recursive) ## Recursive - updated-idxI ($i.ISTORE +1) - tuple-tailI ($i.ASTORE +0) - ($i.GOTO @begin) - ($i.label @not-recursive) - ## $i.POP2 + updated-idxI (_.ISTORE +1) + tuple-tailI (_.ASTORE +0) + (_.GOTO @begin) + (_.label @not-recursive) + ## _.POP2 tuple-elemI - $i.ARETURN))) + _.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)) - (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)) #0))]) - (|>> ($i.label @begin) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @tail)) + _.with-label (function (_ @slice)) + (let [updated-idxI (|>> (_.ILOAD +1) (_.int 1) _.IADD tuple-sizeI _.ISUB) + sliceI (|>> (_.ALOAD +0) (_.ILOAD +1) tuple-sizeI + (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) #0))]) + (|>> (_.label @begin) tuple-sizeI expected-last-sizeI - $i.DUP2 ($i.IF_ICMPEQ @tail) - ($i.IF_ICMPGT @slice) + _.DUP2 (_.IF_ICMPEQ @tail) + (_.IF_ICMPGT @slice) ## Must recurse - tuple-tailI ($i.ASTORE +0) - updated-idxI ($i.ISTORE +1) - ($i.GOTO @begin) - ($i.label @slice) + tuple-tailI (_.ASTORE +0) + updated-idxI (_.ISTORE +1) + (_.GOTO @begin) + (_.label @slice) sliceI - $i.ARETURN - ($i.label @tail) - ## $i.POP2 + _.ARETURN + (_.label @tail) + ## _.POP2 tuple-elemI - $i.ARETURN))) + _.ARETURN))) ))) (def: io-methods Def - (let [string-writerI (|>> ($i.NEW "java.io.StringWriter") - $i.DUP - ($i.INVOKESPECIAL "java.io.StringWriter" "" ($t.method (list) #.None (list)) #0)) - print-writerI (|>> ($i.NEW "java.io.PrintWriter") - $i.SWAP - $i.DUP2 - $i.POP - $i.SWAP - ($i.boolean #1) - ($i.INVOKESPECIAL "java.io.PrintWriter" "" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) + (let [string-writerI (|>> (_.NEW "java.io.StringWriter") + _.DUP + (_.INVOKESPECIAL "java.io.StringWriter" "" ($t.method (list) #.None (list)) #0)) + print-writerI (|>> (_.NEW "java.io.PrintWriter") + _.SWAP + _.DUP2 + _.POP + _.SWAP + (_.boolean #1) + (_.INVOKESPECIAL "java.io.PrintWriter" "" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) )] (|>> ($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.try @from @to @handler "java.lang.Throwable") - ($i.label @from) - ($i.ALOAD +0) - $i.NULL - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler "java.lang.Throwable") + (_.label @from) + (_.ALOAD +0) + _.NULL + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) rightI - $i.ARETURN - ($i.label @to) - ($i.label @handler) + _.ARETURN + (_.label @to) + (_.label @handler) string-writerI ## TW - $i.DUP2 ## TWTW + _.DUP2 ## TWTW print-writerI ## TWTP - ($i.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW - ($i.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS - $i.SWAP $i.POP leftI - $i.ARETURN))) + (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW + (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS + _.SWAP _.POP leftI + _.ARETURN))) ))) (def: process-methods @@ -377,55 +378,55 @@ (let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor" executorT ($t.class executor-class (list)) executor-field "executor" - endI (|>> ($i.string //.unit) - $i.ARETURN) + endI (|>> (_.string //.unit) + _.ARETURN) runnableI (: (-> Inst Inst) (function (_ functionI) - (|>> ($i.NEW //.runnable-class) - $i.DUP + (|>> (_.NEW //.runnable-class) + _.DUP functionI - ($i.INVOKESPECIAL //.runnable-class "" ($t.method (list $Function) #.None (list)) #0)))) + (_.INVOKESPECIAL //.runnable-class "" ($t.method (list $Function) #.None (list)) #0)))) threadI (: (-> Inst Inst) (function (_ runnableI) - (|>> ($i.NEW "java.lang.Thread") - $i.DUP + (|>> (_.NEW "java.lang.Thread") + _.DUP runnableI - ($i.INVOKESPECIAL "java.lang.Thread" "" ($t.method (list $Runnable) #.None (list)) #0))))] + (_.INVOKESPECIAL "java.lang.Thread" "" ($t.method (list $Runnable) #.None (list)) #0))))] (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) executor-field executorT) ($d.method #$.Public $.staticM "" ($t.method (list) #.None (list)) - (let [parallelism-levelI (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) - ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) - executorI (|>> ($i.NEW executor-class) - $i.DUP + (let [parallelism-levelI (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) + executorI (|>> (_.NEW executor-class) + _.DUP parallelism-levelI - ($i.INVOKESPECIAL executor-class "" ($t.method (list $t.int) #.None (list)) #0))] + (_.INVOKESPECIAL executor-class "" ($t.method (list $t.int) #.None (list)) #0))] (|>> executorI - ($i.PUTSTATIC //.runtime-class executor-field executorT) - $i.RETURN))) + (_.PUTSTATIC //.runtime-class executor-field executorT) + _.RETURN))) ($d.method #$.Public $.staticM "schedule" ($t.method (list $t.long $Function) (#.Some $Object) (list)) - (let [delayI ($i.LLOAD +0) + (let [delayI (_.LLOAD +0) immediacy-checkI (|>> delayI - ($i.long 0) - $i.LCMP) + (_.long 0) + _.LCMP) time-unit-class "java.util.concurrent.TimeUnit" time-unitT ($t.class time-unit-class (list)) futureT ($t.class "java.util.concurrent.ScheduledFuture" (list)) - executorI ($i.GETSTATIC //.runtime-class executor-field executorT) + executorI (_.GETSTATIC //.runtime-class executor-field executorT) schedule-laterI (|>> executorI - (runnableI ($i.ALOAD +2)) + (runnableI (_.ALOAD +2)) delayI - ($i.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) - ($i.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) + (_.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) + (_.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) schedule-immediatelyI (|>> executorI - (runnableI ($i.ALOAD +2)) - ($i.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] - (<| $i.with-label (function (_ @immediately)) + (runnableI (_.ALOAD +2)) + (_.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] + (<| _.with-label (function (_ @immediately)) (|>> immediacy-checkI - ($i.IFEQ @immediately) + (_.IFEQ @immediately) schedule-laterI endI - ($i.label @immediately) + (_.label @immediately) schedule-immediatelyI endI)))) ))) @@ -439,7 +440,7 @@ pm-methods io-methods process-methods))] - (do compiler.Monad + (do phase.Monad [_ (translation.execute! [//.runtime-class bytecode])] (wrap bytecode)))) @@ -449,27 +450,27 @@ (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) (let [preI (|> (list.n/range +0 (dec arity)) - (list/map $i.ALOAD) - $i.fuse)] + (list/map _.ALOAD) + _.fuse)] (|>> preI - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) - ($i.CHECKCAST //.function-class) - ($i.ALOAD arity) - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) - $i.ARETURN))))) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) + (_.CHECKCAST //.function-class) + (_.ALOAD arity) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + _.ARETURN))))) (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1))) $d.fuse) bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list) (|>> ($d.field #$.Public $.finalF partials-field $t.int) ($d.method #$.Public $.noneM "" ($t.method (list $t.int) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.INVOKESPECIAL "java.lang.Object" "" ($t.method (list) #.None (list)) #0) - ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.PUTFIELD //.function-class partials-field $t.int) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.INVOKESPECIAL "java.lang.Object" "" ($t.method (list) #.None (list)) #0) + (_.ALOAD +0) + (_.ILOAD +1) + (_.PUTFIELD //.function-class partials-field $t.int) + _.RETURN)) applyI))] - (do compiler.Monad + (do phase.Monad [_ (translation.execute! [//.function-class bytecode])] (wrap bytecode)))) @@ -479,26 +480,26 @@ bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)]) (|>> ($d.field #$.Public $.finalF procedure-field $Function) ($d.method #$.Public $.noneM "" ($t.method (list $Function) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.INVOKESPECIAL "java.lang.Object" "" ($t.method (list) #.None (list)) #0) - ($i.ALOAD +0) - ($i.ALOAD +1) - ($i.PUTFIELD //.runnable-class procedure-field $Function) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.INVOKESPECIAL "java.lang.Object" "" ($t.method (list) #.None (list)) #0) + (_.ALOAD +0) + (_.ALOAD +1) + (_.PUTFIELD //.runnable-class procedure-field $Function) + _.RETURN)) ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.GETFIELD //.runnable-class procedure-field $Function) - $i.NULL - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.GETFIELD //.runnable-class procedure-field $Function) + _.NULL + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + _.RETURN)) ))] - (do compiler.Monad + (do phase.Monad [_ (translation.execute! [//.runnable-class bytecode])] (wrap bytecode)))) (def: #export translate (Operation [ByteCode ByteCode ByteCode]) - (do compiler.Monad + (do phase.Monad [runtime-bc translate-runtime function-bc translate-function runnable-bc translate-runnable] 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 3ed9a8ebc..5abf85c05 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -40,12 +40,12 @@ (-> Text Type $.Inst Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module def-name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module def-name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (&module.define def-ident [realT metaV realV])] + _ (&module.define def-name [realT metaV realV])] (wrap [])) _ @@ -70,17 +70,17 @@ [field (Class::getField [commonT.value-field] class)] (Field::get [#.None] field)) (#e.Success #.None) - (&.throw Invalid-Definition-Value (%ident def-ident)) + (&.throw Invalid-Definition-Value (%name def-name)) (#e.Success (#.Some valueV)) (wrap valueV) (#e.Error error) (&.throw Cannot-Evaluate-Definition - (format "Definition: " (%ident def-ident) "\n" + (format "Definition: " (%name def-name) "\n" "Error:\n" error)))) - _ (&module.define def-ident [valueT metaV valueV]) + _ (&module.define def-name [valueT metaV valueV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -89,7 +89,7 @@ tags (&module.declare-tags tags (macro.export? metaV) (:coerce Type valueV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (commonT.record-artifact (format bytecode-name ".class") bytecode))))) (def: #export (translate-program programI) 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 bc4a3cb95..4c29260f5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -1,23 +1,24 @@ (.module: [lux #* [control - [monad (#+ do)] + ["." monad (#+ do)] ["ex" exception (#+ exception:)]] [data [text format] [collection ["." list]]] - [language - ["." compiler - [synthesis (#+ Synthesis)]]]] + [compiler + [default + ["." phase + [synthesis (#+ Synthesis)]]]]] [luxc [lang [host - ["." jvm (#+ Inst Operation Compiler) + ["." jvm (#+ Inst Operation Phase) ["$t" type] - ["$i" inst]]]]] - [//]) + ["_" inst]]]]] + ["." //]) (exception: #export (not-a-tuple {size Nat}) (ex.report ["Expected size" ">= 2"] @@ -26,41 +27,41 @@ (def: $Object jvm.Type ($t.class "java.lang.Object" (list))) (def: #export (tuple translate members) - (-> Compiler (List Synthesis) (Operation Inst)) - (do compiler.Monad + (-> Phase (List Synthesis) (Operation Inst)) + (do phase.Monad [#let [size (list.size members)] - _ (compiler.assert not-a-tuple size - (n/>= +2 size)) + _ (phase.assert not-a-tuple size + (n/>= +2 size)) membersI (|> members list.enumerate (monad.map @ (function (_ [idx member]) (do @ [memberI (translate member)] - (wrap (|>> $i.DUP - ($i.int (.int idx)) + (wrap (|>> _.DUP + (_.int (.int idx)) memberI - $i.AASTORE))))) - (:: @ map $i.fuse))] - (wrap (|>> ($i.int (.int size)) - ($i.array $Object) + _.AASTORE))))) + (:: @ map _.fuse))] + (wrap (|>> (_.int (.int size)) + (_.array $Object) membersI)))) (def: (flagI tail?) (-> Bit Inst) (if tail? - ($i.string "") - $i.NULL)) + (_.string "") + _.NULL)) (def: #export (variant translate tag tail? member) - (-> Compiler Nat Bit Synthesis (Operation Inst)) - (do compiler.Monad + (-> Phase Nat Bit Synthesis (Operation Inst)) + (do phase.Monad [memberI (translate member)] - (wrap (|>> ($i.int (.int tag)) + (wrap (|>> (_.int (.int tag)) (flagI tail?) memberI - ($i.INVOKESTATIC //.runtime-class - "variant_make" - ($t.method (list $t.int $Object $Object) - (#.Some ($t.array +1 $Object)) - (list)) - #0))))) + (_.INVOKESTATIC //.runtime-class + "variant_make" + ($t.method (list $t.int $Object $Object) + (#.Some ($t.array +1 $Object)) + (list)) + #0))))) diff --git a/new-luxc/source/luxc/lang/translation/lua.lux b/new-luxc/source/luxc/lang/translation/lua.lux index e1cb1a2ac..e5272a3ea 100644 --- a/new-luxc/source/luxc/lang/translation/lua.lux +++ b/new-luxc/source/luxc/lang/translation/lua.lux @@ -204,7 +204,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux deleted file mode 100644 index eaffddfa0..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/procedure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host [lua #+ Lua Expression Statement]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux index b491c9dd4..fac6308a0 100644 --- a/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux @@ -28,9 +28,9 @@ (translate-local (.nat var)))) (def: #export global - (-> Ident Expression) + (-> Name Expression) //.definition-name) (def: #export (translate-definition name) - (-> Ident (Meta Expression)) + (-> Name (Meta Expression)) (:: macro.Monad wrap (global name))) diff --git a/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux index 4fb814f6c..9c0181c1b 100644 --- a/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (lua.global! def-name (#.Some expressionO))) expressionV (evalT.eval def-name) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/php.lux b/new-luxc/source/luxc/lang/translation/php.lux index 67234f998..db0eeced4 100644 --- a/new-luxc/source/luxc/lang/translation/php.lux +++ b/new-luxc/source/luxc/lang/translation/php.lux @@ -182,7 +182,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux deleted file mode 100644 index ab73cddee..000000000 --- a/new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux +++ /dev/null @@ -1,30 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - [text] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host ["_" php #+ Expression Statement]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux index 4364d87ea..833fc5e5a 100644 --- a/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/reference.jvm.lux @@ -24,7 +24,7 @@ (variable (:coerce Nat var)))) (def: #export global - (-> Ident Var) + (-> Name Var) (|>> //.definition-name _.var)) (do-template [ ] @@ -33,5 +33,5 @@ (|>> (:: macro.Monad wrap)))] [translate-variable Variable local] - [translate-definition Ident global] + [translate-definition Name global] ) diff --git a/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux index d4b4a03a8..7c2482af6 100644 --- a/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (_.set! def-name expressionO)) expressionV (evalT.eval def-name) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/python.lux b/new-luxc/source/luxc/lang/translation/python.lux index 2e1b74340..f466a6f29 100644 --- a/new-luxc/source/luxc/lang/translation/python.lux +++ b/new-luxc/source/luxc/lang/translation/python.lux @@ -179,7 +179,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (do-template [ ] diff --git a/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux deleted file mode 100644 index f793a0165..000000000 --- a/new-luxc/source/luxc/lang/translation/python/procedure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host [python #+ Expression Statement]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux index 7cb3390f5..e8bcae522 100644 --- a/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux @@ -34,9 +34,9 @@ (translate-local (.nat var)))) (def: #export global - (-> Ident SVar) + (-> Name SVar) (|>> //.definition-name python.var)) (def: #export (translate-definition name) - (-> Ident (Meta Expression)) + (-> Name (Meta Expression)) (:: macro.Monad wrap (@@ (global name)))) diff --git a/new-luxc/source/luxc/lang/translation/python/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/python/statement.jvm.lux index 0d8321470..bf34f3f2f 100644 --- a/new-luxc/source/luxc/lang/translation/python/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (python.set! (list def-name) expressionO)) expressionV (evalT.eval (@@ def-name)) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/r.lux b/new-luxc/source/luxc/lang/translation/r.lux index 9b8746008..7dc84700f 100644 --- a/new-luxc/source/luxc/lang/translation/r.lux +++ b/new-luxc/source/luxc/lang/translation/r.lux @@ -190,7 +190,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux deleted file mode 100644 index 468d09523..000000000 --- a/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host [r #+ Expression]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux index a7a788094..087b87504 100644 --- a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux @@ -34,9 +34,9 @@ (translate-local (.nat var)))) (def: #export global - (-> Ident SVar) + (-> Name SVar) (|>> //.definition-name r.var)) (def: #export (translate-definition name) - (-> Ident (Meta Expression)) + (-> Name (Meta Expression)) (:: macro.Monad wrap (@@ (global name)))) diff --git a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux index a5515efdc..7530e3669 100644 --- a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (r.set! def-name expressionO)) expressionV (evalT.eval (@@ def-name)) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/ruby.lux b/new-luxc/source/luxc/lang/translation/ruby.lux index a42dae024..501e8e2c1 100644 --- a/new-luxc/source/luxc/lang/translation/ruby.lux +++ b/new-luxc/source/luxc/lang/translation/ruby.lux @@ -168,7 +168,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux deleted file mode 100644 index 036a68d0c..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang ["ls" synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta Expression)) Text (List ls.Synthesis) - (Meta Expression)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad - [proc (dict.get name procedures)] - (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux index b778d090a..fb206b127 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux @@ -28,9 +28,9 @@ (translate-local (.nat var)))) (def: #export global - (-> Ident Expression) + (-> Name Expression) //.definition-name) (def: #export (translate-definition name) - (-> Ident (Meta Expression)) + (-> Name (Meta Expression)) (:: macro.Monad wrap (ruby.global (global name)))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux index a1b2a9e6f..a9fbc7152 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (ruby.global! def-name expressionO)) expressionV (evalT.eval (ruby.global def-name)) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/source/luxc/lang/translation/scheme.lux b/new-luxc/source/luxc/lang/translation/scheme.lux index 44a5808cb..7d261ca04 100644 --- a/new-luxc/source/luxc/lang/translation/scheme.lux +++ b/new-luxc/source/luxc/lang/translation/scheme.lux @@ -185,7 +185,7 @@ (def: #export unit Text "") (def: #export (definition-name [module name]) - (-> Ident Text) + (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) diff --git a/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux index 8c5bdc797..755e8a898 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux @@ -14,20 +14,20 @@ (-> Text Type Expression Code (Meta Any)) (do macro.Monad [current-module macro.current-module-name - #let [def-ident [current-module name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-ident [realT metaV realV])] + _ (moduleL.define def-name [realT metaV realV])] (wrap [])) _ (do @ - [#let [def-name (referenceT.global def-ident)] + [#let [def-name (referenceT.global def-name)] _ (//.save (_.define def-name (list) expressionO)) expressionV (evalT.eval (@@ def-name)) - _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (moduleL.define def-name [expressionT metaV expressionV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -36,7 +36,7 @@ tags (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (wrap [])) ))) diff --git a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux index fcdcfbe6a..dabef0e08 100644 --- a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux @@ -1,34 +1,34 @@ (.module: [lux #* - [io] [control [monad (#+ do)] pipe] [concurrency - [atom]] + ["." atom]] [data ["e" error] - [product] - [maybe] + ["." product] + ["." maybe] [text ("text/" Equivalence) format] [collection - [array] + ["." array] [list ("list/" Fold)] ["dict" dictionary]]] [math ["r" random "r/" Monad]] + ["." type] [macro (#+ Monad) - [code]] - ["." language - [type] - [compiler + ["." code]] + [compiler + ["." default [".L" init] - [analysis - [".A" type]] - [extension + [phase [analysis - [".AE" host]]]]] + [".A" type]] + [extension + [analysis + [".AE" host]]]]]] test] [/// ["_." primitive]]) @@ -39,10 +39,10 @@ (|> (do Monad [## runtime-bytecode @runtime.translate ] - (language.with-scope + (default.with-scope (typeA.with-type output-type (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))) - (language.with-current-module "") + (analysis.with-current-module "") (macro.run (initL.compiler [])) (case> (#e.Success _) @@ -60,10 +60,10 @@ (|> (do Monad [## runtime-bytecode @runtime.translate ] - (language.with-scope + (default.with-scope (typeA.with-type output-type (_primitive.analyse syntax)))) - (language.with-current-module "") + (analysis.with-current-module "") (macro.run (initL.compiler [])) (case> (#e.Success _) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index 1c4236913..f4ff98287 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -4,15 +4,16 @@ [monad (#+ do)] pipe] [data - [error] + ["." error] [bit ("bit/" Equivalence)] [text ("text/" Equivalence) format]] [math ["r" random]] - [language - [compiler - [synthesis]]] + [compiler + [default + [phase + ["." synthesis]]]] test] [test [luxc diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux index 66dd8de9f..4aaed8124 100644 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -19,7 +19,7 @@ ))) (test/luxc common)) -(def: ident-part +(def: name-part (r.Random Text) (|> (r.ascii +5) (r.filter (function (_ sample) @@ -30,7 +30,7 @@ (def: (definitions-spec define) (-> Definer Test) (do r.Monad - [def-name (r.seq ident-part ident-part) + [def-name (r.seq name-part name-part) def-value r.int] (test "Can refer to definitions." (|> (define def-name (//synthesis.i64 def-value)) -- cgit v1.2.3