diff options
Diffstat (limited to '')
11 files changed, 66 insertions, 157 deletions
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 |