aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator
diff options
context:
space:
mode:
authorEduardo Julian2017-10-29 22:21:14 -0400
committerEduardo Julian2017-10-29 22:21:14 -0400
commit7b870a7bd124f35939d9089a2e21f0806a4c6e85 (patch)
tree076fb3544dbb1a811cfbb9dd54008b0753dead16 /new-luxc/source/luxc/generator
parent2dc99a7b62fc5fc19d9982ad4398606f3aebb7a5 (diff)
- Fixed some bugs.
- Improved error reporting. - Implemented macro-expansion (for JVM). - Implemented "let" compilation.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/generator.lux46
-rw-r--r--new-luxc/source/luxc/generator/case.jvm.lux63
-rw-r--r--new-luxc/source/luxc/generator/expr.jvm.lux34
-rw-r--r--new-luxc/source/luxc/generator/function.jvm.lux19
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux132
-rw-r--r--new-luxc/source/luxc/generator/primitive.jvm.lux9
-rw-r--r--new-luxc/source/luxc/generator/procedure/common.jvm.lux41
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux7
-rw-r--r--new-luxc/source/luxc/generator/runtime.jvm.lux104
-rw-r--r--new-luxc/source/luxc/generator/structure.jvm.lux9
10 files changed, 263 insertions, 201 deletions
diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux
index 4ac937402..ad5f578e3 100644
--- a/new-luxc/source/luxc/generator.lux
+++ b/new-luxc/source/luxc/generator.lux
@@ -11,10 +11,10 @@
[io]
(world [file #+ File]))
(luxc ["&" base]
+ [";L" host]
["&;" io]
["&;" module]
["&;" parser]
- ["&;" host]
["&;" analyser]
["&;" analyser/common]
["&;" synthesizer]
@@ -75,24 +75,12 @@
[result action]
(exhaust action)))
-(def: (ensure-new-module! file-hash module-name)
- (-> Nat Text (Meta Unit))
- (do meta;Monad<Meta>
- [module-exists? (meta;module-exists? module-name)
- _ (: (Meta Unit)
- (if module-exists?
- (&;fail (format "Cannot re-define a module: " module-name))
- (wrap [])))
- _ (&module;create file-hash module-name)]
- (wrap [])))
-
(def: prelude Text "lux")
(def: (with-active-compilation [module-name file-name source-code] action)
(All [a] (-> [Text Text Text] (Meta a) (Meta a)))
(do meta;Monad<Meta>
- [_ (ensure-new-module! (text/hash source-code) module-name)
- #let [init-cursor [file-name +0 +0]]
+ [#let [init-cursor [file-name +1 +0]]
output (&;with-source-code [init-cursor +0 source-code]
action)
_ (&module;flag-compiled! module-name)]
@@ -113,17 +101,21 @@
(-> (List File) Text File Compiler (T;Task Compiler))
(do T;Monad<Task>
[_ (&io;prepare-module target-dir module-name)
- [file-name file-content] (&io;read-module source-dirs module-name)]
+ [file-name file-content] (&io;read-module source-dirs module-name)
+ #let [module-hash (text/hash file-content)]]
(case (meta;run' compiler
(do meta;Monad<Meta>
- [[artifacts _] (&&common;with-artifacts
- (with-active-compilation [module-name
- file-name
- file-content]
- (exhaust
- (do @
- [code parse]
- (generate code)))))]
+ [[_ artifacts _] (&module;with-module module-hash module-name
+ (&&common;with-artifacts
+ (with-active-compilation [module-name
+ file-name
+ file-content]
+ (exhaust
+ (do @
+ [code parse
+ #let [[cursor _] code]]
+ (&;with-cursor cursor
+ (generate code)))))))]
(wrap artifacts)
## (&module;generate-descriptor module-name)
))
@@ -139,7 +131,7 @@
(#e;Error error)
(T;fail error))))
-(def: init-cursor Cursor ["" +0 +0])
+(def: init-cursor Cursor ["" +1 +0])
(def: #export init-type-context
Type-Context
@@ -170,15 +162,15 @@
(def: #export (generate-program program target sources)
(-> Text File (List File) (T;Task Unit))
(do T;Monad<Task>
- [compiler (|> (case (&&runtime;generate (init-compiler (io;run &host;init-host)))
+ [compiler (|> (case (&&runtime;generate (init-compiler (io;run hostL;init-host)))
(#e;Error error)
(T;fail error)
(#e;Success [compiler [runtime-bc function-bc]])
(do @
[_ (&io;prepare-target target)
- _ (&io;write-file target &&runtime;runtime-class runtime-bc)
- _ (&io;write-file target &&runtime;function-class function-bc)]
+ _ (&io;write-file target hostL;runtime-class runtime-bc)
+ _ (&io;write-file target hostL;function-class function-bc)]
(wrap compiler)))
(: (T;Task Compiler))
(:: @ map (generate-module sources prelude target)) (:: @ join)
diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux
index 53912f5d0..f20c83f6e 100644
--- a/new-luxc/source/luxc/generator/case.jvm.lux
+++ b/new-luxc/source/luxc/generator/case.jvm.lux
@@ -2,9 +2,9 @@
lux
(lux (control [monad #+ do])
[meta "meta/" Monad<Meta>])
- (luxc (lang ["ls" synthesis])
- (generator [expr]
- (host ["$" jvm]
+ (luxc [";L" host]
+ (lang ["ls" synthesis])
+ (generator (host ["$" jvm]
(jvm ["$t" type]
["$i" inst]))))
[../runtime])
@@ -24,7 +24,7 @@
(def: peekI
$;Inst
(|>. $i;DUP
- ($i;INVOKESTATIC ../runtime;runtime-class
+ ($i;INVOKESTATIC hostL;runtime-class
"pm_peek"
($t;method (list ../runtime;$Stack)
(#;Some $Object)
@@ -33,7 +33,7 @@
(def: popI
$;Inst
- (|>. ($i;INVOKESTATIC ../runtime;runtime-class
+ (|>. ($i;INVOKESTATIC hostL;runtime-class
"pm_pop"
($t;method (list ../runtime;$Stack)
(#;Some ../runtime;$Stack)
@@ -42,19 +42,20 @@
(def: pushI
$;Inst
- (|>. ($i;INVOKESTATIC ../runtime;runtime-class
+ (|>. ($i;INVOKESTATIC hostL;runtime-class
"pm_push"
($t;method (list ../runtime;$Stack $Object)
(#;Some ../runtime;$Stack)
(list))
false)))
-(def: (generate-pattern' stack-depth @else @end path)
- (-> Nat $;Label $;Label ls;Path (Meta $;Inst))
+(def: (generate-pattern' generate stack-depth @else @end path)
+ (-> (-> ls;Synthesis (Meta $;Inst))
+ Nat $;Label $;Label ls;Path (Meta $;Inst))
(case path
(#ls;ExecP bodyS)
(do meta;Monad<Meta>
- [bodyI (expr;generate bodyS)]
+ [bodyI (generate bodyS)]
(wrap (|>. (pop-altI stack-depth)
bodyI
($i;GOTO @end))))
@@ -104,7 +105,7 @@
(#ls;TupleP idx subP)
(do meta;Monad<Meta>
- [subI (generate-pattern' stack-depth @else @end subP)
+ [subI (generate-pattern' generate stack-depth @else @end subP)
#let [[idx tail?] (case idx
(#;Left idx)
[idx false]
@@ -124,7 +125,7 @@
(|>. peekI
($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
($i;int (nat-to-int idx))
- ($i;INVOKESTATIC ../runtime;runtime-class
+ ($i;INVOKESTATIC hostL;runtime-class
(if tail? "pm_right" "pm_left")
($t;method (list ../runtime;$Tuple $t;int)
(#;Some $Object)
@@ -135,7 +136,7 @@
(#ls;VariantP idx subP)
(do meta;Monad<Meta>
- [subI (generate-pattern' stack-depth @else @end subP)
+ [subI (generate-pattern' generate stack-depth @else @end subP)
#let [[idx last?] (case idx
(#;Left idx)
[idx false]
@@ -151,7 +152,7 @@
($i;CHECKCAST ($t;descriptor ../runtime;$Variant))
($i;int (nat-to-int idx))
flagI
- ($i;INVOKESTATIC ../runtime;runtime-class "pm_variant"
+ ($i;INVOKESTATIC hostL;runtime-class "pm_variant"
($t;method (list ../runtime;$Variant ../runtime;$Tag ../runtime;$Flag)
(#;Some ../runtime;$Datum)
(list))
@@ -168,16 +169,16 @@
(#ls;SeqP leftP rightP)
(do meta;Monad<Meta>
- [leftI (generate-pattern' stack-depth @else @end leftP)
- rightI (generate-pattern' stack-depth @else @end rightP)]
+ [leftI (generate-pattern' generate stack-depth @else @end leftP)
+ rightI (generate-pattern' generate stack-depth @else @end rightP)]
(wrap (|>. leftI
rightI)))
(#ls;AltP leftP rightP)
(do meta;Monad<Meta>
[@alt-else $i;make-label
- leftI (generate-pattern' (n.inc stack-depth) @alt-else @end leftP)
- rightI (generate-pattern' stack-depth @else @end rightP)]
+ leftI (generate-pattern' generate (n.inc stack-depth) @alt-else @end leftP)
+ rightI (generate-pattern' generate stack-depth @else @end rightP)]
(wrap (|>. $i;DUP
leftI
($i;label @alt-else)
@@ -185,30 +186,42 @@
rightI)))
))
-(def: (generate-pattern path @end)
- (-> ls;Path $;Label (Meta $;Inst))
+(def: (generate-pattern generate path @end)
+ (-> (-> ls;Synthesis (Meta $;Inst))
+ ls;Path $;Label (Meta $;Inst))
(do meta;Monad<Meta>
[@else $i;make-label
- pathI (generate-pattern' +1 @else @end path)]
+ pathI (generate-pattern' generate +1 @else @end path)]
(wrap (|>. pathI
($i;label @else)
$i;POP
- ($i;INVOKESTATIC ../runtime;runtime-class
+ ($i;INVOKESTATIC hostL;runtime-class
"pm_fail"
($t;method (list) #;None (list))
false)
$i;NULL
($i;GOTO @end)))))
-(def: #export (generate valueS path)
- (-> ls;Synthesis ls;Path (Meta $;Inst))
+(def: #export (generate-case generate valueS path)
+ (-> (-> ls;Synthesis (Meta $;Inst))
+ ls;Synthesis ls;Path (Meta $;Inst))
(do meta;Monad<Meta>
[@end $i;make-label
- valueI (expr;generate valueS)
- pathI (generate-pattern path @end)]
+ valueI (generate valueS)
+ pathI (generate-pattern generate path @end)]
(wrap (|>. valueI
$i;NULL
$i;SWAP
pushI
pathI
($i;label @end)))))
+
+(def: #export (generate-let generate register inputS exprS)
+ (-> (-> ls;Synthesis (Meta $;Inst))
+ Nat ls;Synthesis ls;Synthesis (Meta $;Inst))
+ (do meta;Monad<Meta>
+ [inputI (generate inputS)
+ exprI (generate exprS)]
+ (wrap (|>. inputI
+ ($i;ASTORE register)
+ exprI))))
diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux
index 116c29fb5..685bf2335 100644
--- a/new-luxc/source/luxc/generator/expr.jvm.lux
+++ b/new-luxc/source/luxc/generator/expr.jvm.lux
@@ -1,6 +1,7 @@
(;module:
lux
- (lux (control monad)
+ (lux (control monad
+ ["ex" exception #+ exception:])
(data text/format)
[meta #+ Monad<Meta> "Meta/" Monad<Meta>])
(luxc ["&" base]
@@ -15,8 +16,11 @@
["&;" procedure]
["&;" function]
["&;" reference]
+ [";G" case]
(host ["$" jvm]))))
+(exception: #export Unrecognized-Synthesis)
+
(def: #export (generate synthesis)
(-> ls;Synthesis (Meta $;Inst))
(case synthesis
@@ -47,6 +51,12 @@
(#ls;Definition definition)
(&reference;generate-definition definition)
+ (#ls;Let register inputS exprS)
+ (caseG;generate-let generate register inputS exprS)
+
+ (#ls;Case inputS pathPS)
+ (caseG;generate-case generate inputS pathPS)
+
(#ls;Function arity env body)
(&function;generate-function generate env arity body)
@@ -57,25 +67,5 @@
(&procedure;generate-procedure generate name args)
_
- (meta;fail "Unrecognized synthesis.")
+ (&;throw Unrecognized-Synthesis "")
))
-
-## (def: #export (eval type code)
-## (-> Type Code (Meta Top))
-## (do Monad<Meta>
-## [analysis (&;with-expected-type leftT
-## (&analyser;analyser eval code))
-## #let [synthesis (&synthesizer;synthesize analysis)]
-## inst (generate synthesis)]
-## (&eval;eval inst)))
-
-## (def: analyse
-## &;Analyser
-## (&analyser;analyser eval))
-
-## (def: #export (generate input)
-## (-> Code (Meta Unit))
-## (do Monad<Meta>
-## [analysis (analyse input)
-## #let [synthesis (&synthesizer;synthesize analysis)]]
-## (generate-synthesis synthesis)))
diff --git a/new-luxc/source/luxc/generator/function.jvm.lux b/new-luxc/source/luxc/generator/function.jvm.lux
index 97d3a7c91..ce92b9010 100644
--- a/new-luxc/source/luxc/generator/function.jvm.lux
+++ b/new-luxc/source/luxc/generator/function.jvm.lux
@@ -5,6 +5,7 @@
(coll [list "list/" Functor<List> Monoid<List>]))
[meta])
(luxc ["&" base]
+ [";L" host]
(lang ["la" analysis]
["ls" synthesis])
["&;" analyser]
@@ -58,7 +59,7 @@
(def: get-amount-of-partialsI
$;Inst
(|>. ($i;ALOAD +0)
- ($i;GETFIELD &runtime;function-class &runtime;partials-field $t;int)))
+ ($i;GETFIELD hostL;function-class &runtime;partials-field $t;int)))
(def: (load-fieldI class field)
(-> Text Text $;Inst)
@@ -77,9 +78,9 @@
later-applysI (if (n.> &runtime;num-apply-variants amount)
(applysI (n.+ &runtime;num-apply-variants start) (n.- &runtime;num-apply-variants amount))
id)]
- (|>. ($i;CHECKCAST &runtime;function-class)
+ (|>. ($i;CHECKCAST hostL;function-class)
(inputsI start max-args)
- ($i;INVOKEVIRTUAL &runtime;function-class &runtime;apply-method (&runtime;apply-signature max-args) false)
+ ($i;INVOKEVIRTUAL hostL;function-class &runtime;apply-method (&runtime;apply-signature max-args) false)
later-applysI)))
(def: (inc-intI by)
@@ -167,9 +168,9 @@
(-> ls;Arity Nat $;Inst)
(if (n.= +1 arity)
(|>. ($i;int 0)
- ($i;INVOKESPECIAL &runtime;function-class "<init>" function-init-method false))
+ ($i;INVOKESPECIAL hostL;function-class "<init>" function-init-method false))
(|>. ($i;ILOAD (n.inc env-size))
- ($i;INVOKESPECIAL &runtime;function-class "<init>" function-init-method false))))
+ ($i;INVOKESPECIAL hostL;function-class "<init>" function-init-method false))))
(def: (with-init class env arity)
(-> Text (List ls;Variable) ls;Arity $;Def)
@@ -262,7 +263,7 @@
($i;TABLESWITCH 0 (|> num-partials n.dec nat-to-int)
@default @labels)
casesI
- ($i;INVOKESTATIC &runtime;runtime-class "apply_fail" ($t;method (list) #;None (list)) false)
+ ($i;INVOKESTATIC hostL;runtime-class "apply_fail" ($t;method (list) #;None (list)) false)
$i;NULL
$i;ARETURN
))))
@@ -306,7 +307,7 @@
_ (&common;store-class function-class
($d;class #$;V1.6 #$;Public $;finalC
function-class (list)
- ($;simple-class &runtime;function-class) (list)
+ ($;simple-class hostL;function-class) (list)
functionD))]
(wrap instanceI)))
@@ -326,9 +327,9 @@
argsI (monad;map @ generate argsS)
#let [applyI (|> (segment &runtime;num-apply-variants argsI)
(list/map (function [chunkI+]
- (|>. ($i;CHECKCAST &runtime;function-class)
+ (|>. ($i;CHECKCAST hostL;function-class)
($i;fuse chunkI+)
- ($i;INVOKEVIRTUAL &runtime;function-class &runtime;apply-method (&runtime;apply-signature (list;size chunkI+)) false))))
+ ($i;INVOKEVIRTUAL hostL;function-class &runtime;apply-method (&runtime;apply-signature (list;size chunkI+)) false))))
$i;fuse)]]
(wrap (|>. functionI
applyI))))
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index f515e86ac..37ab75020 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -22,68 +22,72 @@
(L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
wrap))
-(with-expansions [<conversion> (declare D2F D2I D2L
- F2D F2I F2L
- I2B I2C I2D I2F I2L I2S
- L2D L2F L2I)
- <primitive> (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
- T_BYTE T_SHORT T_INT T_LONG)
- <class> (declare CHECKCAST NEW INSTANCEOF)
- <member> (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD
- INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE)
- <stack> (declare DUP DUP2 DUP2_X1 DUP2_X2
- POP POP2
- SWAP)
- <jump> (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT IF_ACMPEQ IFNULL
- IFEQ IFNE IFLT IFLE IFGT IFGE
- GOTO)
- <var> (declare ILOAD LLOAD DLOAD ALOAD
- ISTORE LSTORE ASTORE)
- <arithmetic> (declare IADD ISUB IMUL IDIV IREM
- LADD LSUB LMUL LDIV LREM LCMP
- FADD FSUB FMUL FDIV FREM FCMPG FCMPL
- DADD DSUB DMUL DDIV DREM DCMPG DCMPL)
- <bit-wise> (declare IAND IOR IXOR ISHL ISHR IUSHR
- LAND LOR LXOR LSHL LSHR LUSHR)
- <array> (declare ARRAYLENGTH NEWARRAY ANEWARRAY
- AALOAD AASTORE
- BALOAD BASTORE
- SALOAD SASTORE
- IALOAD IASTORE
- LALOAD LASTORE
- FALOAD FASTORE
- DALOAD DASTORE
- CALOAD CASTORE)
- <concurrency> (declare MONITORENTER MONITOREXIT)
- <return> (declare RETURN IRETURN LRETURN DRETURN ARETURN)]
- (host;import org.objectweb.asm.Opcodes
- (#static NOP int)
-
- <conversion>
- <primitive>
-
- <class>
-
- <stack>
- <jump>
-
- (#static ACONST_NULL int)
-
- <var>
-
- <arithmetic>
- <bit-wise>
-
- <array>
-
- <member>
-
- (#static ATHROW int)
-
- <concurrency>
-
- <return>
- ))
+(`` (host;import org.objectweb.asm.Opcodes
+ (#static NOP int)
+
+ ## Conversion
+ (~~ (declare D2F D2I D2L
+ F2D F2I F2L
+ I2B I2C I2D I2F I2L I2S
+ L2D L2F L2I))
+
+ ## Primitive
+ (~~ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
+ T_BYTE T_SHORT T_INT T_LONG))
+
+ ## Class
+ (~~ (declare CHECKCAST NEW INSTANCEOF))
+
+ ## Stack
+ (~~ (declare DUP DUP_X1 DUP_X2
+ DUP2 DUP2_X1 DUP2_X2
+ POP POP2
+ SWAP))
+
+ ## Jump
+ (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT IF_ACMPEQ IFNULL
+ IFEQ IFNE IFLT IFLE IFGT IFGE
+ GOTO))
+
+ (#static ACONST_NULL int)
+
+ ## Var
+ (~~ (declare ILOAD LLOAD DLOAD ALOAD
+ ISTORE LSTORE ASTORE))
+
+ ## Arithmetic
+ (~~ (declare IADD ISUB IMUL IDIV IREM
+ LADD LSUB LMUL LDIV LREM LCMP
+ FADD FSUB FMUL FDIV FREM FCMPG FCMPL
+ DADD DSUB DMUL DDIV DREM DCMPG DCMPL))
+
+ ## Bit-wise
+ (~~ (declare IAND IOR IXOR ISHL ISHR IUSHR
+ LAND LOR LXOR LSHL LSHR LUSHR))
+
+ ## Array
+ (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY
+ AALOAD AASTORE
+ BALOAD BASTORE
+ SALOAD SASTORE
+ IALOAD IASTORE
+ LALOAD LASTORE
+ FALOAD FASTORE
+ DALOAD DASTORE
+ CALOAD CASTORE))
+
+ ## Member
+ (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD
+ INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE))
+
+ (#static ATHROW int)
+
+ ## Concurrency
+ (~~ (declare MONITORENTER MONITOREXIT))
+
+ ## Return
+ (~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN))
+ ))
(host;import org.objectweb.asm.FieldVisitor
(visitEnd [] void))
@@ -152,7 +156,9 @@
[NOP]
## Stack
- [DUP] [DUP2] [DUP2_X1] [DUP2_X2] [POP] [POP2] [SWAP]
+ [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2]
+ [POP] [POP2]
+ [SWAP]
## Conversions
[D2F] [D2I] [D2L]
diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux
index fc6ffae1f..571ba4835 100644
--- a/new-luxc/source/luxc/generator/primitive.jvm.lux
+++ b/new-luxc/source/luxc/generator/primitive.jvm.lux
@@ -2,8 +2,9 @@
lux
(lux (control monad)
(data text/format)
- [meta #+ Monad<Meta> "Meta/" Monad<Meta>])
+ [meta "meta/" Monad<Meta>])
(luxc ["&" base]
+ [";L" host]
(lang ["la" analysis]
["ls" synthesis])
["&;" analyser]
@@ -16,18 +17,18 @@
(def: #export generate-unit
(Meta $;Inst)
- (Meta/wrap ($i;string ../runtime;unit)))
+ (meta/wrap ($i;string hostL;unit)))
(def: #export (generate-bool value)
(-> Bool (Meta $;Inst))
- (Meta/wrap ($i;GETSTATIC "java.lang.Boolean"
+ (meta/wrap ($i;GETSTATIC "java.lang.Boolean"
(if value "TRUE" "FALSE")
($t;class "java.lang.Boolean" (list)))))
(do-template [<name> <type> <load> <wrap>]
[(def: #export (<name> value)
(-> <type> (Meta $;Inst))
- (Meta/wrap (|>. (<load> value) <wrap>)))]
+ (meta/wrap (|>. (<load> value) <wrap>)))]
[generate-nat Nat (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
[generate-int Int $i;long ($i;wrap #$;Long)]
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index 48a820663..fd76082a6 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -10,6 +10,7 @@
["s" syntax #+ syntax:])
[host])
(luxc ["&" base]
+ [";L" host]
(lang ["la" analysis]
["ls" synthesis])
["&;" analyser]
@@ -56,7 +57,7 @@
(def: $Object-Array $;Type ($t;array +1 $Object))
(def: $String $;Type ($t;class "java.lang.String" (list)))
(def: $CharSequence $;Type ($t;class "java.lang.CharSequence" (list)))
-(def: $Function $;Type ($t;class &runtime;function-class (list)))
+(def: $Function $;Type ($t;class hostL;function-class (list)))
(def: #export (install name unnamed)
(-> Text (-> Text Proc)
@@ -142,8 +143,8 @@
(def: (lux//try riskyI)
Unary
(|>. riskyI
- ($i;CHECKCAST &runtime;function-class)
- ($i;INVOKESTATIC &runtime;runtime-class "try" try-method false)))
+ ($i;CHECKCAST hostL;function-class)
+ ($i;INVOKESTATIC hostL;runtime-class "try" try-method false)))
## [[Bits]]
(do-template [<name> <op>]
@@ -263,9 +264,9 @@
[nat//sub ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LSUB]
[nat//mul ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LMUL]
[nat//div ($i;unwrap #$;Long) ($i;wrap #$;Long)
- ($i;INVOKESTATIC &runtime;runtime-class "div_nat" nat-method false)]
+ ($i;INVOKESTATIC hostL;runtime-class "div_nat" nat-method false)]
[nat//rem ($i;unwrap #$;Long) ($i;wrap #$;Long)
- ($i;INVOKESTATIC &runtime;runtime-class "rem_nat" nat-method false)]
+ ($i;INVOKESTATIC hostL;runtime-class "rem_nat" nat-method false)]
[frac//add ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DADD]
[frac//sub ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DSUB]
@@ -276,9 +277,9 @@
[deg//add ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LADD]
[deg//sub ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LSUB]
[deg//mul ($i;unwrap #$;Long) ($i;wrap #$;Long)
- ($i;INVOKESTATIC &runtime;runtime-class "mul_deg" deg-method false)]
+ ($i;INVOKESTATIC hostL;runtime-class "mul_deg" deg-method false)]
[deg//div ($i;unwrap #$;Long) ($i;wrap #$;Long)
- ($i;INVOKESTATIC &runtime;runtime-class "div_deg" deg-method false)]
+ ($i;INVOKESTATIC hostL;runtime-class "div_deg" deg-method false)]
[deg//rem ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LSUB]
[deg//scale ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LMUL]
[deg//reciprocal ($i;unwrap #$;Long) ($i;wrap #$;Long) $i;LDIV]
@@ -296,10 +297,10 @@
[<eq> 0]
[<lt> -1])]
- [nat//eq nat//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC &runtime;runtime-class "compare_nat" compare-nat-method false)]
+ [nat//eq nat//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false)]
[int//eq int//lt ($i;unwrap #$;Long) $i;LCMP]
[frac//eq frac//lt ($i;unwrap #$;Double) $i;DCMPG]
- [deg//eq deg//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC &runtime;runtime-class "compare_nat" compare-nat-method false)]
+ [deg//eq deg//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false)]
)
(do-template [<name> <prepare> <transform>]
@@ -317,15 +318,15 @@
[frac//to-int ($i;unwrap #$;Double) (<| ($i;wrap #$;Long) $i;D2L)]
[frac//to-deg ($i;unwrap #$;Double)
- (<| ($i;wrap #$;Long) ($i;INVOKESTATIC &runtime;runtime-class "frac_to_deg"
+ (<| ($i;wrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "frac_to_deg"
($t;method (list $t;double) (#;Some $t;long) (list)) false))]
[frac//encode ($i;unwrap #$;Double)
($i;INVOKESTATIC "java.lang.Double" "toString" ($t;method (list $t;double) (#;Some $String) (list)) false)]
[frac//decode ($i;CHECKCAST "java.lang.String")
- ($i;INVOKESTATIC &runtime;runtime-class "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list)) false)]
+ ($i;INVOKESTATIC hostL;runtime-class "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list)) false)]
[deg//to-frac ($i;unwrap #$;Long)
- (<| ($i;wrap #$;Double) ($i;INVOKESTATIC &runtime;runtime-class "deg_to_frac"
+ (<| ($i;wrap #$;Double) ($i;INVOKESTATIC hostL;runtime-class "deg_to_frac"
($t;method (list $t;long) (#;Some $t;double) (list)) false))]
)
@@ -365,7 +366,7 @@
($i;INVOKEVIRTUAL "java.lang.String" "contains" ($t;method (list $CharSequence) (#;Some $t;boolean) (list)) false)
($i;wrap #$;Boolean)]
[text//char ($i;CHECKCAST "java.lang.String") jvm-intI
- ($i;INVOKESTATIC &runtime;runtime-class "text_char" ($t;method (list $String $t;int) (#;Some $t;int) (list)) false)
+ ($i;INVOKESTATIC hostL;runtime-class "text_char" ($t;method (list $String $t;int) (#;Some $t;int) (list)) false)
lux-intI]
)
@@ -378,7 +379,7 @@
<op>))]
[text//clip ($i;CHECKCAST "java.lang.String") jvm-intI jvm-intI
- ($i;INVOKESTATIC &runtime;runtime-class "text_clip"
+ ($i;INVOKESTATIC hostL;runtime-class "text_clip"
($t;method (list $String $t;int $t;int) (#;Some $Object-Array) (list)) false)]
[text//replace ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
($i;INVOKEVIRTUAL "java.lang.String" "replace" ($t;method (list $CharSequence $CharSequence) (#;Some $String) (list)) false)]
@@ -466,7 +467,7 @@
messageI
($i;CHECKCAST "java.lang.String")
($i;INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false)
- ($i;string &runtime;unit)))
+ ($i;string hostL;unit)))
(def: (io//error messageI)
Unary
@@ -515,20 +516,20 @@
## [[Processes]]
(def: (process//concurrency-level [])
Nullary
- (|>. ($i;GETSTATIC &runtime;runtime-class "concurrency_level" $t;int)
+ (|>. ($i;GETSTATIC hostL;runtime-class "concurrency_level" $t;int)
lux-intI))
(def: (process//future procedureI)
Unary
- (|>. procedureI ($i;CHECKCAST &runtime;function-class)
- ($i;INVOKESTATIC &runtime;runtime-class "future"
+ (|>. procedureI ($i;CHECKCAST hostL;function-class)
+ ($i;INVOKESTATIC hostL;runtime-class "future"
($t;method (list $Function) (#;Some $Object) (list)) false)))
(def: (process//schedule [millisecondsI procedureI])
Binary
(|>. millisecondsI ($i;unwrap #$;Long)
- procedureI ($i;CHECKCAST &runtime;function-class)
- ($i;INVOKESTATIC &runtime;runtime-class "schedule"
+ procedureI ($i;CHECKCAST hostL;function-class)
+ ($i;INVOKESTATIC hostL;runtime-class "schedule"
($t;method (list $t;long $Function) (#;Some $Object) (list)) false)))
## [Bundles]
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
index f908c6c6e..fc6bdd01b 100644
--- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -15,6 +15,7 @@
["s" syntax #+ syntax:])
[host])
(luxc ["&" base]
+ [";L" host]
(lang ["la" analysis]
["ls" synthesis])
["&;" analyser]
@@ -494,13 +495,13 @@
(wrap (|>. valueI
($i;unwrap primitive)
($i;PUTSTATIC class field (#$;Primitive primitive))
- ($i;string &runtime;unit))))
+ ($i;string hostL;unit))))
#;None
(wrap (|>. valueI
($i;CHECKCAST class)
($i;PUTSTATIC class field ($t;class class (list)))
- ($i;string &runtime;unit)))))
+ ($i;string hostL;unit)))))
_
(&;fail (format "Wrong syntax for '" proc "'."))))
@@ -655,7 +656,7 @@
(case returnT
#;None
(|>. returnI
- ($i;string &runtime;unit))
+ ($i;string hostL;unit))
(#;Some type)
(case type
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index d2ad42a2c..d3f99ae6a 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -7,6 +7,7 @@
[meta]
[host])
(luxc ["&" base]
+ [";L" host]
(lang ["la" analysis]
["ls" synthesis])
["&;" analyser]
@@ -40,20 +41,16 @@
(visitEnd [] void)
(toByteArray [] (Array byte)))
-(def: #export runtime-class Text "LuxRuntime")
-(def: #export function-class Text "LuxFunction")
-(def: #export unit Text "\u0000")
-
(def: $Object $;Type ($t;class "java.lang.Object" (list)))
(def: $Object-Array $;Type ($t;array +1 $Object))
(def: $String $;Type ($t;class "java.lang.String" (list)))
(def: #export $Stack $;Type ($t;array +1 $Object))
-(def: #export $Tuple $;Type ($t;array +1 $Object))
-(def: #export $Variant $;Type ($t;array +1 $Object))
+(def: #export $Tuple $;Type $Object-Array)
+(def: #export $Variant $;Type $Object-Array)
(def: #export $Tag $;Type $t;int)
(def: #export $Flag $;Type $Object)
(def: #export $Datum $;Type $Object)
-(def: #export $Function $;Type ($t;class function-class (list)))
+(def: #export $Function $;Type ($t;class hostL;function-class (list)))
(def: $Throwable $;Type ($t;class "java.lang.Throwable" (list)))
(def: #export logI
@@ -69,7 +66,7 @@
(def: variantI
$;Inst
- ($i;INVOKESTATIC runtime-class "variant_make" variant-method false))
+ ($i;INVOKESTATIC hostL;runtime-class "variant_make" variant-method false))
(def: #export leftI
$;Inst
@@ -93,9 +90,13 @@
$;Inst
(|>. ($i;int 0)
$i;NULL
- ($i;string unit)
+ ($i;string hostL;unit)
variantI))
+(def: #export string-concatI
+ $;Inst
+ ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false))
+
(def: #export partials-field Text "partials")
(def: #export apply-method Text "apply")
(def: #export num-apply-variants Nat +8)
@@ -108,8 +109,59 @@
$;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)]
- (|>. ($d;method #$;Public $;staticM "variant_make"
+ store-valueI (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)
+ force-textMT ($t;method (list $Object) (#;Some $String) (list))]
+ (|>. ($d;method #$;Public $;staticM "force_text" force-textMT
+ (<| $i;with-label (function [@is-null])
+ $i;with-label (function [@normal-object])
+ $i;with-label (function [@array-loop])
+ $i;with-label (function [@within-bounds])
+ $i;with-label (function [@is-first])
+ $i;with-label (function [@elem-end])
+ $i;with-label (function [@fold-end])
+ (let [on-normal-objectI (|>. ($i;ALOAD +0)
+ ($i;INVOKEVIRTUAL "java.lang.Object" "toString" ($t;method (list) (#;Some $String) (list)) false))
+ on-null-objectI ($i;string "NULL")
+ arrayI (|>. ($i;ALOAD +0)
+ ($i;CHECKCAST ($t;descriptor $Object-Array)))
+ recurseI ($i;INVOKESTATIC hostL;runtime-class "force_text" force-textMT false)
+ 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
+ )
+ add-spacingI (|>. ($i;string ", ") $i;SWAP string-concatI)
+ merge-with-totalI (|>. $i;DUP_X2 $i;POP ## TSIP => TPSI
+ swap2 ## TPSI => SITP
+ string-concatI ## SITP => SIT
+ $i;DUP_X2 $i;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
+ force-elemI merge-with-totalI
+ ($i;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)))
+ ($d;method #$;Public $;staticM "variant_make"
($t;method (list $t;int $Object $Object)
(#;Some $Variant)
(list))
@@ -120,14 +172,18 @@
store-valueI
$i;ARETURN)))))
+(def: #export force-textI
+ $;Inst
+ ($i;INVOKESTATIC hostL;runtime-class "force_text" ($t;method (list $Object) (#;Some $String) (list)) false))
+
(def: nat-methods
$;Def
(let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list))
- less-thanI (function [@where] (|>. ($i;INVOKESTATIC runtime-class "compare_nat" compare-nat-method false) ($i;IFLT @where)))
+ less-thanI (function [@where] (|>. ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false) ($i;IFLT @where)))
$BigInteger ($t;class "java.math.BigInteger" (list))
upcast-method ($t;method (list $t;long) (#;Some $BigInteger) (list))
div-method ($t;method (list $t;long $t;long) (#;Some $t;long) (list))
- upcastI ($i;INVOKESTATIC runtime-class "_toUnsignedBigInteger" upcast-method false)
+ upcastI ($i;INVOKESTATIC hostL;runtime-class "_toUnsignedBigInteger" upcast-method false)
downcastI ($i;INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t;method (list) (#;Some $t;long) (list)) false)]
## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
(|>. ($d;method #$;Public $;staticM "_toUnsignedBigInteger" upcast-method
@@ -300,7 +356,7 @@
(let [subjectI ($i;LLOAD +0)
paramI ($i;LLOAD +2)
equal?I (function [@where] (|>. $i;LCMP ($i;IFEQ @where)))
- count-leading-zerosI ($i;INVOKESTATIC runtime-class "count_leading_zeros" clz-method false)
+ count-leading-zerosI ($i;INVOKESTATIC hostL;runtime-class "count_leading_zeros" clz-method false)
calc-max-shiftI (|>. subjectI count-leading-zerosI
paramI count-leading-zerosI
($i;INVOKESTATIC "java.lang.Math" "min" ($t;method (list $t;int $t;int) (#;Some $t;int) (list)) false)
@@ -373,7 +429,7 @@
($i;int 1)
$i;AALOAD
$i;ARETURN))
- ($d;method #$;Public $;staticM "pm_variant" ($t;method (list $Stack $t;int $Object) (#;Some $Object) (list))
+ ($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])
@@ -487,7 +543,7 @@
($i;label @from)
($i;ALOAD +0)
$i;NULL
- ($i;INVOKEVIRTUAL function-class apply-method (apply-signature +1) false)
+ ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false)
rightI
$i;ARETURN
($i;label @to)
@@ -505,14 +561,14 @@
(Meta &common;Bytecode)
(do meta;Monad<Meta>
[_ (wrap [])
- #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-class (list) ["java.lang.Object" (list)] (list)
+ #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC hostL;runtime-class (list) ["java.lang.Object" (list)] (list)
(|>. adt-methods
nat-methods
frac-methods
deg-methods
pm-methods
io-methods))]
- _ (&common;store-class runtime-class bytecode)]
+ _ (&common;store-class hostL;runtime-class bytecode)]
(wrap bytecode)))
(def: generate-function
@@ -526,24 +582,24 @@
(list/map $i;ALOAD)
$i;fuse)]
(|>. preI
- ($i;INVOKEVIRTUAL function-class apply-method (apply-signature (n.dec arity)) false)
- ($i;CHECKCAST function-class)
+ ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature (n.dec arity)) false)
+ ($i;CHECKCAST hostL;function-class)
($i;ALOAD arity)
- ($i;INVOKEVIRTUAL function-class apply-method (apply-signature +1) false)
+ ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false)
$i;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)
+ bytecode ($d;abstract #$;V1.6 #$;Public $;noneC hostL;function-class (list) ["java.lang.Object" (list)] (list)
(|>. ($d;field #$;Public $;finalF partials-field $t;int)
($d;method #$;Public $;noneM "<init>" ($t;method (list $t;int) #;None (list))
(|>. ($i;ALOAD +0)
($i;INVOKESPECIAL "java.lang.Object" "<init>" ($t;method (list) #;None (list)) false)
($i;ALOAD +0)
($i;ILOAD +1)
- ($i;PUTFIELD function-class partials-field $t;int)
+ ($i;PUTFIELD hostL;function-class partials-field $t;int)
$i;RETURN))
applyI))]
- _ (&common;store-class function-class bytecode)]
+ _ (&common;store-class hostL;function-class bytecode)]
(wrap bytecode)))
(def: #export generate
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
index cee5800cd..28196b914 100644
--- a/new-luxc/source/luxc/generator/structure.jvm.lux
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -3,9 +3,10 @@
(lux (control [monad #+ do])
(data text/format
(coll [list]))
- [meta #+ Monad<Meta> "Meta/" Monad<Meta>]
+ [meta]
[host #+ do-to])
(luxc ["&" base]
+ [";L" host]
(lang ["la" analysis]
["ls" synthesis])
["&;" analyser]
@@ -21,7 +22,7 @@
(def: #export (generate-tuple generate members)
(-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis) (Meta $;Inst))
- (do Monad<Meta>
+ (do meta;Monad<Meta>
[#let [size (list;size members)]
_ (&;assert "Cannot generate tuples with less than 2 elements."
(n.>= +2 size))
@@ -47,12 +48,12 @@
(def: #export (generate-variant generate tag tail? member)
(-> (-> ls;Synthesis (Meta $;Inst)) Nat Bool ls;Synthesis (Meta $;Inst))
- (do Monad<Meta>
+ (do meta;Monad<Meta>
[memberI (generate member)]
(wrap (|>. ($i;int (nat-to-int tag))
(flagI tail?)
memberI
- ($i;INVOKESTATIC ../runtime;runtime-class
+ ($i;INVOKESTATIC hostL;runtime-class
"variant_make"
($t;method (list $t;int $Object $Object)
(#;Some ($t;array +1 $Object))