diff options
author | Eduardo Julian | 2019-04-07 17:49:35 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-04-07 17:49:35 -0400 |
commit | a4e0eb58480a05e4c23a07d33965022125c539f2 (patch) | |
tree | 751b2dd5f6154b5940df39a3cb16c49868cd6551 | |
parent | a61c3f2e7bc29c3224264317b14254fe93d503fe (diff) |
Updated the JVM compiler to the latest changes.
Diffstat (limited to '')
17 files changed, 208 insertions, 241 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index 71e887d4d..da9dcb974 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -1,7 +1,8 @@ (.module: [lux (#- Type Definition) + [abstract + monad] [control - monad ["p" parser]] [data [collection @@ -16,7 +17,7 @@ [compiler [reference (#+ Register)] [phase - ["." translation]]]]]) + ["." generation]]]]]) ## [Host] (import: org/objectweb/asm/MethodVisitor) @@ -94,17 +95,17 @@ (type: #export Anchor [Label Register]) (type: #export Host - (translation.Host Inst Definition)) + (generation.Host Inst Definition)) (template [<name> <base>] [(type: #export <name> (<base> ..Anchor Inst Definition))] - [State translation.State] - [Operation translation.Operation] - [Phase translation.Phase] - [Handler translation.Handler] - [Bundle translation.Bundle] + [State generation.State] + [Operation generation.Operation] + [Phase generation.Phase] + [Handler generation.Handler] + [Bundle generation.Bundle] ) ## [Values] diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index f9b6e5c2d..012d7ceee 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -1,5 +1,7 @@ (.module: [lux #* + [control + ["." function]] [data ["." text format] @@ -7,8 +9,7 @@ [collection ["." array (#+ Array)] ["." list ("#/." functor)]]] - ["." host (#+ import: do-to)] - ["." function]] + ["." host (#+ import: do-to)]] ["$" // ["$t" type]]) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 36a020686..f1ae8abd2 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -1,7 +1,9 @@ (.module: [lux (#- int char) + [abstract + [monad (#+ do)]] [control - [monad (#+ do)] + ["." function] ["p" parser]] [data ["." maybe] @@ -14,7 +16,6 @@ [macro ["." code] ["s" syntax (#+ syntax:)]] - ["." function] [tool [compiler [phase (#+ Operation)]]]] diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index d1d1a9f4c..4d2031d12 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -1,12 +1,15 @@ (.module: [lux (#- Definition) + [abstract + [monad (#+ do)]] [control pipe - [monad (#+ do)] ["ex" exception (#+ exception:)] + ["." io (#+ IO io)] [concurrency ["." atom (#+ Atom atom)]]] [data + ["." product] ["." error (#+ Error)] ["." text ("#/." hash) format] @@ -17,14 +20,11 @@ ["." host (#+ import: do-to object) [jvm ["." loader (#+ Library)]]] - ["." io (#+ IO io)] [world [binary (#+ Binary)]] [tool [compiler - ["." name] - [phase - ["." translation]]]]] + ["." name]]]] [/// [host ["." jvm (#+ Inst Definition Host State) @@ -85,7 +85,7 @@ (def: class-path-separator ".") (def: (evaluate! library loader eval-class valueI) - (-> Library ClassLoader Text Inst (Error Any)) + (-> Library ClassLoader Text Inst (Error [Any Definition])) (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class) bytecode (def.class #jvm.V1_6 #jvm.Public jvm.noneC @@ -102,23 +102,31 @@ inst.RETURN))))] (io.run (do (error.with io.monad) [_ (loader.store eval-class bytecode library) - class (loader.load eval-class loader)] - (:: io.monad wrap (class-value eval-class class)))))) + class (loader.load eval-class loader) + value (:: io.monad wrap (class-value eval-class class))] + (wrap [value + [eval-class bytecode]]))))) (def: (execute! library loader temp-label [class-name class-bytecode]) (-> Library ClassLoader Text Definition (Error Any)) (io.run (do (error.with io.monad) - [_ (loader.store class-name class-bytecode library)] + [existing-class? (|> (atom.read library) + (:: io.monad map (dictionary.contains? class-name)) + (error.lift io.monad) + (: (IO (Error Bit)))) + _ (if ?existing-class + (wrap []) + (loader.store class-name class-bytecode library))] (loader.load class-name loader)))) (def: (define! library loader [module name] valueI) - (-> Library ClassLoader Name Inst (Error [Text Any])) + (-> Library ClassLoader Name Inst (Error [Text Any Definition])) (let [class-name (format (text.replace-all .module-separator class-path-separator module) class-path-separator (name.normalize name) "___" (%n (text/hash name)))] (do error.monad - [value (evaluate! library loader class-name valueI)] - (wrap [class-name value])))) + [[value definition] (evaluate! library loader class-name valueI)] + (wrap [class-name value definition])))) (def: #export host (IO Host) @@ -128,9 +136,14 @@ (structure (def: (evaluate! temp-label valueI) (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] - (..evaluate! library loader eval-class valueI))) - (def: execute! (..execute! library loader)) - (def: define! (..define! library loader))))))) + (:: error.monad map product.left + (..evaluate! library loader eval-class valueI)))) + + (def: execute! + (..execute! library loader)) + + (def: define! + (..define! library loader))))))) (def: #export runtime-class "LuxRuntime") (def: #export function-class "LuxFunction") 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 457c052a2..32b002b91 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -1,8 +1,9 @@ (.module: [lux (#- if let case) - ["." function] + [abstract + [monad (#+ do)]] [control - [monad (#+ do)] + ["." function] ["ex" exception (#+ exception:)]] [data [text 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 896fc9de3..ea6665dc5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -1,9 +1,10 @@ (.module: [lux #* + [abstract + [monad (#+ do)]] [control - [monad (#+ do)] - ["ex" exception (#+ exception:)]] - ["." io] + ["ex" exception (#+ exception:)] + ["." io]] [data ["." error (#+ Error)] ["." text ("#/." hash) 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 8c35952fd..db8716697 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -1,9 +1,10 @@ (.module: [lux (#- function) - ["." function] + [abstract + ["." monad (#+ do)]] [control [pipe (#+ when> new>)] - ["." monad (#+ do)]] + ["." function]] [data ["." text format] @@ -15,7 +16,7 @@ [synthesis (#+ Synthesis Abstraction Apply)] ["_." reference (#+ Register Variable)] ["." phase - ["." translation]]]]] + ["." generation]]]]] [luxc [lang [host @@ -295,16 +296,16 @@ (-> Phase Abstraction (Operation Inst)) (do phase.monad [@begin _.make-label - [function-class bodyI] (translation.with-context - (translation.with-anchor [@begin 1] + [function-class bodyI] (generation.with-context + (generation.with-anchor [@begin 1] (translate bodyS))) [functionD instanceI] (with-function @begin function-class env arity bodyI) - _ (translation.save! ["" function-class] - [function-class - (def.class #$.V1_6 #$.Public $.finalC - function-class (list) - ($.simple-class //.function-class) (list) - functionD)])] + _ (generation.save! ["" function-class] + [function-class + (def.class #$.V1_6 #$.Public $.finalC + function-class (list) + ($.simple-class //.function-class) (list) + functionD)])] (wrap instanceI))) (def: (segment size elems) 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 6e3f01c78..d7e706aaf 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -1,8 +1,9 @@ (.module: [lux #* - ["." function] - [control + [abstract ["." monad (#+ do)]] + [control + ["." function]] [data ["." text format] @@ -13,7 +14,7 @@ [reference (#+ Register)] ["." synthesis (#+ Synthesis)] ["." phase - ["." translation]]]]] + ["." generation]]]]] [luxc [lang [host @@ -33,7 +34,7 @@ (def: #export (recur translate argsS) (-> Phase (List Synthesis) (Operation Inst)) (do phase.monad - [[@begin start] translation.anchor + [[@begin start] generation.anchor #let [end (|> argsS list.size dec (n/+ start)) pairs (list.zip2 (list.n/range start end) argsS)] @@ -66,7 +67,7 @@ (do phase.monad [@begin _.make-label initsI+ (monad.map @ translate initsS+) - iterationI (translation.with-anchor [@begin start] + iterationI (generation.with-anchor [@begin start] (translate iterationS)) #let [initializationI (|> (list.enumerate initsI+) (list/map (function (_ [register initI]) 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 e514fe28a..f9d9034ea 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux @@ -1,6 +1,6 @@ (.module: [lux (#- i64) - [control + [abstract monad] [data [text 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 6f5fccf4e..b19287b4e 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 @@ -1,7 +1,8 @@ (.module: [lux #* + [abstract + ["." monad (#+ do)]] [control - ["." monad (#+ do)] ["p" parser] ["ex" exception (#+ exception:)]] [data 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 0a354a929..c821a9de2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -1,6 +1,6 @@ (.module: [lux #* - [control + [abstract [monad (#+ do)]] [data [text @@ -10,7 +10,7 @@ ["." name] ["." reference (#+ Register Variable)] ["." phase ("operation/." monad) - ["." translation]]]]] + ["." generation]]]]] [luxc [lang [host @@ -31,7 +31,7 @@ (def: (foreign variable) (-> Register (Operation Inst)) (do phase.monad - [function-class translation.context] + [function-class generation.context] (wrap (|>> (_.ALOAD 0) (_.GETFIELD function-class (|> variable .nat foreign-name) @@ -53,5 +53,5 @@ (def: #export (constant name) (-> Name (Operation Inst)) (do phase.monad - [bytecode-name (translation.remember name)] + [bytecode-name (generation.remember name)] (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 ae984baa9..78e613076 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -1,6 +1,6 @@ (.module: [lux #* - [control + [abstract [monad (#+ do)]] [data [text @@ -13,7 +13,7 @@ [analysis (#+ Arity)] ["." synthesis] ["." phase - ["." translation]]]]] + ["." generation]]]]] [luxc [lang [host @@ -311,7 +311,7 @@ pm-methods io-methods))] (do phase.monad - [_ (translation.execute! //.runtime-class [//.runtime-class bytecode])] + [_ (generation.execute! //.runtime-class [//.runtime-class bytecode])] (wrap bytecode)))) (def: translate-function @@ -341,7 +341,7 @@ _.RETURN)) applyI))] (do phase.monad - [_ (translation.execute! //.function-class [//.function-class bytecode])] + [_ (generation.execute! //.function-class [//.function-class bytecode])] (wrap bytecode)))) (def: #export translate diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux deleted file mode 100644 index 65ab9d147..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ /dev/null @@ -1,110 +0,0 @@ -(.module: - lux - (lux (control monad - ["ex" exception #+ exception:]) - (data ["e" error] - [maybe] - [text "text/" Monoid<Text> Hash<Text>] - text/format - (coll [list "list/" Functor<List> Fold<List>])) - [macro]) - (luxc ["&" lang] - ["&." io] - (lang (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst])) - ["&." scope] - ["&." module] - [".L" host])) - (// [".T" common] - [".T" runtime])) - -## (def: (lux//program procedure) -## (-> Text //.Statement) -## (function (_ inputsC+) -## (case inputsC+ -## (^ (list [_ (#.Identifier ["" args])] programC)) -## (do macro.Monad<Meta> -## [[_ programA] (<| lang.with-scope -## (scopeL.with-local [args (type (List Text))]) -## (lang.with-type (type (IO Any))) -## (expressionA.analyser evalL.eval programC)) -## syntheses //.all-syntheses -## programI (expressionT.translate (expressionS.synthesize syntheses programA)) -## _ (statementT.translate-program programI)] -## (wrap [])) - -## _ -## (throw-invalid-statement procedure inputsC+)))) - -(def: #export (translate-program programI) - (-> $.Inst (Meta Any)) - (let [nilI runtimeT.noneI - num-inputsI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH) - decI (|>> ($i.int 1) $i.ISUB) - headI (|>> $i.DUP - ($i.ALOAD +0) - $i.SWAP - $i.AALOAD - $i.SWAP - $i.DUP_X2 - $i.POP) - pairI (|>> ($i.int 2) - ($i.ANEWARRAY "java.lang.Object") - $i.DUP_X1 - $i.SWAP - ($i.int 0) - $i.SWAP - $i.AASTORE - $i.DUP_X1 - $i.SWAP - ($i.int 1) - $i.SWAP - $i.AASTORE) - consI (|>> ($i.int 1) - ($i.string "") - $i.DUP2_X1 - $i.POP2 - runtimeT.variantI) - prepare-input-listI (<| $i.with-label (function (_ @loop)) - $i.with-label (function (_ @end)) - (|>> nilI - num-inputsI - ($i.label @loop) - decI - $i.DUP - ($i.IFLT @end) - headI - pairI - consI - $i.SWAP - ($i.GOTO @loop) - ($i.label @end) - $i.POP - ($i.ASTORE +0))) - run-ioI (|>> ($i.CHECKCAST hostL.function-class) - $i.NULL - ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature +1) #0)) - main-type ($t.method (list ($t.array +1 ($t.class "java.lang.String" (list)))) - #.None - (list))] - (do macro.Monad<Meta> - [current-module macro.current-module-name - #let [normal-name "_" - bytecode-name (format current-module "/" normal-name) - class-name (text.replace-all "/" "." bytecode-name) - bytecode ($d.class #$.V1_6 - #$.Public $.finalC - bytecode-name - (list) ["java.lang.Object" (list)] - (list) - (|>> ($d.method #$.Public $.staticM "main" main-type - (|>> prepare-input-listI - programI - run-ioI - $i.POP - $i.RETURN))))] - #let [_ (log! (format "PROGRAM " current-module))] - _ (commonT.store-class class-name bytecode)] - (commonT.record-artifact (format bytecode-name ".class") bytecode)))) 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 7bf54b7ea..527228c8e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -1,7 +1,8 @@ (.module: [lux #* + [abstract + ["." monad (#+ do)]] [control - ["." monad (#+ do)] ["ex" exception (#+ exception:)]] [data [text diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index c669b9c24..23384cf17 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -1,59 +1,148 @@ (.module: [lux #* - [cli (#+ program:)] - [control + ["." host (#+ import:)] + [abstract [monad (#+ do)]] - ["." io (#+ IO)] + [control + [cli (#+ program:)] + ["." io (#+ IO)]] + [data + ["." error (#+ Error)] + [collection + [array (#+ Array)]]] [world ["." file]] - [host - ["." js]] [tool [compiler - ["." cli] - ["/" program] [phase - ["." macro] - ["." translation - [".T" js - [".JS" runtime] - [".JS" expression] - [".JS" extension]]] - ["." statement]] + ["." macro (#+ Expander)]] [default ["." platform (#+ Platform)]]]]] + [program + ["/" compositor + ["/." cli]]] [luxc [lang [host - ["." jvm]] + ["_" jvm + ["$t" type] + ["$d" def] + ["$i" inst]]] [translation - [".T" jvm - [".JVM" runtime] - [".JVM" expression] + ["." jvm + ["." runtime] + ["." expression] [procedure - [".JVM" common]]]]]] - ) + ["." common]]]]]]) + +(import: #long java/lang/reflect/Method + (invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object)) + +(import: #long (java/lang/Class c) + (getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method)) + +(import: #long java/lang/Object + (getClass [] (java/lang/Class java/lang/Object))) + +(def: _object-class + (java/lang/Class java/lang/Object) + (host.class-for java/lang/Object)) + +(def: _apply-args + (Array (java/lang/Class java/lang/Object)) + (|> (host.array (java/lang/Class java/lang/Object) 2) + (host.array-write 0 _object-class) + (host.array-write 1 _object-class))) + +(def: (expander macro inputs lux) + Expander + (do error.monad + [apply-method (|> macro + (:coerce java/lang/Object) + (java/lang/Object::getClass) + (java/lang/Class::getMethod "apply" _apply-args))] + (:coerce (Error (Error [Lux (List Code)])) + (java/lang/reflect/Method::invoke + (:coerce java/lang/Object macro) + (|> (host.array java/lang/Object 2) + (host.array-write 0 (:coerce java/lang/Object inputs)) + (host.array-write 1 (:coerce java/lang/Object lux))) + apply-method)))) (def: jvm - (IO (Platform IO jvm.Anchor jvm.Inst jvm.Definition)) + (IO (Platform IO _.Anchor _.Inst _.Definition)) (do io.monad - [host jvmT.host] + [host jvm.host] (wrap {#platform.&monad io.monad #platform.&file-system file.system #platform.host host - #platform.phase expressionJVM.translate - #platform.runtime runtimeJVM.translate}))) + #platform.phase expression.translate + #platform.runtime runtime.translate}))) -(def: js - (IO (Platform IO js.Var js.Expression js.Statement)) - (do io.monad - [host jsT.host] - (wrap {#platform.&monad io.monad - #platform.&file-system file.system - #platform.host host - #platform.phase expressionJS.translate - #platform.runtime runtimeJS.translate}))) +(def: (program programI) + (-> _.Inst _.Definition) + (let [nilI runtime.noneI + num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH) + decI (|>> ($i.int +1) $i.ISUB) + headI (|>> $i.DUP + ($i.ALOAD 0) + $i.SWAP + $i.AALOAD + $i.SWAP + $i.DUP_X2 + $i.POP) + pairI (|>> ($i.int +2) + ($i.ANEWARRAY "java.lang.Object") + $i.DUP_X1 + $i.SWAP + ($i.int +0) + $i.SWAP + $i.AASTORE + $i.DUP_X1 + $i.SWAP + ($i.int +1) + $i.SWAP + $i.AASTORE) + consI (|>> ($i.int +1) + ($i.string "") + $i.DUP2_X1 + $i.POP2 + runtime.variantI) + prepare-input-listI (<| $i.with-label (function (_ @loop)) + $i.with-label (function (_ @end)) + (|>> nilI + num-inputsI + ($i.label @loop) + decI + $i.DUP + ($i.IFLT @end) + headI + pairI + consI + $i.SWAP + ($i.GOTO @loop) + ($i.label @end) + $i.POP + ($i.ASTORE 0))) + run-ioI (|>> ($i.CHECKCAST jvm.function-class) + $i.NULL + ($i.INVOKEVIRTUAL jvm.function-class runtime.apply-method (runtime.apply-signature 1) #0)) + main-type ($t.method (list ($t.array 1 ($t.class "java.lang.String" (list)))) + #.None + (list)) + bytecode-name "_"] + [bytecode-name + ($d.class #_.V1_6 + #_.Public _.finalC + bytecode-name + (list) ["java.lang.Object" (list)] + (list) + (|>> ($d.method #_.Public _.staticM "main" main-type + (|>> prepare-input-listI + programI + run-ioI + $i.POP + $i.RETURN))))])) -(program: [{service cli.service}] - ## (/.compiler macro.jvm ..jvm commonJVM.bundle service) - (/.compiler jsT.expander ..js extensionJS.bundle service)) +(program: [{service /cli.service}] + (/.compiler ..expander ..jvm common.bundle ..program service)) diff --git a/stdlib/source/lux/host/jvm/loader.jvm.lux b/stdlib/source/lux/host/jvm/loader.jvm.lux index 9227b6c69..0ca92fa23 100644 --- a/stdlib/source/lux/host/jvm/loader.jvm.lux +++ b/stdlib/source/lux/host/jvm/loader.jvm.lux @@ -28,6 +28,7 @@ (exception: #export (unknown {class Text} {known-classes (List Text)}) (ex.report ["Class" class] ["Known classes" (|> known-classes + (list.sort (:: text.order <)) (list;map (|>> (format text.new-line text.tab))) (text.join-with ""))])) diff --git a/stdlib/source/lux/tool/compiler/phase/macro.lux b/stdlib/source/lux/tool/compiler/phase/macro.lux index dbc201ca3..ddbde68ad 100644 --- a/stdlib/source/lux/tool/compiler/phase/macro.lux +++ b/stdlib/source/lux/tool/compiler/phase/macro.lux @@ -11,8 +11,7 @@ [collection [array (#+ Array)] ["." list ("#;." functor)]]] - ["." macro] - ["." host (#+ import:)]] + ["." macro]] ["." //]) (exception: #export (expansion-failed {macro Name} {inputs (List Code)} {error Text}) @@ -30,43 +29,9 @@ (list;map (|>> %code (format text.new-line text.tab))) (text.join-with ""))])) -(import: #long java/lang/reflect/Method - (invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object)) - -(import: #long (java/lang/Class c) - (getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method)) - -(import: #long java/lang/Object - (getClass [] (java/lang/Class java/lang/Object))) - -(def: _object-class - (java/lang/Class java/lang/Object) - (host.class-for java/lang/Object)) - -(def: _apply-args - (Array (java/lang/Class java/lang/Object)) - (|> (host.array (java/lang/Class java/lang/Object) 2) - (host.array-write 0 _object-class) - (host.array-write 1 _object-class))) - (type: #export Expander (-> Macro (List Code) Lux (Error (Error [Lux (List Code)])))) -(def: #export (jvm macro inputs lux) - Expander - (do error.monad - [apply-method (|> macro - (:coerce java/lang/Object) - (java/lang/Object::getClass) - (java/lang/Class::getMethod "apply" _apply-args))] - (:coerce (Error (Error [Lux (List Code)])) - (java/lang/reflect/Method::invoke - (:coerce java/lang/Object macro) - (|> (host.array java/lang/Object 2) - (host.array-write 0 (:coerce java/lang/Object inputs)) - (host.array-write 1 (:coerce java/lang/Object lux))) - apply-method)))) - (def: #export (expand expander name macro inputs) (-> Expander Name Macro (List Code) (Meta (List Code))) (function (_ state) |