From aa42fde49c66d73f41b17d4939a9226671442a8a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 24 Jun 2020 22:31:02 -0400 Subject: Last bug fixes to get the new JVM compiler to fully process the standard library and its tests. --- lux-jvm/source/luxc/lang/directive/jvm.lux | 23 +++++++-------- lux-jvm/source/luxc/lang/host/jvm.lux | 2 +- lux-jvm/source/luxc/lang/translation/jvm/case.lux | 2 +- .../source/luxc/lang/translation/jvm/runtime.lux | 34 +++++++++++++--------- lux-jvm/source/program.lux | 18 +++++++----- 5 files changed, 43 insertions(+), 36 deletions(-) (limited to 'lux-jvm') diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 27b1c8688..23d2fb6d5 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -492,7 +492,7 @@ (dictionary.new nat.hash)) (def: bytecode - (-> (/.Bytecode /.Label) Inst) + (-> (/.Bytecode /.Label) jvm.Inst) (|>> [..fresh] ..relabel-bytecode product.right @@ -500,15 +500,15 @@ row.to-list _.fuse)) -(type: Pseudo-Handler - (-> Text (List Synthesis) (Try (/.Bytecode /.Label)))) +(type: Handler + (generation.Handler jvm.Anchor (/.Bytecode /.Label) jvm.Definition)) -(def: (true-handler pseudo) - (-> Pseudo-Handler jvm.Handler) +(def: (true-handler extender pseudo) + (-> jvm.Extender Any jvm.Handler) (function (_ extension-name phase archive inputs) - (|> (pseudo extension-name inputs) - (:: try.monad map ..bytecode) - phase.lift))) + (do phase.monad + [bytecode ((extender pseudo) extension-name phase archive inputs)] + (wrap (..bytecode (:coerce (/.Bytecode /.Label) bytecode)))))) (def: (def::generation extender) (-> jvm.Extender @@ -518,10 +518,9 @@ (^ (list nameC valueC)) (do phase.monad [[_ _ name] (lux/.evaluate! archive Text nameC) - [_ _ pseudo-handlerV] (lux/.evaluate! archive ..Pseudo-Handler valueC) - _ (|> pseudo-handlerV - (:coerce ..Pseudo-Handler) - ..true-handler + [_ handlerV] (lux/.generator archive (:coerce Text name) ..Handler valueC) + _ (|> handlerV + (..true-handler extender) (extension.install extender (:coerce Text name)) directive.lift-generation) _ (directive.lift-generation diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index 841b6a2a9..9301ab4ae 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -70,7 +70,7 @@ (template [ ] [(type: #export - ( ..Anchor Inst Definition))] + ( ..Anchor ..Inst ..Definition))] [State generation.State] [Operation generation.Operation] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index 573e9764b..d77e747fd 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -260,7 +260,7 @@ (..right-projection lefts))] (|>> so-far next))) recordG - path)))) + (list.reverse path))))) (def: #export (case phase archive [valueS path]) (Generator [Synthesis Path]) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index a657a7a38..1cad5569f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -67,7 +67,7 @@ (def: #export leftI Inst - (|>> (_.int +0) + (|>> _.ICONST_0 _.NULL _.DUP2_X1 _.POP2 @@ -75,7 +75,7 @@ (def: #export rightI Inst - (|>> (_.int +1) + (|>> _.ICONST_1 (_.string "") _.DUP2_X1 _.POP2 @@ -85,7 +85,7 @@ (def: #export noneI Inst - (|>> (_.int +0) + (|>> _.ICONST_0 _.NULL (_.string synthesis.unit) variantI)) @@ -115,12 +115,12 @@ (def: adt-methods Def - (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE) - store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) - store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)] + (let [store-tagI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE) + store-flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE) + store-valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" (type.method [(list $Tag $Flag $Value) //.$Variant (list)]) - (|>> (_.int +3) + (|>> _.ICONST_3 (_.ANEWARRAY $Value) store-tagI store-flagI @@ -146,14 +146,20 @@ (def: pm-methods Def - (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) - last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB) + (let [tuple-sizeI (|>> (_.ALOAD 0) + _.ARRAYLENGTH) + last-rightI (|>> tuple-sizeI + _.ICONST_1 + _.ISUB) leftsI (_.ILOAD 1) left-indexI leftsI sub-leftsI (|>> leftsI last-rightI _.ISUB) - sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple)) + sub-tupleI (|>> (_.ALOAD 0) + last-rightI + _.AALOAD + (_.CHECKCAST //.$Tuple)) recurI (: (-> Label Inst) (function (_ @loop) (|>> sub-leftsI (_.ISTORE 1) @@ -166,14 +172,14 @@ (|>> (illegal-state-exception "Error while applying function.") _.ATHROW)) ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)]) - (|>> (_.int +2) + (|>> _.ICONST_2 (_.ANEWARRAY $Value) _.DUP - (_.int +1) + _.ICONST_1 (_.ALOAD 0) _.AASTORE _.DUP - (_.int +0) + _.ICONST_0 (_.ALOAD 1) _.AASTORE _.ARETURN)) @@ -253,7 +259,7 @@ _.with-label (function (_ @not-tail)) _.with-label (function (_ @slice)) (let [right-indexI (|>> leftsI - (_.int +1) + _.ICONST_1 _.IADD) right-accessI (|>> (_.ALOAD 0) _.SWAP diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index e2cf047e9..ccb8ba414 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -82,13 +82,14 @@ (host.array-write 0 _object-class) (host.array-write 1 _object-class))) -(def: _apply4-args +(def: _apply5-args (Array (java/lang/Class java/lang/Object)) - (|> (host.array (java/lang/Class java/lang/Object) 4) + (|> (host.array (java/lang/Class java/lang/Object) 5) (host.array-write 0 _object-class) (host.array-write 1 _object-class) (host.array-write 2 _object-class) - (host.array-write 3 _object-class))) + (host.array-write 3 _object-class) + (host.array-write 4 _object-class))) (def: #export (expander macro inputs lux) Expander @@ -127,7 +128,7 @@ (:coerce Handler) (function (@self name phase)) (:coerce Phase) - (function (@self parameters)) + (function (@self archive parameters)) (:coerce Operation) (function (@self state)) (:coerce Try) @@ -137,14 +138,15 @@ [method (|> handler (:coerce java/lang/Object) (java/lang/Object::getClass) - (java/lang/Class::getMethod "apply" _apply4-args))] + (java/lang/Class::getMethod "apply" _apply5-args))] (java/lang/reflect/Method::invoke (:coerce java/lang/Object handler) - (|> (host.array java/lang/Object 4) + (|> (host.array java/lang/Object 5) (host.array-write 0 (:coerce java/lang/Object name)) (host.array-write 1 (:coerce java/lang/Object phase)) - (host.array-write 2 (:coerce java/lang/Object parameters)) - (host.array-write 3 (:coerce java/lang/Object state))) + (host.array-write 2 (:coerce java/lang/Object archive)) + (host.array-write 3 (:coerce java/lang/Object parameters)) + (host.array-write 4 (:coerce java/lang/Object state))) method)))) (def: (target service) -- cgit v1.2.3