From d4ded2084127fd8953d2889d72bab889213000a1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 7 Apr 2019 21:12:08 -0400 Subject: Upgraded the tuple right-access mechanism to the new style. --- luxc/src/lux/compiler/jvm/case.clj | 41 ++++---- luxc/src/lux/compiler/jvm/lux.clj | 6 +- luxc/src/lux/compiler/jvm/rt.clj | 113 ++++++++++----------- .../source/luxc/lang/translation/jvm/case.jvm.lux | 52 +++++----- .../luxc/lang/translation/jvm/runtime.jvm.lux | 44 ++++---- .../lux/tool/compiler/phase/generation/js/case.lux | 28 +++-- .../tool/compiler/phase/generation/js/runtime.lux | 39 ++++--- .../tool/compiler/phase/generation/python/case.lux | 28 +++-- .../compiler/phase/generation/python/runtime.lux | 45 ++++---- 9 files changed, 209 insertions(+), 187 deletions(-) diff --git a/luxc/src/lux/compiler/jvm/case.clj b/luxc/src/lux/compiler/jvm/case.clj index cceed14e4..aa262a102 100644 --- a/luxc/src/lux/compiler/jvm/case.clj +++ b/luxc/src/lux/compiler/jvm/case.clj @@ -108,27 +108,26 @@ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z") (.visitJumpInsn Opcodes/IFEQ $else)) - (&o/$TuplePM _idx+) - (|let [[_idx is-tail?] (|case _idx+ - (&/$Left _idx) - (&/T [_idx false]) - - (&/$Right _idx) - (&/T [_idx true]))] - (if (= 0 _idx) - (doto writer - stack-peek - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitLdcInsn (int 0)) - (.visitInsn Opcodes/AALOAD) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) - (doto writer - stack-peek - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitLdcInsn (int _idx)) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" (if is-tail? "product_getRight" "tuple_left") "([Ljava/lang/Object;I)Ljava/lang/Object;") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") - ))) + (&o/$TuplePM (&/$Left lefts)) + (let [accessI (if (= 0 lefts) + #(doto % + (.visitInsn Opcodes/AALOAD)) + #(doto % + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;")))] + (doto writer + stack-peek + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitLdcInsn (int lefts)) + accessI + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))) + + (&o/$TuplePM (&/$Right _idx)) + (doto writer + stack-peek + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitLdcInsn (int (dec _idx))) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) (&o/$VariantPM _idx+) (|let [$success (new Label) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index b57b94894..4aebc2bbf 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -206,9 +206,11 @@ (|let [[idx tail?] step] (doto *writer* (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitLdcInsn (int idx)) + (.visitLdcInsn (int (if tail? + (dec idx) + idx))) (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" - (if tail? "product_getRight" "tuple_left") + (if tail? "tuple_right" "tuple_left") "([Ljava/lang/Object;I)Ljava/lang/Object;")))) _path)]] (return nil))) diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index d28011b41..f5fc85795 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -68,88 +68,85 @@ ;; Runtime infrastructure (defn ^:private compile-LuxRT-adt-methods [^ClassWriter =class] - (|let [_ (let [$begin (new Label) + (|let [lefts #(doto % + (.visitVarInsn Opcodes/ILOAD 1)) + tuple-size #(doto % + (.visitVarInsn Opcodes/ALOAD 0) + (.visitInsn Opcodes/ARRAYLENGTH)) + last-right-index #(doto % + tuple-size + (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/ISUB)) + sub-tuple #(doto % + (.visitVarInsn Opcodes/ALOAD 0) + last-right-index + (.visitInsn Opcodes/AALOAD) + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")) + _ (let [$begin (new Label) $not-rec (new Label) - index-right #(doto % - (.visitVarInsn Opcodes/ALOAD 0) - (.visitInsn Opcodes/ARRAYLENGTH) - (.visitLdcInsn (int 1)) - (.visitInsn Opcodes/ISUB)) - lefts #(doto % - (.visitVarInsn Opcodes/ILOAD 1)) left-index lefts - access #(doto % - (.visitVarInsn Opcodes/ALOAD 0) - left-index - (.visitInsn Opcodes/AALOAD)) + left-access #(doto % + (.visitVarInsn Opcodes/ALOAD 0) + left-index + (.visitInsn Opcodes/AALOAD)) sub-lefts #(doto % - ;; index-right, lefts + ;; last-right-index, lefts (.visitInsn Opcodes/SWAP) - (.visitInsn Opcodes/ISUB)) - sub-tuple #(doto % - (.visitVarInsn Opcodes/ALOAD 0) - index-right - (.visitInsn Opcodes/AALOAD) - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;"))] + (.visitInsn Opcodes/ISUB))] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil) (.visitCode) (.visitLabel $begin) - index-right + last-right-index lefts (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $not-rec) - sub-lefts (.visitVarInsn Opcodes/ISTORE 1) sub-tuple (.visitVarInsn Opcodes/ASTORE 0) + sub-lefts (.visitVarInsn Opcodes/ISTORE 1) (.visitJumpInsn Opcodes/GOTO $begin) (.visitLabel $not-rec) - ;; index-right, lefts + ;; last-right-index, lefts ;; (.visitInsn Opcodes/POP2) ;; - access + left-access (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd))) _ (let [$begin (new Label) $is-last (new Label) - $must-copy (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "product_getRight" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil) + $must-copy (new Label) + right-index #(doto % + lefts + (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/IADD)) + right-access #(doto % + (.visitVarInsn Opcodes/ALOAD 0) + (.visitInsn Opcodes/SWAP) + (.visitInsn Opcodes/AALOAD)) + sub-right #(doto % + (.visitVarInsn Opcodes/ALOAD 0) + right-index + tuple-size + (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;")) + sub-lefts #(doto % + lefts + last-right-index + (.visitInsn Opcodes/ISUB))] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil) (.visitCode) (.visitLabel $begin) - (.visitVarInsn Opcodes/ALOAD 0) ;; tuple - (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-size - (.visitVarInsn Opcodes/ILOAD 1) ;; tuple-size, index - (.visitLdcInsn (int 1)) ;; tuple-size, index, offset-last-elem - (.visitInsn Opcodes/IADD) ;; tuple-size, index-last-elem - (.visitInsn Opcodes/DUP2) ;; tuple-size, index-last-elem, tuple-size, index-last-elem - (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last) ;; tuple-size, index-last-elem - (.visitJumpInsn Opcodes/IF_ICMPGT $must-copy) ;; + last-right-index + right-index + (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last) + (.visitJumpInsn Opcodes/IF_ICMPGT $must-copy) ;; Must recurse - (.visitVarInsn Opcodes/ALOAD 0) ;; tuple - (.visitInsn Opcodes/DUP) ;; tuple, tuple - (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple, tuple-size - (.visitLdcInsn (int 1)) ;; tuple, tuple-size, offset-last-elem - (.visitInsn Opcodes/ISUB) ;; tuple, offset-tuple-last-elem - (.visitInsn Opcodes/AALOAD) ;; tuple-tail - (.visitVarInsn Opcodes/ILOAD 1) ;; tuple-tail, index - (.visitVarInsn Opcodes/ALOAD 0) ;; tuple-tail, index, tuple - (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-tail, index, tuple-size - (.visitLdcInsn (int 1)) ;; tuple-tail, index, tuple-size, 1 - (.visitInsn Opcodes/ISUB) ;; tuple-tail, index, tuple-size* - (.visitInsn Opcodes/ISUB) ;; tuple-tail, index* - (.visitVarInsn Opcodes/ISTORE 1) ;; tuple-tail - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") ;; tuple-tail - (.visitVarInsn Opcodes/ASTORE 0) ;; + sub-tuple (.visitVarInsn Opcodes/ASTORE 0) + sub-lefts (.visitVarInsn Opcodes/ISTORE 1) (.visitJumpInsn Opcodes/GOTO $begin) (.visitLabel $must-copy) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitInsn Opcodes/ARRAYLENGTH) - (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;") + sub-right (.visitInsn Opcodes/ARETURN) - (.visitLabel $is-last) ;; tuple-size, index-last-elem - ;; (.visitInsn Opcodes/POP2) ;; - (.visitVarInsn Opcodes/ALOAD 0) ;; tuple - (.visitVarInsn Opcodes/ILOAD 1) ;; tuple, index - (.visitInsn Opcodes/AALOAD) ;; elem + (.visitLabel $is-last) + ;; last-right-index, right-index + ;; (.visitInsn Opcodes/POP) + right-access (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd))) 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 22817e8eb..43d11c71e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -132,29 +132,35 @@ ([synthesis.side/left _.NULL function.identity] [synthesis.side/right (_.string "") .inc]) - (^template [ ] - (^ ( idx)) - (operation/wrap (.case ( idx) - 0 - (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Tuple)) - (_.int +0) - _.AALOAD - pushI) - - idx - (|>> peekI - (_.CHECKCAST ($t.descriptor runtime.$Tuple)) - (_.int (.int idx)) - (_.INVOKESTATIC //.runtime-class - - ($t.method (list runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - #0) - pushI)))) - ([synthesis.member/left "tuple_left" <|] - [synthesis.member/right "pm_right" inc]) + (^ (synthesis.member/left lefts)) + (operation/wrap (.let [accessI (.case lefts + 0 + _.AALOAD + + lefts + (_.INVOKESTATIC //.runtime-class + "tuple_left" + ($t.method (list runtime.$Tuple $t.int) + (#.Some $Object) + (list)) + #0))] + (|>> peekI + (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.int (.int lefts)) + accessI + pushI))) + + (^ (synthesis.member/right lefts)) + (operation/wrap (|>> peekI + (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.int (.int lefts)) + (_.INVOKESTATIC //.runtime-class + "tuple_right" + ($t.method (list runtime.$Tuple $t.int) + (#.Some $Object) + (list)) + #0) + pushI)) (#synthesis.Alt leftP rightP) (do phase.monad 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 6ea00df21..973170d77 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -136,8 +136,6 @@ last-right-indexI (|>> tuple-sizeI (_.int +1) _.ISUB) leftsI (_.ILOAD 1) left-indexI leftsI - accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD) - sub-leftsI (|>> _.SWAP _.ISUB) sub-tupleI (|>> (_.ALOAD 0) last-right-indexI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple))) expected-last-sizeI (|>> (_.ILOAD 1) (_.int +1) _.IADD)] @@ -231,6 +229,8 @@ ($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) (<| _.with-label (function (_ @begin)) _.with-label (function (_ @not-recursive)) + (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD) + sub-leftsI (|>> _.SWAP _.ISUB)]) (|>> (_.label @begin) last-right-indexI leftsI @@ -241,34 +241,44 @@ (_.GOTO @begin) (_.label @not-recursive) ## _.POP2 - accessI + left-accessI _.ARETURN))) - ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) + ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) (<| _.with-label (function (_ @begin)) _.with-label (function (_ @tail)) _.with-label (function (_ @slice)) - (let [updated-idxI (|>> (_.ILOAD 1) (_.int +1) _.ISUB tuple-sizeI _.ISUB) - sliceI (|>> (_.ALOAD 0) (_.ILOAD 1) tuple-sizeI - (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" - ($t.method (list $Object-Array $t.int $t.int) - (#.Some $Object-Array) - (list)) - #0))]) + (let [right-indexI (|>> leftsI + (_.int +1) + _.IADD) + right-accessI (|>> (_.ALOAD 0) + _.SWAP + _.AALOAD) + sub-rightI (|>> (_.ALOAD 0) + right-indexI + tuple-sizeI + (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" + ($t.method (list $Object-Array $t.int $t.int) + (#.Some $Object-Array) + (list)) + #0)) + sub-leftsI (|>> leftsI + last-right-indexI + _.ISUB)]) (|>> (_.label @begin) - tuple-sizeI - expected-last-sizeI + last-right-indexI + right-indexI _.DUP2 (_.IF_ICMPEQ @tail) (_.IF_ICMPGT @slice) ## Must recurse sub-tupleI (_.ASTORE 0) - updated-idxI (_.ISTORE 1) + sub-leftsI (_.ISTORE 1) (_.GOTO @begin) (_.label @slice) - sliceI + sub-rightI _.ARETURN (_.label @tail) - ## _.POP2 - accessI + ## _.POP + right-accessI _.ARETURN))) ))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux index f426dd6ff..dca429854 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux @@ -39,15 +39,18 @@ (list valueO))))) (def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List [Nat Bit]) + (-> Phase Synthesis (List (Either Nat Nat)) (Operation Expression)) (do ////.monad [valueO (generate valueS)] - (wrap (list@fold (function (_ [idx tail?] source) - (.let [method (.if tail? - //runtime.product//right - //runtime.tuple//left)] - (method source (_.i32 (.int idx))))) + (wrap (list@fold (function (_ side source) + (.let [method (.case side + (^template [ ] + ( lefts) + ( (_.i32 (.int lefts)))) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) valueO pathP)))) @@ -165,11 +168,14 @@ ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) - (^template [ ] - (^ ( idx)) - (////@wrap (|> idx .int _.i32 ( ..peek-cursor) push-cursor!))) - ([/////synthesis.member/left //runtime.tuple//left (<|)] - [/////synthesis.member/right //runtime.product//right inc]) + (^ (/////synthesis.member/left 0)) + (////@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor))) + + (^template [ ] + (^ ( lefts)) + (////@wrap (push-cursor! ( (_.i32 (.int lefts)) ..peek-cursor)))) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind-top register thenP)) (do ////.monad diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index 43dcbe716..9102dd30d 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -177,33 +177,30 @@ @lux//program-args )) -(runtime: (tuple//left tuple lefts) - (with-vars [index-right] +(runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] ($_ _.then - (_.define index-right (..last-index tuple)) - (_.if (_.> lefts index-right) + (_.define last-index-right (..last-index tuple)) + (_.if (_.> lefts last-index-right) ## No need for recursion (_.return (_.at lefts tuple)) ## Needs recursion - (_.return (tuple//left (_.at index-right tuple) - (_.- index-right lefts))))))) + (_.return (tuple//left (_.- last-index-right lefts) + (_.at last-index-right tuple))))))) -(runtime: (product//right product index) - (with-vars [index-min-length] +(runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index] ($_ _.then - (_.define index-min-length (_.+ (_.i32 +1) index)) - (_.cond (list [(_.= index-min-length - (..length product)) - ## Last element. - (_.return (_.at index product))] - [(_.< index-min-length - (..length product)) + (_.define last-index-right (..last-index tuple)) + (_.define right-index (_.+ (_.i32 +1) lefts)) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.at right-index tuple))] + [(_.> right-index last-index-right) ## Needs recursion. - (_.return (product//right (last-element product) - (_.- (..length product) - index-min-length)))]) - ## Must slice - (_.return (_.do "slice" (list index) product)))))) + (_.return (tuple//right (_.- last-index-right lefts) + (_.at last-index-right tuple)))]) + (_.return (_.do "slice" (list right-index) tuple))) + ))) (runtime: (sum//get sum wants-last wanted-tag) (let [no-match! (_.return _.null) @@ -232,7 +229,7 @@ Statement ($_ _.then @tuple//left - @product//right + @tuple//right @sum//get )) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux index 6e4988b9b..923f3d1d3 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux @@ -43,15 +43,18 @@ (list valueO))))) (def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List [Nat Bit]) + (-> Phase Synthesis (List (Either Nat Nat)) (Operation (Expression Any))) (do ////.monad [valueO (generate valueS)] - (wrap (list@fold (function (_ [idx tail?] source) - (.let [method (.if tail? - //runtime.product//right - //runtime.tuple//left)] - (method source (_.int (.int idx))))) + (wrap (list@fold (function (_ side source) + (.let [method (.case side + (^template [ ] + ( lefts) + ( (_.int (.int lefts)))) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) valueO pathP)))) @@ -159,11 +162,14 @@ ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) - (^template [ ] - (^ ( idx)) - (////@wrap (|> idx .int _.int ( ..peek-cursor) push-cursor!))) - ([/////synthesis.member/left //runtime.tuple//left (<|)] - [/////synthesis.member/right //runtime.product//right inc]) + (^ (/////synthesis.member/left 0)) + (////@wrap (|> ..peek-cursor (_.nth (_.int +0)) push-cursor!)) + + (^template [ ] + (^ ( lefts)) + (////@wrap (|> ..peek-cursor ( (_.int (.int lefts))) push-cursor!))) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind-top register thenP)) (do ////.monad diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index c4a1a6da2..f5a734346 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -180,34 +180,33 @@ @io//exit! @io//current-time!)) -(runtime: (tuple//left tuple lefts) - (with-vars [index-right] +(def: last-index + (|>> _.len/1 (_.- (_.int +1)))) + +(runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] ($_ _.then - (_.set (list index-right) (_.- (_.int +1) - (_.len/1 tuple))) - (_.if (_.> lefts index-right) + (_.set (list last-index-right) (..last-index tuple)) + (_.if (_.> lefts last-index-right) ## No need for recursion (_.return (_.nth lefts tuple)) ## Needs recursion - (_.return (tuple//left (_.nth index-right tuple) - (_.- index-right lefts))))))) + (_.return (tuple//left (_.- last-index-right lefts) + (_.nth last-index-right tuple))))))) -(runtime: (product//right product index) - (with-vars [index-min-length] +(runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index] ($_ _.then - (_.set (list index-min-length) (_.+ (_.int +1) index)) - (_.cond (list [(_.= index-min-length (_.len/1 product)) - ## Last element. - (_.return (_.nth index product))] - [(_.< index-min-length (_.len/1 product)) - ## Needs recursion - (_.return (product//right (_.nth (_.- (_.int +1) - (_.len/1 product)) - product) - (_.- (_.len/1 product) - index-min-length)))]) - ## Must slice - (_.return (_.slice-from index product)))))) + (_.set (list last-index-right) (..last-index tuple)) + (_.set (list right-index) (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.nth right-index tuple))] + [(_.> right-index last-index-right) + ## Needs recursion. + (_.return (tuple//right (_.- last-index-right lefts) + (_.nth last-index-right tuple)))]) + (_.return (_.slice-from right-index tuple))) + ))) (runtime: (sum//get sum wantsLast wantedTag) (let [no-match! (_.return _.none) @@ -237,7 +236,7 @@ (Statement Any) ($_ _.then @tuple//left - @product//right + @tuple//right @sum//get)) (def: full-64-bits -- cgit v1.2.3