From eff4c59794868b89d60fdc411f9b544a270b817e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 2 Aug 2021 20:26:21 -0400 Subject: Fixed a bug in the new compiler which allowed the same module to be imported more than once. --- lux-jvm/source/luxc/lang/translation/jvm/case.lux | 198 ++++++++++++---------- 1 file changed, 105 insertions(+), 93 deletions(-) (limited to 'lux-jvm/source/luxc/lang/translation/jvm/case.lux') diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index b7b1d6b0f..2c9bfdb61 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -71,6 +71,9 @@ 5 _.ICONST_5 _ (_.int (.int value)))) +(def: projectionJT + (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)])) + (def: (left_projection lefts) (-> Nat Inst) (.let [[indexI accessI] (.case lefts @@ -80,7 +83,7 @@ lefts [(leftsI lefts) - (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)]))])] + (_.INVOKESTATIC //.$Runtime "tuple_left" ..projectionJT)])] (|>> (_.CHECKCAST //.$Tuple) indexI accessI))) @@ -89,17 +92,23 @@ (-> Nat Inst) (|>> (_.CHECKCAST //.$Tuple) (leftsI lefts) - (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)])))) + (_.INVOKESTATIC //.$Runtime "tuple_right" ..projectionJT))) + +(def: equalsJT + (type.method [(list) (list //.$Value) type.boolean (list)])) + +(def: sideJT + (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) (def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label Phase Archive Path (Operation Inst)) (.case path #synthesis.Pop - (operation@wrap ..popI) + (operation@in ..popI) (#synthesis.Bind register) - (operation@wrap (|>> peekI - (_.ASTORE register))) + (operation@in (|>> peekI + (_.ASTORE register))) (#synthesis.Bit_Fork when thenP elseP) (do phase.monad @@ -109,15 +118,15 @@ (path' stack_depth @else @end phase archive elseP) #.None - (wrap (_.GOTO @else))) + (in (_.GOTO @else))) #let [ifI (.if when _.IFEQ _.IFNE)]] - (wrap (<| _.with_label (function (_ @else)) - (|>> peekI - (_.unwrap type.boolean) - (ifI @else) - thenG - (_.label @else) - elseG)))) + (in (<| _.with_label (function (_ @else)) + (|>> peekI + (_.unwrap type.boolean) + (ifI @else) + thenG + (_.label @else) + elseG)))) (^template [ ] [( cons) @@ -126,70 +135,70 @@ (monad.fold @ (function (_ [test thenP] elseG) (do @ [thenG (path' stack_depth @else @end phase archive thenP)] - (wrap (<| _.with_label (function (_ @else)) - (|>> - ( test) - - ( @else) - - thenG - (_.label @else) - elseG))))) + (in (<| _.with_label (function (_ @else)) + (|>> + ( test) + + ( @else) + + thenG + (_.label @else) + elseG))))) (|>> (_.GOTO @else)) - (#.Cons cons)))] - (wrap (|>> peekI - - forkG)))]) + (#.Item cons)))] + (in (|>> peekI + + forkG)))]) ([#synthesis.I64_Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] [#synthesis.F64_Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] [#synthesis.Text_Fork (|>) _.DUP _.POP _.string - (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list) (list //.$Value) type.boolean (list)])) + (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" ..equalsJT) _.IFEQ]) (#synthesis.Then bodyS) (do phase.monad [bodyI (phase archive bodyS)] - (wrap (|>> (pop_altI stack_depth) - bodyI - (_.GOTO @end)))) + (in (|>> (pop_altI stack_depth) + bodyI + (_.GOTO @end)))) (^template [ ] [(^ ( lefts)) - (operation@wrap (<| _.with_label (function (_ @success)) - _.with_label (function (_ @fail)) - (|>> peekI - (_.CHECKCAST //.$Variant) - (structure.tagI lefts ) - (structure.flagI ) - (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) - _.DUP - (_.IFNULL @fail) - (_.GOTO @success) - (_.label @fail) - _.POP - (_.GOTO @else) - (_.label @success) - pushI)))]) + (operation@in (<| _.with_label (function (_ @success)) + _.with_label (function (_ @fail)) + (|>> peekI + (_.CHECKCAST //.$Variant) + (structure.tagI lefts ) + (structure.flagI ) + (_.INVOKESTATIC //.$Runtime "pm_variant" ..sideJT) + _.DUP + (_.IFNULL @fail) + (_.GOTO @success) + (_.label @fail) + _.POP + (_.GOTO @else) + (_.label @success) + pushI)))]) ([synthesis.side/left false] [synthesis.side/right true]) ## Extra optimization (^template [ ] [(^ ( lefts)) - (operation@wrap (|>> peekI - ( lefts) - pushI)) + (operation@in (|>> peekI + ( lefts) + pushI)) (^ (synthesis.path/seq ( lefts) (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] - (wrap (|>> peekI - ( lefts) - (_.ASTORE register) - then!)))]) + (in (|>> peekI + ( lefts) + (_.ASTORE register) + then!)))]) ([synthesis.member/left ..left_projection] [synthesis.member/right ..right_projection]) @@ -197,32 +206,35 @@ (do phase.monad [leftI (path' stack_depth @else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] - (wrap (|>> leftI - rightI))) + (in (|>> leftI + rightI))) (#synthesis.Alt leftP rightP) (do phase.monad [@alt_else _.make_label leftI (path' (inc stack_depth) @alt_else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] - (wrap (|>> _.DUP - leftI - (_.label @alt_else) - _.POP - rightI))) + (in (|>> _.DUP + leftI + (_.label @alt_else) + _.POP + rightI))) )) +(def: failJT + (type.method [(list) (list) type.void (list)])) + (def: (path @end phase archive path) (-> Label Phase Archive Path (Operation Inst)) (do phase.monad [@else _.make_label pathI (..path' 1 @else @end phase archive path)] - (wrap (|>> pathI - (_.label @else) - _.POP - (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) (list) type.void (list)])) - _.NULL - (_.GOTO @end))))) + (in (|>> pathI + (_.label @else) + _.POP + (_.INVOKESTATIC //.$Runtime "pm_fail" ..failJT) + _.NULL + (_.GOTO @end))))) (def: #export (if phase archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -230,40 +242,40 @@ [testI (phase archive testS) thenI (phase archive thenS) elseI (phase archive elseS)] - (wrap (<| _.with_label (function (_ @else)) - _.with_label (function (_ @end)) - (|>> testI - (_.unwrap type.boolean) - (_.IFEQ @else) - thenI - (_.GOTO @end) - (_.label @else) - elseI - (_.label @end)))))) + (in (<| _.with_label (function (_ @else)) + _.with_label (function (_ @end)) + (|>> testI + (_.unwrap type.boolean) + (_.IFEQ @else) + thenI + (_.GOTO @end) + (_.label @else) + elseI + (_.label @end)))))) (def: #export (let phase archive [inputS register exprS]) (Generator [Synthesis Nat Synthesis]) (do phase.monad [inputI (phase archive inputS) exprI (phase archive exprS)] - (wrap (|>> inputI - (_.ASTORE register) - exprI)))) + (in (|>> inputI + (_.ASTORE register) + exprI)))) (def: #export (get phase archive [path recordS]) (Generator [(List synthesis.Member) Synthesis]) (do phase.monad [recordG (phase archive recordS)] - (wrap (list@fold (function (_ step so_far) - (.let [next (.case step - (#.Left lefts) - (..left_projection lefts) - - (#.Right lefts) - (..right_projection lefts))] - (|>> so_far next))) - recordG - (list.reverse path))))) + (in (list@fold (function (_ step so_far) + (.let [next (.case step + (#.Left lefts) + (..left_projection lefts) + + (#.Right lefts) + (..right_projection lefts))] + (|>> so_far next))) + recordG + (list.reversed path))))) (def: #export (case phase archive [valueS path]) (Generator [Synthesis Path]) @@ -271,8 +283,8 @@ [@end _.make_label valueI (phase archive valueS) pathI (..path @end phase archive path)] - (wrap (|>> _.NULL - valueI - pushI - pathI - (_.label @end))))) + (in (|>> _.NULL + valueI + pushI + pathI + (_.label @end))))) -- cgit v1.2.3