aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux43
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux7
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux23
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux11
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux3
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux110
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux3
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