aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/runtime.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/generator/runtime.jvm.lux')
-rw-r--r--new-luxc/source/luxc/generator/runtime.jvm.lux79
1 files changed, 68 insertions, 11 deletions
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index 68e18deaa..69f90cea0 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -2,7 +2,8 @@
lux
(lux (control monad)
(data ["R" result]
- text/format)
+ text/format
+ (coll [list "L/" Functor<List>]))
[math]
[macro #+ Monad<Lux> "Lux/" Monad<Lux>]
[host #+ do-to])
@@ -40,8 +41,8 @@
(visitEnd [] void)
(toByteArray [] Byte-Array))
-(def: #export runtime-name Text "LuxRuntime")
-(def: #export function-name Text "LuxFunction")
+(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)))
@@ -54,7 +55,7 @@
(def: #export $Flag $;Type $Object)
(def: #export $Datum $;Type $Object)
-(def: logI
+(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)) false))]
@@ -67,7 +68,7 @@
(def: variant-makeI
$;Inst
- ($i;INVOKESTATIC runtime-name "variant_make" variant-method false))
+ ($i;INVOKESTATIC runtime-class "variant_make" variant-method false))
(def: #export someI
$;Inst
@@ -102,11 +103,11 @@
(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-name "compare_nat" compare-nat-method false) ($i;IFLT @where)))
+ less-thanI (function [@where] (|>. ($i;INVOKESTATIC 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-name "_toUnsignedBigInteger" upcast-method false)
+ upcastI ($i;INVOKESTATIC 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
@@ -279,7 +280,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-name "count_leading_zeros" clz-method false)
+ count-leading-zerosI ($i;INVOKESTATIC 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)
@@ -323,6 +324,12 @@
($i;string "Invalid expression for pattern-matching.")
($i;INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t;method (list $String) #;None (list)) false)
$i;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" "<init>" ($t;method (list $String) #;None (list)) false)
+ $i;ATHROW))
($d;method #$;Public $;staticM "pm_push" ($t;method (list $Stack $Object) (#;Some $Stack) (list))
(|>. ($i;int 2)
($i;ANEWARRAY "java.lang.Object")
@@ -439,15 +446,65 @@
$i;ARETURN)))
)))
-(def: #export generate
+(def: generate-runtime
(Lux &common;Bytecode)
(do Monad<Lux>
[_ (wrap [])
- #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-name (list) ["java.lang.Object" (list)] (list)
+ #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-class (list) ["java.lang.Object" (list)] (list)
(|>. adt-methods
nat-methods
frac-methods
deg-methods
pm-methods))]
- _ (&common;store-class runtime-name bytecode)]
+ _ (&common;store-class runtime-class bytecode)]
(wrap bytecode)))
+
+(def: #export partials-field Text "partials")
+(def: #export apply-method Text "apply")
+(def: #export num-apply-variants Nat +8)
+
+(def: #export (apply-signature arity)
+ (-> ls;Arity $;Method)
+ ($t;method (list;repeat arity $Object) (#;Some $Object) (list)))
+
+(def: generate-function
+ (Lux &common;Bytecode)
+ (do Monad<Lux>
+ [_ (wrap [])
+ #let [applyI (|> (list;n.range +2 num-apply-variants)
+ (L/map (function [arity]
+ ($d;method #$;Public $;noneM apply-method (apply-signature arity)
+ (let [preI (|> (list;n.range +0 (n.dec arity))
+ (L/map $i;ALOAD)
+ $i;fuse)]
+ (|>. preI
+ ($i;INVOKEVIRTUAL function-class apply-method (apply-signature (n.dec arity)) false)
+ ($i;CHECKCAST function-class)
+ ($i;ALOAD arity)
+ ($i;INVOKEVIRTUAL function-class apply-method (apply-signature +1) false)
+ $i;ARETURN)))))
+ (list& ($d;abstract-method #$;Public $;noneM apply-method (apply-signature +1))
+ ## ($d;method #$;Public $;noneM apply-method (apply-signature +1)
+ ## (|>. $i;NULL
+ ## $i;ARETURN))
+ )
+ $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 "<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;RETURN))
+ applyI))]
+ _ (&common;store-class function-class bytecode)]
+ (wrap bytecode)))
+
+(def: #export generate
+ (Lux Unit)
+ (do Monad<Lux>
+ [_ generate-runtime
+ _ generate-function]
+ (wrap [])))